module Data.ByteString.Arbitrary
( ArbByteString(..)
, ArbByteString1M(..)
, ArbByteString10M(..)
, fastRandBs
, slowRandBs
) where
import qualified Data.ByteString as BS
import Data.ByteString ( ByteString )
import Crypto.Hash.Skein512 ( hash )
import Test.QuickCheck ( Arbitrary(..), Gen, choose, vectorOf )
newtype ArbByteString = ABS { fromABS :: ByteString }
deriving (Eq, Ord, Read, Show )
newtype ArbByteString1M = ABS1M { fromABS1M :: ByteString }
deriving (Eq, Ord, Read, Show )
newtype ArbByteString10M = ABS10M { fromABS10M :: ByteString }
deriving (Eq, Ord, Read, Show )
instance Arbitrary ArbByteString where
arbitrary = do
len <- choose (0, 100*1024)
ABS `fmap` fastRandBs len
shrink (ABS bs) = map ABS $ shrinks bs
instance Arbitrary ArbByteString1M where
arbitrary =
ABS1M `fmap` fastRandBs (1024*1024)
shrink (ABS1M bs) = map ABS1M $ shrinks bs
instance Arbitrary ArbByteString10M where
arbitrary =
ABS10M `fmap` fastRandBs (10*1024*1024)
shrink (ABS10M bs) = map ABS10M $ shrinks bs
fastRandBs :: Int -> Gen ByteString
fastRandBs len = do
let perChunk = 1024*1024
let (rounds, bytes) = len `divMod` perChunk
bSeed <- slowRandBs $ 16
let preChunks = if bytes == 0 then BS.empty else hash (8*bytes) bSeed
if rounds == 0
then return preChunks
else do
rSeed <- slowRandBs $ 16
let hashes = tail $ iterate ( hash (8*perChunk) . BS.take 32 ) rSeed
return $ BS.concat $ preChunks : take rounds hashes
slowRandBs :: Int -> Gen ByteString
slowRandBs numBytes = BS.pack `fmap` vectorOf numBytes (choose (0, 255))
shrinks :: ByteString -> [ByteString]
shrinks bs =
[ BS.append a b | (a, b) <- zip (BS.inits bs) (tail $ BS.tails bs) ]