{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Crypto.Hash (
  tests,
)
where

import Cardano.Crypto.Hash
import Control.Exception (bracket)
import Data.Bifunctor
import qualified Data.Bits as Bits (xor)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Short as SBS
import Data.Maybe (fromJust)
import Data.MemPack
import Data.Proxy (Proxy (..))
import Data.String (fromString)
import GHC.TypeLits
import Test.Crypto.Util (Lock, prop_cbor, prop_cbor_size, prop_no_thunks, withLock)
import Test.QuickCheck
import Test.QuickCheck.Instances ()
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)

import qualified Cardano.Crypto.Libsodium as NaCl

--
-- The list of all tests
--
tests :: Lock -> TestTree
tests :: Lock -> TestTree
tests Lock
lock =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Crypto.Hash"
    [ forall (proxy :: * -> *) h. HashAlgorithm h => proxy h -> TestTree
testHashAlgorithm (forall {k} (t :: k). Proxy t
Proxy :: Proxy SHA256)
    , forall (proxy :: * -> *) h. HashAlgorithm h => proxy h -> TestTree
testHashAlgorithm (forall {k} (t :: k). Proxy t
Proxy :: Proxy SHA3_256)
    , forall (proxy :: * -> *) h. HashAlgorithm h => proxy h -> TestTree
testHashAlgorithm (forall {k} (t :: k). Proxy t
Proxy :: Proxy Blake2b_224)
    , forall (proxy :: * -> *) h. HashAlgorithm h => proxy h -> TestTree
testHashAlgorithm (forall {k} (t :: k). Proxy t
Proxy :: Proxy Blake2b_256)
    , forall (proxy :: * -> *) h. HashAlgorithm h => proxy h -> TestTree
testHashAlgorithm (forall {k} (t :: k). Proxy t
Proxy :: Proxy Keccak256)
    , forall (proxy :: * -> *) h.
SodiumHashAlgorithm h =>
Lock -> proxy h -> TestTree
testSodiumHashAlgorithm Lock
lock (forall {k} (t :: k). Proxy t
Proxy :: Proxy SHA256)
    , forall (proxy :: * -> *) h.
SodiumHashAlgorithm h =>
Lock -> proxy h -> TestTree
testSodiumHashAlgorithm Lock
lock (forall {k} (t :: k). Proxy t
Proxy :: Proxy Blake2b_256)
    , TestTree
testPackedBytes
    ]

testHashAlgorithm ::
  forall proxy h.
  HashAlgorithm h =>
  proxy h ->
  TestTree
testHashAlgorithm :: forall (proxy :: * -> *) h. HashAlgorithm h => proxy h -> TestTree
testHashAlgorithm proxy h
p =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
n
    [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"hash size" forall a b. (a -> b) -> a -> b
$ forall h a. HashAlgorithm h => Hash h a -> Property
prop_hash_correct_sizeHash @h @[Int]
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"serialise" forall a b. (a -> b) -> a -> b
$ forall h. HashAlgorithm h => Hash h Int -> Property
prop_hash_cbor @h
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"ToCBOR size" forall a b. (a -> b) -> a -> b
$ forall h. HashAlgorithm h => Hash h Int -> Property
prop_hash_cbor_size @h
    , -- TODO The following property is wrong because show and fromString are not inverses of each other
      -- Commenting the following out to fix CI and unblock other unrelated PRs to this project.

      forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"hashFromStringAsHex/hashToStringFromHash" forall a b. (a -> b) -> a -> b
$
        forall h a. HashAlgorithm h => Hash h a -> Property
prop_hash_hashFromStringAsHex_hashToStringFromHash @h @Float
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"hashFromStringAsHex/fromString" forall a b. (a -> b) -> a -> b
$ forall h a. HashAlgorithm h => Hash h a -> Property
prop_hash_hashFromStringAsHex_fromString @h @Float
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"show/read" forall a b. (a -> b) -> a -> b
$ forall h a. HashAlgorithm h => Hash h a -> Property
prop_hash_show_read @h @Float
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"NoThunks" forall a b. (a -> b) -> a -> b
$ forall a. NoThunks a => a -> Property
prop_no_thunks @(Hash h Int)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"MemPack RoundTrip" forall a b. (a -> b) -> a -> b
$ forall a. (MemPack a, Eq a, Show a) => a -> Property
prop_MemPackRoundTrip @(Hash h Int)
    ]
  where
    n :: TestName
n = forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> TestName
hashAlgorithmName proxy h
p

prop_MemPackRoundTrip :: forall a. (MemPack a, Eq a, Show a) => a -> Property
prop_MemPackRoundTrip :: forall a. (MemPack a, Eq a, Show a) => a -> Property
prop_MemPackRoundTrip a
a =
  forall a b. (MemPack a, Buffer b, HasCallStack) => b -> a
unpackError (forall a. (MemPack a, HasCallStack) => a -> ByteArray
pack a
a) forall a. (Eq a, Show a) => a -> a -> Property
=== a
a
    forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. forall a b. (MemPack a, Buffer b, HasCallStack) => b -> a
unpackError (forall a. (MemPack a, HasCallStack) => a -> ByteString
packByteString a
a) forall a. (Eq a, Show a) => a -> a -> Property
=== a
a

testSodiumHashAlgorithm ::
  forall proxy h.
  NaCl.SodiumHashAlgorithm h =>
  Lock ->
  proxy h ->
  TestTree
testSodiumHashAlgorithm :: forall (proxy :: * -> *) h.
SodiumHashAlgorithm h =>
Lock -> proxy h -> TestTree
testSodiumHashAlgorithm Lock
lock proxy h
p =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
n
    [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"sodium and crypton work the same" forall a b. (a -> b) -> a -> b
$ forall h.
SodiumHashAlgorithm h =>
Lock -> Proxy h -> ByteString -> Property
prop_libsodium_model @h Lock
lock forall {k} (t :: k). Proxy t
Proxy
    ]
  where
    n :: TestName
n = forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> TestName
hashAlgorithmName proxy h
p

testPackedBytesN :: forall n. KnownNat n => TestHash n -> TestTree
testPackedBytesN :: forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN TestHash n
h = do
  TestName -> [TestTree] -> TestTree
testGroup
    (forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> TestName
hashAlgorithmName (forall {k} (t :: k). Proxy t
Proxy :: Proxy (TestHash n)))
    [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"roundtrip" forall a b. (a -> b) -> a -> b
$ forall (n :: Nat). KnownNat n => TestHash n -> Property
prop_roundtrip TestHash n
h
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"compare" forall a b. (a -> b) -> a -> b
$ forall (n :: Nat). KnownNat n => TestHash n -> Property
prop_compare TestHash n
h
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"xor" forall a b. (a -> b) -> a -> b
$ forall (n :: Nat). KnownNat n => TestHash n -> Property
prop_xor TestHash n
h
    ]

testPackedBytes :: TestTree
testPackedBytes :: TestTree
testPackedBytes =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"PackedBytes"
    [ forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 0)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 1)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 2)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 3)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 4)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 5)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 6)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 7)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 8)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 9)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 10)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 11)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 12)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 13)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 14)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 15)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 16)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 17)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 18)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 19)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 20)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 21)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 22)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 23)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 24)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 25)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 26)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 27)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 28)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 29)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 30)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 31)
    , forall (n :: Nat). KnownNat n => TestHash n -> TestTree
testPackedBytesN (forall (n :: Nat). TestHash n
TestHash :: TestHash 32)
    ]

prop_hash_cbor :: HashAlgorithm h => Hash h Int -> Property
prop_hash_cbor :: forall h. HashAlgorithm h => Hash h Int -> Property
prop_hash_cbor = forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_cbor

prop_hash_cbor_size :: HashAlgorithm h => Hash h Int -> Property
prop_hash_cbor_size :: forall h. HashAlgorithm h => Hash h Int -> Property
prop_hash_cbor_size = forall a. ToCBOR a => a -> Property
prop_cbor_size

prop_hash_correct_sizeHash ::
  forall h a.
  HashAlgorithm h =>
  Hash h a ->
  Property
prop_hash_correct_sizeHash :: forall h a. HashAlgorithm h => Hash h a -> Property
prop_hash_correct_sizeHash Hash h a
h =
  ByteString -> Int
BS.length (forall h a. Hash h a -> ByteString
hashToBytes Hash h a
h) forall a. (Eq a, Show a) => a -> a -> Property
=== forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (forall {k} (t :: k). Proxy t
Proxy :: Proxy h))

prop_hash_show_read ::
  forall h a.
  HashAlgorithm h =>
  Hash h a -> Property
prop_hash_show_read :: forall h a. HashAlgorithm h => Hash h a -> Property
prop_hash_show_read Hash h a
h = forall a. Read a => TestName -> a
read (forall a. Show a => a -> TestName
show Hash h a
h) forall a. (Eq a, Show a) => a -> a -> Property
=== Hash h a
h

prop_hash_hashFromStringAsHex_fromString ::
  forall h a.
  HashAlgorithm h =>
  Hash h a -> Property
prop_hash_hashFromStringAsHex_fromString :: forall h a. HashAlgorithm h => Hash h a -> Property
prop_hash_hashFromStringAsHex_fromString Hash h a
h = let s :: TestName
s = forall h a. Hash h a -> TestName
hashToStringAsHex Hash h a
h in forall a. HasCallStack => Maybe a -> a
fromJust (forall h a. HashAlgorithm h => TestName -> Maybe (Hash h a)
hashFromStringAsHex @h @a TestName
s) forall a. (Eq a, Show a) => a -> a -> Property
=== forall a. IsString a => TestName -> a
fromString TestName
s

prop_hash_hashFromStringAsHex_hashToStringFromHash ::
  forall h a.
  HashAlgorithm h =>
  Hash h a -> Property
prop_hash_hashFromStringAsHex_hashToStringFromHash :: forall h a. HashAlgorithm h => Hash h a -> Property
prop_hash_hashFromStringAsHex_hashToStringFromHash Hash h a
h = forall a. HasCallStack => Maybe a -> a
fromJust (forall h a. HashAlgorithm h => TestName -> Maybe (Hash h a)
hashFromStringAsHex @h @a (forall h a. Hash h a -> TestName
hashToStringAsHex Hash h a
h)) forall a. (Eq a, Show a) => a -> a -> Property
=== Hash h a
h

prop_libsodium_model ::
  forall h.
  NaCl.SodiumHashAlgorithm h =>
  Lock -> Proxy h -> BS.ByteString -> Property
prop_libsodium_model :: forall h.
SodiumHashAlgorithm h =>
Lock -> Proxy h -> ByteString -> Property
prop_libsodium_model Lock
lock Proxy h
p ByteString
bs = forall prop. Testable prop => IO prop -> Property
ioProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lock -> IO a -> IO a
withLock Lock
lock forall a b. (a -> b) -> a -> b
$ do
  ByteString
actual <-
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
      (forall h (proxy :: * -> *).
SodiumHashAlgorithm h =>
proxy h -> ByteString -> IO (MLockedSizedBytes (SizeHash h))
NaCl.digestMLockedBS Proxy h
p ByteString
bs)
      forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
NaCl.mlsbFinalize
      forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
NaCl.mlsbToByteString
  forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
expected forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString
actual)
  where
    expected :: ByteString
expected = forall h (proxy :: * -> *).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
digest Proxy h
p ByteString
bs

--
-- Arbitrary instances
--

instance HashAlgorithm h => Arbitrary (Hash h a) where
  arbitrary :: Gen (Hash h a)
arbitrary = forall h a b. Hash h a -> Hash h b
castHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith [Word8] -> ByteString
BS.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Int -> Gen [a]
vector Int
16
  shrink :: Hash h a -> [Hash h a]
shrink = forall a b. a -> b -> a
const []

--
-- Test Hash Algorithm
--

data TestHash (n :: Nat) = TestHash

instance KnownNat n => HashAlgorithm (TestHash n) where
  type SizeHash (TestHash n) = n
  hashAlgorithmName :: forall (proxy :: * -> *). proxy (TestHash n) -> TestName
hashAlgorithmName proxy (TestHash n)
px = TestName
"TestHash " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> TestName
show (forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash proxy (TestHash n)
px)
  digest :: forall (proxy :: * -> *).
proxy (TestHash n) -> ByteString -> ByteString
digest proxy (TestHash n)
px ByteString
_ = [Word8] -> ByteString
BS.pack (forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash proxy (TestHash n)
px)) Word8
0)

prop_roundtrip ::
  forall n.
  KnownNat n =>
  TestHash n ->
  Property
prop_roundtrip :: forall (n :: Nat). KnownNat n => TestHash n -> Property
prop_roundtrip TestHash n
h =
  forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall a. Int -> Gen a -> Gen [a]
vectorOf (forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal TestHash n
h)) forall a. Arbitrary a => Gen a
arbitrary) forall a b. (a -> b) -> a -> b
$ \[Word8]
xs ->
    let sbs :: ShortByteString
sbs = [Word8] -> ShortByteString
SBS.pack [Word8]
xs
        bs :: ByteString
bs = ShortByteString -> ByteString
SBS.fromShort ShortByteString
sbs
        sbsHash :: Maybe (Hash (TestHash n) ())
sbsHash = forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
hashFromBytesShort ShortByteString
sbs :: Maybe (Hash (TestHash n) ())
        bsHash :: Maybe (Hash (TestHash n) ())
bsHash = forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bs :: Maybe (Hash (TestHash n) ())
     in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall h a. Hash h a -> ShortByteString
hashToBytesShort Maybe (Hash (TestHash n) ())
sbsHash forall a. (Eq a, Show a) => a -> a -> Property
=== forall a. a -> Maybe a
Just ShortByteString
sbs
          forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall h a. Hash h a -> ByteString
hashToBytes Maybe (Hash (TestHash n) ())
bsHash forall a. (Eq a, Show a) => a -> a -> Property
=== forall a. a -> Maybe a
Just ByteString
bs

prop_compare ::
  forall n.
  KnownNat n =>
  TestHash n ->
  Property
prop_compare :: forall (n :: Nat). KnownNat n => TestHash n -> Property
prop_compare TestHash n
h =
  let n :: Int
n = forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal TestHash n
h)
      distinct :: Int -> Gen ([a], [a])
distinct Int
k = forall a. Int -> [a] -> ([a], [a])
splitAt Int
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
vectorOf (Int
k forall a. Num a => a -> a -> a
* Int
2) forall a. Arbitrary a => Gen a
arbitrary
      prefixCount :: Int
prefixCount = forall a. Ord a => a -> a -> a
max Int
0 (Int
n forall a. Num a => a -> a -> a
- Int
2)
      prefix :: [Word8]
prefix = forall a. Int -> a -> [a]
replicate Int
prefixCount Word8
0
      similar :: Gen ([Word8], [Word8])
similar = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ([Word8]
prefix forall a. [a] -> [a] -> [a]
++) ([Word8]
prefix forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}. Arbitrary a => Int -> Gen ([a], [a])
distinct (Int
n forall a. Num a => a -> a -> a
- Int
prefixCount)
   in forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
10, forall {a}. Arbitrary a => Int -> Gen ([a], [a])
distinct Int
n), (Int
40, Gen ([Word8], [Word8])
similar)]) forall a b. (a -> b) -> a -> b
$ \([Word8]
xs1, [Word8]
xs2) ->
        let sbs1 :: ShortByteString
sbs1 = [Word8] -> ShortByteString
SBS.pack [Word8]
xs1
            sbs2 :: ShortByteString
sbs2 = [Word8] -> ShortByteString
SBS.pack [Word8]
xs2
         in forall a. Ord a => a -> a -> Ordering
compare
              (forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
hashFromBytesShort ShortByteString
sbs1 :: Maybe (Hash (TestHash n) ()))
              (forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
hashFromBytesShort ShortByteString
sbs2 :: Maybe (Hash (TestHash n) ()))
              forall a. (Eq a, Show a) => a -> a -> Property
=== forall a. Ord a => a -> a -> Ordering
compare ShortByteString
sbs1 ShortByteString
sbs2

prop_xor ::
  forall n.
  KnownNat n =>
  TestHash n ->
  Property
prop_xor :: forall (n :: Nat). KnownNat n => TestHash n -> Property
prop_xor TestHash n
h =
  let n :: Int
n = forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal TestHash n
h)
   in forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Word8] -> ByteString
BS.pack [Word8] -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> ([a], [a])
splitAt Int
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
vectorOf (Int
n forall a. Num a => a -> a -> a
* Int
2) forall a. Arbitrary a => Gen a
arbitrary) forall a b. (a -> b) -> a -> b
$ \(ByteString
bs1, ByteString
bs2) ->
        forall a. a -> Maybe a
Just ([Word8] -> ByteString
BS.pack (forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
BS.zipWith forall a. Bits a => a -> a -> a
Bits.xor ByteString
bs1 ByteString
bs2))
          forall a. (Eq a, Show a) => a -> a -> Property
=== ( forall h a. Hash h a -> ByteString
hashToBytes
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall h a. Hash h a -> Hash h a -> Hash h a
xor
                          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bs1 :: Maybe (Hash (TestHash n) ()))
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bs2 :: Maybe (Hash (TestHash n) ()))
                      )
              )