bytestring-typenats (empty) → 1.0.0
raw patch · 6 files changed
+365/−0 lines, 6 filesdep +QuickCheckdep +basedep +binarysetup-changed
Dependencies added: QuickCheck, base, binary, blake2, bytestring, bytestring-typenats, cereal, criterion, cryptohash, deepseq, entropy
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- benches/bench.hs +40/−0
- bytestring-typenats.cabal +88/−0
- src/Data/ByteString/TypeNats.hs +178/−0
- tests/test.hs +27/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Jeremy Groven++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Jeremy Groven nor the names of other+ 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+OWNER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benches/bench.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE DataKinds #-}+#ifdef UseArbitrary+import Test.QuickCheck.Arbitrary+import Test.QuickCheck.Gen+import Criterion.Main++import Data.ByteString.TypeNats+#endif++main :: IO ()+#ifdef UseArbitrary+main = defaultMain+ [ bench "arbitrary" $ nfIO $ action (arbitrary :: Gen (ByteString 10))+ , bench "arbitrary1M" $ nfIO $ action (arbitrary :: Gen (ByteString 1000000))+ , bench "arbitrary10M" $ nfIO $ action (arbitrary :: Gen (ByteString 10000000))+ , bgroup "fastRandBs"+ [ bench "10B" $ nfIO $ action (fastRandBs 10)+ , bench "1KB" $ nfIO $ action (fastRandBs 1024)+ , bench "1MB" $ nfIO $ action (fastRandBs (1024*1024))+ ]+ , bgroup "slowRandBs"+ [ bench "10B" $ nfIO $ action (slowRandBs 10)+ , bench "1KB" $ nfIO $ action (slowRandBs 1024)+ , bench "10KB" $ nfIO $ action (slowRandBs 10240)+ ]+ ]++ where+ action :: Gen a -> IO ()+ action act = do+ samples <- sample' act+ examine samples+ where+ examine :: [a] -> IO ()+ examine [] = return ()+ examine (hd:tl) = hd `seq` examine tl+#else+main = putStrLn "Arbitrary disabled; nothing to benchmark"+#endif+
+ bytestring-typenats.cabal view
@@ -0,0 +1,88 @@+-- Initial bytestring-typenats.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: bytestring-typenats+version: 1.0.0+synopsis: Bytestrings with typenat lengths+-- description: +homepage: https://github.com/tsuraan/bytestring-typenats+license: BSD3+license-file: LICENSE+author: Jeremy Groven+maintainer: jeremy.groven@gmail.com+-- copyright: +category: Data+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++Flag UseCereal+ Description: Enable 'cereal' serialization+ Default: True++Flag UseBinary+ Description: Enable 'binary' serialization+ Default: True++Flag UseArbitrary+ Description: Enable instance for QuickCheck 'Arbitrary'+ Default: True++library+ exposed-modules: Data.ByteString.TypeNats+ default-extensions: CPP+ -- other-modules: + -- other-extensions: + build-depends: base >=4.8 && <4.9+ , bytestring+ , deepseq+ , entropy+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall++ if flag(usecereal)+ build-depends: cereal+ cpp-options: -DUseCereal++ if flag(usebinary)+ build-depends: binary >= 0.8.3.0+ cpp-options: -DUseBinary++ if flag(usearbitrary)+ build-depends: QuickCheck+ , blake2+ , cryptohash >= 0.6+ cpp-options: -DUseArbitrary++benchmark benchmark-all+ type: exitcode-stdio-1.0+ hs-source-dirs: benches+ main-is: bench.hs+ build-depends: base >=4.6 && <4.9+ , bytestring >=0.10+ , criterion+ , bytestring-typenats+ , QuickCheck+ default-language: Haskell2010+ ghc-options: -Wall+ default-extensions: CPP+ if flag(usearbitrary)+ build-depends: QuickCheck+ cpp-options: -DUseArbitrary++Test-Suite test-all+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: test.hs+ build-depends: base+ , bytestring+ , QuickCheck+ , cryptohash+ , bytestring-typenats+ default-language: Haskell2010+ default-extensions: CPP+ if flag(usearbitrary)+ build-depends: QuickCheck+ cpp-options: -DUseArbitrary+
+ src/Data/ByteString/TypeNats.hs view
@@ -0,0 +1,178 @@+{-# LANGUAGE DataKinds, KindSignatures, TypeOperators, OverloadedStrings,+ LambdaCase, DeriveDataTypeable #-}+-- |+-- Module : Data.ByteString.TypeNats+-- Copyright: Jeremy Groven+-- License: BSD3+--+-- A tiny tagged 'ByteString' wrapper that carries around the size of the+-- wrapped ByteString. This allows for very simple+-- serialization/deserialization.+module Data.ByteString.TypeNats+( ByteString(stripSize)+, wrap+, wrap'+, random+, length+, append+, sizeHelper+, sizeHelper'+#ifdef UseArbitrary+, fastRandBs+, slowRandBs+#endif+) where++import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Char8 as BSC+-- import qualified Data.ByteString.Lazy as LazyByteString++import Control.DeepSeq ( NFData(..) )+-- import Crypto.Hash.Skein512 ( hash )+import Data.Functor.Identity ( Identity(..) )+import Data.Monoid ( (<>) )+import Data.Proxy ( Proxy(..) )+import Data.String ( IsString(..) )+import Data.Typeable ( Typeable )+import System.Entropy ( getEntropy )+import GHC.TypeLits++import Prelude hiding ( length )++#ifdef UseCereal+import qualified Data.Serialize.Put as SP+import qualified Data.Serialize.Get as SG+import Data.Serialize ( Serialize(..) )+#endif++#ifdef UseBinary+import qualified Data.Binary.Put as BP+import qualified Data.Binary.Get as BG+import Data.Binary ( Binary(..) )+import Data.Coerce ( coerce )+#endif++#ifdef UseArbitrary+import Crypto.Hash.BLAKE2.BLAKE2bp ( hash )+import Test.QuickCheck ( Arbitrary(..), Gen, choose, vectorOf )+#endif++-- | A sized-tagged wrapper around 'ByteString's. Useful when doing a lot of+-- serialization and deserialization of bytestrings that have fixed lengths.+newtype ByteString (sz :: Nat ) = ByteString+ { stripSize :: ByteString.ByteString }+ deriving ( Eq, Ord, Typeable )++-- |Wrap a 'ByteString' with a size tag. Returns 'Just' if the given ByteString+-- has the desired length, 'Nothing' if it does not.+wrap :: KnownNat sz => ByteString.ByteString -> Either String (ByteString sz)+wrap bs = runIdentity $ sizeHelper (const $ return bs)++-- | Wrap a 'ByteString' with a size tag. Errors out if the given ByteString is+-- the wrong size, does the wrapping if the size is right.+wrap' :: KnownNat sz => ByteString.ByteString -> ByteString sz+wrap' bs = case wrap bs of+ Right wrapped -> wrapped+ Left err -> error err++-- | Generate a random bytestring using the system's entropy source+random :: KnownNat sz => IO (ByteString sz)+random = sizeHelper' getEntropy++-- | Determine the length of a size tagged ByteString. I think this is probably+-- constant-folded at compile time, since it only uses types.+length :: KnownNat sz => ByteString sz -> Int+length = fromIntegral . natVal . proxy++-- | Append two tagged 'ByteString's.+append :: (KnownNat s1, KnownNat s2)+ => ByteString s1 -> ByteString s2 -> ByteString (s1+s2)+append (ByteString a) (ByteString b) =+ -- I really want to use wrap', but I can't make the type machinery work.+ -- Something about having to be 10% smarter than the tools we use... :(+ ByteString (a <> b)++proxy :: ByteString sz -> Proxy sz+proxy _ = Proxy++fst' :: (a, a) -> a+fst' = fst++-- | Generate a ByteString of the desired length. The given callback will be+-- called with the number of bytes that are indicated by the output's type, and+-- is expected to return a (standard) ByteString of that length.+sizeHelper :: (Monad m, KnownNat sz)+ => (Int -> m ByteString.ByteString)+ -> m (Either String (ByteString sz))+sizeHelper fn = do+ let dummy = undefined+ r <- helper' fn dummy+ return $ fst' (r, dummy)+ where+ helper' :: (Monad m, KnownNat sz)+ => (Int -> m ByteString.ByteString)+ -> ByteString sz+ -> m (Either String (ByteString sz))+ helper' fn' dummy = do+ let needLen = fromIntegral $ natVal $ proxy dummy+ bs <- fn' needLen+ let gotLen = ByteString.length bs+ if gotLen == needLen+ then return $ Right $ ByteString bs+ else return $ Left $ "Expected " ++ show needLen ++ + " byte result from callback, but got " ++ show gotLen++-- | Same as sizeHelper, but this does the monad's fail action instead of+-- returning Left/Right values+sizeHelper' :: (Monad m, KnownNat sz)+ => (Int -> m ByteString.ByteString)+ -> m (ByteString sz)+sizeHelper' fn =+ sizeHelper fn >>= \case+ Right bs -> return bs+ Left err -> fail err++instance Show (ByteString sz) where+ showsPrec x b = showsPrec x (stripSize b)++instance KnownNat sz => IsString (ByteString sz) where+ fromString = wrap' . BSC.pack++instance NFData (ByteString sz) where+ rnf (ByteString bs) = rnf bs++#ifdef UseCereal+instance KnownNat sz => Serialize (ByteString sz) where+ put (ByteString bs) = SP.putByteString bs++ get = sizeHelper' SG.getByteString+#endif++#ifdef UseBinary+instance KnownNat sz => Binary (ByteString sz) where+ put (ByteString bs) = BP.putByteString bs+ putList sbss =+ let bss = coerce sbss+ bs = ByteString.concat bss+ in BP.putByteString bs++ get = sizeHelper' BG.getByteString+#endif++#ifdef UseArbitrary+-- | Quickly generate large amounts of pseudo-random data using a few bytes+-- from the quicktest generator, and then a bunch more bytes from Blake2.+fastRandBs :: Int -> Gen ByteString.ByteString+fastRandBs 0 = return ""+fastRandBs numBytes | numBytes <= 16 = slowRandBs numBytes+fastRandBs numBytes = hash numBytes "" <$> slowRandBs 16++-- | Use choose to generate some "random" Word8 values, and then pack them+-- together with ByteString.pack+slowRandBs :: Int -> Gen ByteString.ByteString+slowRandBs numBytes = ByteString.pack `fmap` vectorOf numBytes (choose (0, 255))++instance KnownNat sz => Arbitrary (ByteString sz) where+ arbitrary = sizeHelper' fastRandBs+#endif+
+ tests/test.hs view
@@ -0,0 +1,27 @@+import qualified Data.ByteString as BS+import Data.ByteString ( ByteString )+import Test.QuickCheck.Monadic+import Test.QuickCheck++#ifdef UseArbitrary+import Data.ByteString.TypeNats ( fastRandBs, slowRandBs )+#endif++main :: IO ()+main = do+#ifdef UseArbitrary+ quickCheck $ lengths fastRandBs+ quickCheck $ lengths (\i -> slowRandBs $ min i 10240)+ x <- generate $ fastRandBs 100000000+ putStrLn $ "100000000 " ++ (show $ BS.length x)+ where+ lengths :: (Int -> Gen ByteString) -> Int -> Property+ lengths genFn len =+ let len' = abs len+ gen = genFn len'+ in monadicIO $ do+ samples <- run $ sample' gen+ assert $ all (==len') $ map BS.length samples+#else+ putStrLn "Arbitrary disabled; nothing to test"+#endif