static-bytes-0.1.0/src/0000755000000000000000000000000014452071251013101 5ustar0000000000000000static-bytes-0.1.0/src/Data/0000755000000000000000000000000014452071251013752 5ustar0000000000000000static-bytes-0.1.0/test/0000755000000000000000000000000014452071771013300 5ustar0000000000000000static-bytes-0.1.0/test/Data/0000755000000000000000000000000014452072006014141 5ustar0000000000000000static-bytes-0.1.0/src/Data/StaticBytes.hs0000644000000000000000000001770414452071251016555 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# 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 import Data.ByteArray import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B import qualified Data.Primitive.ByteArray as BA 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 import Foreign.Ptr import Foreign.Storable 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 -- | May throw a runtime exception if invariants are violated! fromWordsD :: Int -> [Word64] -> dbytes fromWordsForeign :: (ForeignPtr a -> Int -> b) -> Int -> [Word64] -> 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 w loop (off + 1) ws loop 0 words0 pure $ wrapper fptr len withPeekForeign :: (ForeignPtr a, Int, Int) -> ((Int -> IO Word64) -> IO b) -> 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 = 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 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 $ 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 static-bytes-0.1.0/test/Spec.hs0000644000000000000000000000005514452071251014517 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} static-bytes-0.1.0/test/Data/StaticBytesSpec.hs0000644000000000000000000000700614452073115017553 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.0/README.md0000644000000000000000000000014714452071251013573 0ustar0000000000000000# static-bytes A Haskell library providing types representing 8, 16, 32, 64 or 128 bytes of data. static-bytes-0.1.0/CHANGELOG.md0000644000000000000000000000060614452071251014125 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.0 - 2023-07-07 * Spin out module `Pantry.Internal.StaticBytes` from package `pantry-0.8.3`. static-bytes-0.1.0/LICENSE0000644000000000000000000000300214452071251013312 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.0/Setup.hs0000644000000000000000000000006014452071251013742 0ustar0000000000000000import Distribution.Simple main = defaultMain static-bytes-0.1.0/static-bytes.cabal0000644000000000000000000000313314452075762015724 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack name: static-bytes version: 0.1.0 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