{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE MonoLocalBinds      #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- Generic tests for hash.

module Tests.Digest
       ( digestsTo
       , incrementalVsFull
       ) where

import Implementation
import Interface

import Tests.Core



digestsTo :: ByteString
          -> Prim
          -> Spec
digestsTo :: ByteString -> Prim -> Spec
digestsTo ByteString
str Prim
h = forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
msg (forall src. PureByteSource src => src -> Prim
digest ByteString
str forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Prim
h)
  where msg :: String
msg   = [String] -> String
unwords [ String
"hashes"
                        , String -> String
shortened forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ByteString
str
                        , String
"to"
                        , String -> String
shortened forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Prim
h
                        ]

incrDigest :: ByteString
           -> IO Prim
incrDigest :: ByteString -> IO Prim
incrDigest ByteString
bs = forall mem a. Memory mem => (mem -> IO a) -> IO a
withMemory forall a b. (a -> b) -> a -> b
$ \ (DigestCxt 1
cxt :: DigestCxt 1) ->
  do forall (n :: Nat). KnownNat n => Cxt n -> Expectation
startDigest DigestCxt 1
cxt
     forall (n :: Nat) src.
(KnownNat n, ByteSource src) =>
src -> Cxt n -> Expectation
updateDigest ByteString
bs DigestCxt 1
cxt
     forall (n :: Nat). KnownNat n => Cxt n -> IO Prim
finaliseDigest DigestCxt 1
cxt

incrDigestList :: [ByteString]
               -> IO Prim
incrDigestList :: [ByteString] -> IO Prim
incrDigestList [ByteString]
bsL = forall mem a. Memory mem => (mem -> IO a) -> IO a
withMemory forall a b. (a -> b) -> a -> b
$ \ (DigestCxt 1
cxt :: DigestCxt 1) ->
  do forall (n :: Nat). KnownNat n => Cxt n -> Expectation
startDigest DigestCxt 1
cxt
     forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (n :: Nat) src.
(KnownNat n, ByteSource src) =>
src -> Cxt n -> Expectation
`updateDigest` DigestCxt 1
cxt) [ByteString]
bsL
     forall (n :: Nat). KnownNat n => Cxt n -> IO Prim
finaliseDigest DigestCxt 1
cxt

incrementalVsFull :: Spec
incrementalVsFull :: Spec
incrementalVsFull = forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Incremental vs Full digest" forall a b. (a -> b) -> a -> b
$ do
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"for single source" forall a b. (a -> b) -> a -> b
$
    \ ByteString
bs -> ByteString -> IO Prim
incrDigest ByteString
bs forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` forall src. PureByteSource src => src -> Prim
digest ByteString
bs

  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"for multiple source" forall a b. (a -> b) -> a -> b
$
    \ [ByteString]
bsL -> [ByteString] -> IO Prim
incrDigestList [ByteString]
bsL forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` forall src. PureByteSource src => src -> Prim
digest [ByteString]
bsL