static-bytes-0.1.1/src/0000755000000000000000000000000014705521101013075 5ustar0000000000000000static-bytes-0.1.1/src/Data/0000755000000000000000000000000014705521101013746 5ustar0000000000000000static-bytes-0.1.1/test/0000755000000000000000000000000014705521101013265 5ustar0000000000000000static-bytes-0.1.1/test/Data/0000755000000000000000000000000014705521101014136 5ustar0000000000000000static-bytes-0.1.1/src/Data/StaticBytes.hs0000644000000000000000000002152714705521101016547 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} module Data.StaticBytes ( Bytes8 , Bytes16 , Bytes32 , Bytes64 , Bytes128 , DynamicBytes , StaticBytes , StaticBytesException (..) , toStaticExact , toStaticPad , toStaticTruncate , toStaticPadTruncate , fromStatic ) where import Data.Bits ( Bits (..) ) import Data.ByteArray ( ByteArrayAccess (..) ) import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B import qualified Data.Primitive.ByteArray as BA #if MIN_VERSION_GLASGOW_HASKELL(9,4,1,0) import Data.Type.Equality ( type (~) ) #endif import qualified Data.Vector.Primitive as VP import qualified Data.Vector.Storable as VS import qualified Data.Vector.Unboxed as VU import qualified Data.Vector.Unboxed.Base as VU import Foreign.ForeignPtr ( ForeignPtr, withForeignPtr ) import Foreign.Ptr ( Ptr, castPtr ) import Foreign.Storable ( Storable (..) ) import GHC.ByteOrder ( ByteOrder (..), targetByteOrder ) import RIO hiding ( words ) import System.IO.Unsafe ( unsafePerformIO ) -- | A type representing 8 bytes of data. newtype Bytes8 = Bytes8 Word64 deriving (Eq, Ord, Generic, NFData, Hashable, Data) instance Show Bytes8 where show (Bytes8 w) = show (fromWordsD 8 [w] :: B.ByteString) -- | A type representing 16 bytes of data. data Bytes16 = Bytes16 !Bytes8 !Bytes8 deriving (Show, Eq, Ord, Generic, NFData, Hashable, Data) -- | A type representing 32 bytes of data. data Bytes32 = Bytes32 !Bytes16 !Bytes16 deriving (Show, Eq, Ord, Generic, NFData, Hashable, Data) -- | A type representing 64 bytes of data. data Bytes64 = Bytes64 !Bytes32 !Bytes32 deriving (Show, Eq, Ord, Generic, NFData, Hashable, Data) -- | A type representing 128 bytes of data. data Bytes128 = Bytes128 !Bytes64 !Bytes64 deriving (Show, Eq, Ord, Generic, NFData, Hashable, Data) -- | A type representing exceptions thrown by functions expecting data of a -- fixed number of bytes. data StaticBytesException = NotEnoughBytes | TooManyBytes deriving (Eq, Show, Typeable) instance Exception StaticBytesException -- All lengths below are given in bytes class DynamicBytes dbytes where lengthD :: dbytes -> Int -- Yeah, it looks terrible to use a list here, but fusion should kick in withPeekD :: dbytes -> ((Int -> IO Word64) -> IO a) -> IO a -- ^ This assumes that the Word64 values are all little-endian. -- | May throw a runtime exception if invariants are violated! fromWordsD :: Int -> [Word64] -> dbytes -- ^ This assumes that the Word64 values are all little-endian. fromWordsForeign :: (ForeignPtr a -> Int -> b) -> Int -> [Word64] -- ^ The Word64 values are assumed to be little-endian. -> b fromWordsForeign wrapper len words0 = unsafePerformIO $ do fptr <- B.mallocByteString len withForeignPtr fptr $ \ptr -> do let loop _ [] = pure () loop off (w:ws) = do pokeElemOff (castPtr ptr) off (fromLE64 w) loop (off + 1) ws loop 0 words0 pure $ wrapper fptr len withPeekForeign :: (ForeignPtr a, Int, Int) -> ((Int -> IO Word64) -> IO b) -- ^ The Word64 values are assumed to be little-endian. -> IO b withPeekForeign (fptr, off, len) inner = withForeignPtr fptr $ \ptr -> do let f off' | off' >= len = pure 0 | off' + 8 > len = do let loop w64 i | off' + i >= len = pure w64 | otherwise = do w8 :: Word8 <- peekByteOff ptr (off + off' + i) let w64' = shiftL (fromIntegral w8) (i * 8) .|. w64 loop w64' (i + 1) loop 0 0 | otherwise = toLE64 <$> peekByteOff ptr (off + off') inner f instance DynamicBytes B.ByteString where lengthD = B.length fromWordsD = fromWordsForeign (`B.fromForeignPtr` 0) withPeekD = withPeekForeign . B.toForeignPtr instance word8 ~ Word8 => DynamicBytes (VS.Vector word8) where lengthD = VS.length fromWordsD = fromWordsForeign VS.unsafeFromForeignPtr0 withPeekD = withPeekForeign . VS.unsafeToForeignPtr instance word8 ~ Word8 => DynamicBytes (VP.Vector word8) where lengthD = VP.length fromWordsD len words0 = unsafePerformIO $ do ba <- BA.newByteArray len let loop _ [] = VP.Vector 0 len <$> BA.unsafeFreezeByteArray ba loop i (w:ws) = do BA.writeByteArray ba i (fromLE64 w) loop (i + 1) ws loop 0 words0 withPeekD (VP.Vector off len ba) inner = do let f off' | off' >= len = pure 0 | off' + 8 > len = do let loop w64 i | off' + i >= len = pure w64 | otherwise = do let w8 :: Word8 = BA.indexByteArray ba (off + off' + i) let w64' = shiftL (fromIntegral w8) (i * 8) .|. w64 loop w64' (i + 1) loop 0 0 | otherwise = pure $ toLE64 $ BA.indexByteArray ba (off + (off' `div` 8)) inner f instance word8 ~ Word8 => DynamicBytes (VU.Vector word8) where lengthD = VU.length fromWordsD len words = VU.V_Word8 (fromWordsD len words) withPeekD (VU.V_Word8 v) = withPeekD v class StaticBytes sbytes where lengthS :: proxy sbytes -> Int -- use type level literals instead? -- difference list toWordsS :: sbytes -> [Word64] -> [Word64] usePeekS :: Int -> (Int -> IO Word64) -> IO sbytes instance StaticBytes Bytes8 where lengthS _ = 8 toWordsS (Bytes8 w) = (w:) usePeekS off f = Bytes8 <$> f off instance StaticBytes Bytes16 where lengthS _ = 16 toWordsS (Bytes16 b1 b2) = toWordsS b1 . toWordsS b2 usePeekS off f = Bytes16 <$> usePeekS off f <*> usePeekS (off + 8) f instance StaticBytes Bytes32 where lengthS _ = 32 toWordsS (Bytes32 b1 b2) = toWordsS b1 . toWordsS b2 usePeekS off f = Bytes32 <$> usePeekS off f <*> usePeekS (off + 16) f instance StaticBytes Bytes64 where lengthS _ = 64 toWordsS (Bytes64 b1 b2) = toWordsS b1 . toWordsS b2 usePeekS off f = Bytes64 <$> usePeekS off f <*> usePeekS (off + 32) f instance StaticBytes Bytes128 where lengthS _ = 128 toWordsS (Bytes128 b1 b2) = toWordsS b1 . toWordsS b2 usePeekS off f = Bytes128 <$> usePeekS off f <*> usePeekS (off + 64) f instance ByteArrayAccess Bytes8 where length _ = 8 withByteArray = withByteArrayS instance ByteArrayAccess Bytes16 where length _ = 16 withByteArray = withByteArrayS instance ByteArrayAccess Bytes32 where length _ = 32 withByteArray = withByteArrayS instance ByteArrayAccess Bytes64 where length _ = 64 withByteArray = withByteArrayS instance ByteArrayAccess Bytes128 where length _ = 128 withByteArray = withByteArrayS withByteArrayS :: StaticBytes sbytes => sbytes -> (Ptr p -> IO a) -> IO a withByteArrayS sbytes = withByteArray (fromStatic sbytes :: ByteString) toStaticExact :: forall dbytes sbytes. (DynamicBytes dbytes, StaticBytes sbytes) => dbytes -> Either StaticBytesException sbytes toStaticExact dbytes = case compare (lengthD dbytes) (lengthS (Nothing :: Maybe sbytes)) of LT -> Left NotEnoughBytes GT -> Left TooManyBytes EQ -> Right (toStaticPadTruncate dbytes) toStaticPad :: forall dbytes sbytes. (DynamicBytes dbytes, StaticBytes sbytes) => dbytes -> Either StaticBytesException sbytes toStaticPad dbytes = case compare (lengthD dbytes) (lengthS (Nothing :: Maybe sbytes)) of GT -> Left TooManyBytes _ -> Right (toStaticPadTruncate dbytes) toStaticTruncate :: forall dbytes sbytes. (DynamicBytes dbytes, StaticBytes sbytes) => dbytes -> Either StaticBytesException sbytes toStaticTruncate dbytes = case compare (lengthD dbytes) (lengthS (Nothing :: Maybe sbytes)) of LT -> Left NotEnoughBytes _ -> Right (toStaticPadTruncate dbytes) toStaticPadTruncate :: (DynamicBytes dbytes, StaticBytes sbytes) => dbytes -> sbytes toStaticPadTruncate dbytes = unsafePerformIO (withPeekD dbytes (usePeekS 0)) fromStatic :: forall dbytes sbytes. (DynamicBytes dbytes, StaticBytes sbytes) => sbytes -> dbytes fromStatic = fromWordsD (lengthS (Nothing :: Maybe sbytes)) . ($ []) . toWordsS -- | Convert a 64 bit value in CPU endianess to little endian. toLE64 :: Word64 -> Word64 toLE64 = case targetByteOrder of BigEndian -> byteSwap64 LittleEndian -> id -- | Convert a little endian 64 bit value to CPU endianess. fromLE64 :: Word64 -> Word64 fromLE64 = toLE64 static-bytes-0.1.1/test/Spec.hs0000644000000000000000000000005514705521101014513 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} static-bytes-0.1.1/test/Data/StaticBytesSpec.hs0000644000000000000000000000700614705521101017546 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Data.StaticBytesSpec ( spec ) where import Control.Monad ( replicateM ) import qualified Data.ByteString as B import Data.StaticBytes ( Bytes128, Bytes16, Bytes32, Bytes8, DynamicBytes , StaticBytesException (..), fromStatic, toStaticExact , toStaticPad, toStaticPadTruncate ) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Vector.Primitive as VP import qualified Data.Vector.Storable as VS import qualified Data.Vector.Unboxed as VU import RIO import Test.Hspec ( Spec, describe, it, shouldBe ) import Test.Hspec.QuickCheck ( prop ) import Test.QuickCheck ( arbitrary, forAll, property ) spec :: Spec spec = do describe "ByteString" $ tests B.pack describe "Storable Vector" $ tests VS.fromList describe "Unboxed Vector" $ tests VU.fromList describe "Primitive Vector" $ tests VP.fromList tests :: (Eq dbytes, Show dbytes, DynamicBytes dbytes) => ([Word8] -> dbytes) -> Spec tests pack = do it "disallows 4 bytes" $ property $ \(w1,w2,w3,w4) -> toStaticExact (pack [w1,w2,w3,w4]) `shouldBe` (Left NotEnoughBytes :: Either StaticBytesException Bytes8) it "toStaticExact matches ByteString" $ property $ \(w1,w2,w3,w4) -> property $ \(w5,w6,w7,w8) -> do let octets = [w1,w2,w3,w4,w5,w6,w7,w8] (expected :: Bytes8) = either impureThrow id $ toStaticExact (B.pack octets) actual = either impureThrow id $ toStaticExact (pack octets) actual `shouldBe` expected it "fromStatic round trips" $ property $ \(w1,w2,w3,w4) -> property $ \(w5,w6,w7,w8) -> do let octets = [w1,w2,w3,w4,w5,w6,w7,w8] v1 = pack octets (b8 :: Bytes8) = either impureThrow id $ toStaticExact v1 v2 = fromStatic b8 v2 `shouldBe` v1 it "allows 8 bytes" $ property $ \(w1,w2,w3,w4) -> property $ \(w5,w6,w7,w8) -> do let bs = pack [w1,w2,w3,w4,w5,w6,w7,w8] case toStaticExact bs of Left e -> throwIO e Right b8 -> fromStatic (b8 :: Bytes8) `shouldBe` bs toStaticExact bs `shouldBe` (Left NotEnoughBytes :: Either StaticBytesException Bytes16) it "padding is the same as trailing nulls" $ property $ \(w1,w2,w3,w4) -> do let ws = [w1,w2,w3,w4] bs1 = pack $ ws ++ replicate 4 0 bs2 = pack ws Right (toStaticPadTruncate bs2 :: Bytes8) `shouldBe` toStaticExact bs1 prop "handles bytes16" $ \octets -> do let bs = pack $ take 16 octets (b16 :: Bytes16) = either impureThrow id $ toStaticPad bs fromStatic b16 `shouldBe` pack (take 16 (octets ++ replicate 16 0)) it "spot check bytes16" $ forAll (replicateM 16 arbitrary) $ \ws -> do let bs = pack ws (b16 :: Bytes16) = either impureThrow id $ toStaticPad bs fromStatic b16 `shouldBe` pack ws prop "handles bytes32" $ \octets -> do let bs = pack $ take 32 octets (b32 :: Bytes32) = either impureThrow id $ toStaticPad bs fromStatic b32 `shouldBe` pack (take 32 (take 32 octets ++ replicate 32 0)) prop "fuzz with encodeUtf8" $ \chars -> do let t = T.pack $ filter (/= '\0') chars bs = TE.encodeUtf8 t bs128 = pack $ B.unpack $ B.take 128 $ bs `B.append` B.replicate 128 0 b128 = toStaticPadTruncate (pack $ B.unpack bs) :: Bytes128 fromStatic b128 `shouldBe` bs128 static-bytes-0.1.1/README.md0000644000000000000000000000014714705521101013567 0ustar0000000000000000# static-bytes A Haskell library providing types representing 8, 16, 32, 64 or 128 bytes of data. static-bytes-0.1.1/CHANGELOG.md0000644000000000000000000000104614705521544014133 0ustar0000000000000000# Changelog for `static-bytes` All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). ## 0.1.1 - 2024-10-21 * Ensure that the functionality on big-endian machine architectures is the same as that on little-endian machine architectures. ## 0.1.0 - 2023-07-07 * Spin out module `Pantry.Internal.StaticBytes` from package `pantry-0.8.3`. static-bytes-0.1.1/LICENSE0000644000000000000000000000300214705521101013306 0ustar0000000000000000BSD 3-Clause License Copyright (c) 2015-2023, Stack contributors Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. static-bytes-0.1.1/Setup.hs0000644000000000000000000000006014705521101013736 0ustar0000000000000000import Distribution.Simple main = defaultMain static-bytes-0.1.1/static-bytes.cabal0000644000000000000000000000313314705523325015717 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack name: static-bytes version: 0.1.1 synopsis: A Haskell library providing types representing 8, 16, 32, 64 or 128 bytes of data. description: Please see the README on GitHub at category: Data homepage: https://github.com/commercialhaskell/static-bytes#readme bug-reports: https://github.com/commercialhaskell/static-bytes/issues author: Michael Snoyman maintainer: Mike Pilgrem copyright: 2018-2023 FP Complete license: BSD3 license-file: LICENSE build-type: Simple extra-source-files: README.md CHANGELOG.md source-repository head type: git location: https://github.com/commercialhaskell/static-bytes library exposed-modules: Data.StaticBytes other-modules: Paths_static_bytes hs-source-dirs: src ghc-options: -Wall build-depends: base >=4.12 && <5 , bytestring , memory , primitive , rio , vector default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Data.StaticBytesSpec Paths_static_bytes hs-source-dirs: test ghc-options: -Wall build-tool-depends: hspec-discover:hspec-discover build-depends: QuickCheck , base >=4.12 && <5 , bytestring , hspec , memory , primitive , rio , static-bytes , text , vector default-language: Haskell2010