{-# 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_bad_cbor_bytes,
  prop_cbor,
  prop_cbor_size,
  prop_no_thunks,
  prop_raw_deserialise,
  withLock,
 )
import Test.Hspec (Spec, describe)
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck
import Test.QuickCheck.Instances ()

import qualified Cardano.Crypto.Libsodium as NaCl

--
-- The list of all tests
--
tests :: Lock -> Spec
tests :: Lock -> Spec
tests Lock
lock =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Crypto.Hash" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    Proxy SHA256 -> Spec
forall (proxy :: * -> *) h. HashAlgorithm h => proxy h -> Spec
testHashAlgorithm (Proxy SHA256
forall {k} (t :: k). Proxy t
Proxy :: Proxy SHA256)
    Proxy SHA3_256 -> Spec
forall (proxy :: * -> *) h. HashAlgorithm h => proxy h -> Spec
testHashAlgorithm (Proxy SHA3_256
forall {k} (t :: k). Proxy t
Proxy :: Proxy SHA3_256)
    Proxy Blake2b_224 -> Spec
forall (proxy :: * -> *) h. HashAlgorithm h => proxy h -> Spec
testHashAlgorithm (Proxy Blake2b_224
forall {k} (t :: k). Proxy t
Proxy :: Proxy Blake2b_224)
    Proxy Blake2b_256 -> Spec
forall (proxy :: * -> *) h. HashAlgorithm h => proxy h -> Spec
testHashAlgorithm (Proxy Blake2b_256
forall {k} (t :: k). Proxy t
Proxy :: Proxy Blake2b_256)
    Proxy Keccak256 -> Spec
forall (proxy :: * -> *) h. HashAlgorithm h => proxy h -> Spec
testHashAlgorithm (Proxy Keccak256
forall {k} (t :: k). Proxy t
Proxy :: Proxy Keccak256)
    Lock -> Proxy SHA256 -> Spec
forall (proxy :: * -> *) h.
SodiumHashAlgorithm h =>
Lock -> proxy h -> Spec
testSodiumHashAlgorithm Lock
lock (Proxy SHA256
forall {k} (t :: k). Proxy t
Proxy :: Proxy SHA256)
    Lock -> Proxy Blake2b_256 -> Spec
forall (proxy :: * -> *) h.
SodiumHashAlgorithm h =>
Lock -> proxy h -> Spec
testSodiumHashAlgorithm Lock
lock (Proxy Blake2b_256
forall {k} (t :: k). Proxy t
Proxy :: Proxy Blake2b_256)
    Proxy SHA512 -> Spec
forall (proxy :: * -> *) h. HashAlgorithm h => proxy h -> Spec
testHashAlgorithm (Proxy SHA512
forall {k} (t :: k). Proxy t
Proxy :: Proxy SHA512)
    Proxy SHA3_512 -> Spec
forall (proxy :: * -> *) h. HashAlgorithm h => proxy h -> Spec
testHashAlgorithm (Proxy SHA3_512
forall {k} (t :: k). Proxy t
Proxy :: Proxy SHA3_512)
    Spec
testPackedBytes

testHashAlgorithm ::
  forall proxy h.
  HashAlgorithm h =>
  proxy h ->
  Spec
testHashAlgorithm :: forall (proxy :: * -> *) h. HashAlgorithm h => proxy h -> Spec
testHashAlgorithm proxy h
p =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (proxy h -> String
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> String
forall (proxy :: * -> *). proxy h -> String
hashAlgorithmName proxy h
p) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> (Hash h [Int] -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"hash size" ((Hash h [Int] -> Property) -> Spec)
-> (Hash h [Int] -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ forall h a. HashAlgorithm h => Hash h a -> Property
prop_hash_correct_sizeHash @h @[Int]
    String -> (Hash h Int -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"serialise" ((Hash h Int -> Property) -> Spec)
-> (Hash h Int -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ forall h. HashAlgorithm h => Hash h Int -> Property
prop_hash_cbor @h
    String -> (BadInputFor (Hash h ()) -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"fail fromCBOR" ((BadInputFor (Hash h ()) -> Property) -> Spec)
-> (BadInputFor (Hash h ()) -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ forall a. (Show a, FromCBOR a) => BadInputFor a -> Property
prop_bad_cbor_bytes @(Hash h ())
    String -> (BadInputFor (Hash h ()) -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"hashFromBytes" ((BadInputFor (Hash h ()) -> Property) -> Spec)
-> (BadInputFor (Hash h ()) -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe (Hash h ()))
-> BadInputFor (Hash h ()) -> Property
forall a.
Show a =>
(ByteString -> Maybe a) -> BadInputFor a -> Property
prop_raw_deserialise (forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes @h @())
    String -> (BadInputFor (Hash h ()) -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"hashFromBytesShort" ((BadInputFor (Hash h ()) -> Property) -> Spec)
-> (BadInputFor (Hash h ()) -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe (Hash h ()))
-> BadInputFor (Hash h ()) -> Property
forall a.
Show a =>
(ByteString -> Maybe a) -> BadInputFor a -> Property
prop_raw_deserialise (forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
hashFromBytesShort @h @() (ShortByteString -> Maybe (Hash h ()))
-> (ByteString -> ShortByteString)
-> ByteString
-> Maybe (Hash h ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort)
    String -> (Hash h Int -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"ToCBOR size" ((Hash h Int -> Property) -> Spec)
-> (Hash h Int -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ forall h. HashAlgorithm h => Hash h Int -> Property
prop_hash_cbor_size @h
    String -> (Hash h Float -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"hashFromStringAsHex/hashToStringFromHash" ((Hash h Float -> Property) -> Spec)
-> (Hash h Float -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$
      forall h a. HashAlgorithm h => Hash h a -> Property
prop_hash_hashFromStringAsHex_hashToStringFromHash @h @Float
    String -> (Hash h Float -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"hashFromStringAsHex/fromString" ((Hash h Float -> Property) -> Spec)
-> (Hash h Float -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ forall h a. HashAlgorithm h => Hash h a -> Property
prop_hash_hashFromStringAsHex_fromString @h @Float
    String -> (Hash h Float -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"show/read" ((Hash h Float -> Property) -> Spec)
-> (Hash h Float -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ forall h a. HashAlgorithm h => Hash h a -> Property
prop_hash_show_read @h @Float
    String -> (Hash h Int -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"NoThunks" ((Hash h Int -> Property) -> Spec)
-> (Hash h Int -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ forall a. NoThunks a => a -> Property
prop_no_thunks @(Hash h Int)
    String -> (Hash h Int -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"MemPack RoundTrip" ((Hash h Int -> Property) -> Spec)
-> (Hash h Int -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ forall a. (MemPack a, Eq a, Show a) => a -> Property
prop_MemPackRoundTrip @(Hash h Int)

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 =
  ByteArray -> a
forall a b. (MemPack a, Buffer b, HasCallStack) => b -> a
unpackError (a -> ByteArray
forall a. (MemPack a, HasCallStack) => a -> ByteArray
pack a
a) a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a
    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. ByteString -> a
forall a b. (MemPack a, Buffer b, HasCallStack) => b -> a
unpackError (a -> ByteString
forall a. (MemPack a, HasCallStack) => a -> ByteString
packByteString a
a) a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
a

testSodiumHashAlgorithm ::
  forall proxy h.
  NaCl.SodiumHashAlgorithm h =>
  Lock ->
  proxy h ->
  Spec
testSodiumHashAlgorithm :: forall (proxy :: * -> *) h.
SodiumHashAlgorithm h =>
Lock -> proxy h -> Spec
testSodiumHashAlgorithm Lock
lock proxy h
p =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (proxy h -> String
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> String
forall (proxy :: * -> *). proxy h -> String
hashAlgorithmName proxy h
p) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> (ByteString -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"sodium and crypton work the same" ((ByteString -> Property) -> Spec)
-> (ByteString -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ forall h.
SodiumHashAlgorithm h =>
Lock -> Proxy h -> ByteString -> Property
prop_libsodium_model @h Lock
lock Proxy h
forall {k} (t :: k). Proxy t
Proxy

testPackedBytesN :: forall n. KnownNat n => TestHash n -> Spec
testPackedBytesN :: forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN TestHash n
h = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (Proxy (TestHash n) -> String
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> String
forall (proxy :: * -> *). proxy (TestHash n) -> String
hashAlgorithmName (Proxy (TestHash n)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (TestHash n))) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"roundtrip" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$ TestHash n -> Property
forall (n :: Nat). KnownNat n => TestHash n -> Property
prop_roundtrip TestHash n
h
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"compare" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$ TestHash n -> Property
forall (n :: Nat). KnownNat n => TestHash n -> Property
prop_compare TestHash n
h
    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"xor" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$ TestHash n -> Property
forall (n :: Nat). KnownNat n => TestHash n -> Property
prop_xor TestHash n
h

testPackedBytes :: Spec
testPackedBytes :: Spec
testPackedBytes =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"PackedBytes" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    TestHash 0 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 0
forall (n :: Nat). TestHash n
TestHash :: TestHash 0)
    TestHash 1 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 1
forall (n :: Nat). TestHash n
TestHash :: TestHash 1)
    TestHash 2 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 2
forall (n :: Nat). TestHash n
TestHash :: TestHash 2)
    TestHash 3 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 3
forall (n :: Nat). TestHash n
TestHash :: TestHash 3)
    TestHash 4 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 4
forall (n :: Nat). TestHash n
TestHash :: TestHash 4)
    TestHash 5 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 5
forall (n :: Nat). TestHash n
TestHash :: TestHash 5)
    TestHash 6 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 6
forall (n :: Nat). TestHash n
TestHash :: TestHash 6)
    TestHash 7 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 7
forall (n :: Nat). TestHash n
TestHash :: TestHash 7)
    TestHash 8 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 8
forall (n :: Nat). TestHash n
TestHash :: TestHash 8)
    TestHash 9 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 9
forall (n :: Nat). TestHash n
TestHash :: TestHash 9)
    TestHash 10 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 10
forall (n :: Nat). TestHash n
TestHash :: TestHash 10)
    TestHash 11 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 11
forall (n :: Nat). TestHash n
TestHash :: TestHash 11)
    TestHash 12 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 12
forall (n :: Nat). TestHash n
TestHash :: TestHash 12)
    TestHash 13 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 13
forall (n :: Nat). TestHash n
TestHash :: TestHash 13)
    TestHash 14 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 14
forall (n :: Nat). TestHash n
TestHash :: TestHash 14)
    TestHash 15 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 15
forall (n :: Nat). TestHash n
TestHash :: TestHash 15)
    TestHash 16 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 16
forall (n :: Nat). TestHash n
TestHash :: TestHash 16)
    TestHash 17 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 17
forall (n :: Nat). TestHash n
TestHash :: TestHash 17)
    TestHash 18 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 18
forall (n :: Nat). TestHash n
TestHash :: TestHash 18)
    TestHash 19 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 19
forall (n :: Nat). TestHash n
TestHash :: TestHash 19)
    TestHash 20 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 20
forall (n :: Nat). TestHash n
TestHash :: TestHash 20)
    TestHash 21 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 21
forall (n :: Nat). TestHash n
TestHash :: TestHash 21)
    TestHash 22 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 22
forall (n :: Nat). TestHash n
TestHash :: TestHash 22)
    TestHash 23 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 23
forall (n :: Nat). TestHash n
TestHash :: TestHash 23)
    TestHash 24 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 24
forall (n :: Nat). TestHash n
TestHash :: TestHash 24)
    TestHash 25 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 25
forall (n :: Nat). TestHash n
TestHash :: TestHash 25)
    TestHash 26 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 26
forall (n :: Nat). TestHash n
TestHash :: TestHash 26)
    TestHash 27 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 27
forall (n :: Nat). TestHash n
TestHash :: TestHash 27)
    TestHash 28 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 28
forall (n :: Nat). TestHash n
TestHash :: TestHash 28)
    TestHash 29 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 29
forall (n :: Nat). TestHash n
TestHash :: TestHash 29)
    TestHash 30 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 30
forall (n :: Nat). TestHash n
TestHash :: TestHash 30)
    TestHash 31 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 31
forall (n :: Nat). TestHash n
TestHash :: TestHash 31)
    TestHash 32 -> Spec
forall (n :: Nat). KnownNat n => TestHash n -> Spec
testPackedBytesN (TestHash 32
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 = Hash h Int -> Property
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 = Hash h Int -> Property
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 (Hash h a -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash h a
h) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (Proxy h
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 = String -> Hash h a
forall a. Read a => String -> a
read (Hash h a -> String
forall a. Show a => a -> String
show Hash h a
h) Hash h a -> Hash h a -> Property
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 :: String
s = Hash h a -> String
forall h a. Hash h a -> String
hashToStringAsHex Hash h a
h in Maybe (Hash h a) -> Hash h a
forall a. HasCallStack => Maybe a -> a
fromJust (forall h a. HashAlgorithm h => String -> Maybe (Hash h a)
hashFromStringAsHex @h @a String
s) Hash h a -> Hash h a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== String -> Hash h a
forall a. IsString a => String -> a
fromString String
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 = Maybe (Hash h a) -> Hash h a
forall a. HasCallStack => Maybe a -> a
fromJust (forall h a. HashAlgorithm h => String -> Maybe (Hash h a)
hashFromStringAsHex @h @a (Hash h a -> String
forall h a. Hash h a -> String
hashToStringAsHex Hash h a
h)) Hash h a -> Hash h a -> Property
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 = IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property)
-> (IO Property -> IO Property) -> IO Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lock -> IO Property -> IO Property
forall a. Lock -> IO a -> IO a
withLock Lock
lock (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
  ByteString
actual <-
    IO (MLockedSizedBytes (SizeHash h))
-> (MLockedSizedBytes (SizeHash h) -> IO ())
-> (MLockedSizedBytes (SizeHash h) -> IO ByteString)
-> IO ByteString
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
      (Proxy h -> ByteString -> IO (MLockedSizedBytes (SizeHash h))
forall h (proxy :: * -> *).
SodiumHashAlgorithm h =>
proxy h -> ByteString -> IO (MLockedSizedBytes (SizeHash h))
NaCl.digestMLockedBS Proxy h
p ByteString
bs)
      MLockedSizedBytes (SizeHash h) -> IO ()
forall (m :: * -> *) (n :: Nat).
MonadST m =>
MLockedSizedBytes n -> m ()
NaCl.mlsbFinalize
      MLockedSizedBytes (SizeHash h) -> IO ByteString
forall (n :: Nat) (m :: * -> *).
(KnownNat n, MonadST m) =>
MLockedSizedBytes n -> m ByteString
NaCl.mlsbToByteString
  Property -> IO Property
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
expected ByteString -> ByteString -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString
actual)
  where
    expected :: ByteString
expected = Proxy h -> ByteString -> ByteString
forall h (proxy :: * -> *).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
forall (proxy :: * -> *). 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 = Hash h [Word8] -> Hash h a
forall h a b. Hash h a -> Hash h b
castHash (Hash h [Word8] -> Hash h a)
-> ([Word8] -> Hash h [Word8]) -> [Word8] -> Hash h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Word8] -> ByteString) -> [Word8] -> Hash h [Word8]
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith [Word8] -> ByteString
BS.pack ([Word8] -> Hash h a) -> Gen [Word8] -> Gen (Hash h a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
vector Int
16
  shrink :: Hash h a -> [Hash h a]
shrink = [Hash h a] -> Hash h a -> [Hash h a]
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) -> String
hashAlgorithmName proxy (TestHash n)
px = String
"TestHash " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show (proxy (TestHash n) -> Word
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 (Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (proxy (TestHash n) -> Word
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 =
  Gen [Word8] -> ([Word8] -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (TestHash n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal TestHash n
h)) Gen Word8
forall a. Arbitrary a => Gen a
arbitrary) (([Word8] -> Property) -> Property)
-> ([Word8] -> Property) -> Property
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 = ShortByteString -> Maybe (Hash (TestHash n) ())
forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
hashFromBytesShort ShortByteString
sbs :: Maybe (Hash (TestHash n) ())
        bsHash :: Maybe (Hash (TestHash n) ())
bsHash = ByteString -> Maybe (Hash (TestHash n) ())
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bs :: Maybe (Hash (TestHash n) ())
     in (Hash (TestHash n) () -> ShortByteString)
-> Maybe (Hash (TestHash n) ()) -> Maybe ShortByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash (TestHash n) () -> ShortByteString
forall h a. Hash h a -> ShortByteString
hashToBytesShort Maybe (Hash (TestHash n) ())
sbsHash Maybe ShortByteString -> Maybe ShortByteString -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ShortByteString -> Maybe ShortByteString
forall a. a -> Maybe a
Just ShortByteString
sbs
          Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (Hash (TestHash n) () -> ByteString)
-> Maybe (Hash (TestHash n) ()) -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash (TestHash n) () -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Maybe (Hash (TestHash n) ())
bsHash Maybe ByteString -> Maybe ByteString -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString -> Maybe ByteString
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 = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (TestHash n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal TestHash n
h)
      distinct :: Int -> Gen ([a], [a])
distinct Int
k = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
k ([a] -> ([a], [a])) -> Gen [a] -> Gen ([a], [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen a -> Gen [a]
forall a. Int -> Gen a -> Gen [a]
vectorOf (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Gen a
forall a. Arbitrary a => Gen a
arbitrary
      prefixCount :: Int
prefixCount = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
      prefix :: [Word8]
prefix = Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
prefixCount Word8
0
      similar :: Gen ([Word8], [Word8])
similar = ([Word8] -> [Word8])
-> ([Word8] -> [Word8]) -> ([Word8], [Word8]) -> ([Word8], [Word8])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ([Word8]
prefix [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++) ([Word8]
prefix [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++) (([Word8], [Word8]) -> ([Word8], [Word8]))
-> Gen ([Word8], [Word8]) -> Gen ([Word8], [Word8])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ([Word8], [Word8])
forall {a}. Arbitrary a => Int -> Gen ([a], [a])
distinct (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
prefixCount)
   in Gen ([Word8], [Word8])
-> (([Word8], [Word8]) -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ([(Int, Gen ([Word8], [Word8]))] -> Gen ([Word8], [Word8])
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
10, Int -> Gen ([Word8], [Word8])
forall {a}. Arbitrary a => Int -> Gen ([a], [a])
distinct Int
n), (Int
40, Gen ([Word8], [Word8])
similar)]) ((([Word8], [Word8]) -> Property) -> Property)
-> (([Word8], [Word8]) -> Property) -> Property
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 Maybe (Hash (TestHash n) ())
-> Maybe (Hash (TestHash n) ()) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
              (ShortByteString -> Maybe (Hash (TestHash n) ())
forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
hashFromBytesShort ShortByteString
sbs1 :: Maybe (Hash (TestHash n) ()))
              (ShortByteString -> Maybe (Hash (TestHash n) ())
forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
hashFromBytesShort ShortByteString
sbs2 :: Maybe (Hash (TestHash n) ()))
              Ordering -> Ordering -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ShortByteString -> ShortByteString -> Ordering
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 = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (TestHash n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal TestHash n
h)
   in Gen (ByteString, ByteString)
-> ((ByteString, ByteString) -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (([Word8] -> ByteString)
-> ([Word8] -> ByteString)
-> ([Word8], [Word8])
-> (ByteString, ByteString)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
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 (([Word8], [Word8]) -> (ByteString, ByteString))
-> ([Word8] -> ([Word8], [Word8]))
-> [Word8]
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> ([Word8], [Word8])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n ([Word8] -> (ByteString, ByteString))
-> Gen [Word8] -> Gen (ByteString, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Gen Word8
forall a. Arbitrary a => Gen a
arbitrary) (((ByteString, ByteString) -> Property) -> Property)
-> ((ByteString, ByteString) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(ByteString
bs1, ByteString
bs2) ->
        ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ([Word8] -> ByteString
BS.pack ((Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> [Word8]
forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
BS.zipWith Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
Bits.xor ByteString
bs1 ByteString
bs2))
          Maybe ByteString -> Maybe ByteString -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ( Hash (TestHash n) () -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes
                  (Hash (TestHash n) () -> ByteString)
-> Maybe (Hash (TestHash n) ()) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Hash (TestHash n) ()
-> Hash (TestHash n) () -> Hash (TestHash n) ()
forall h a. Hash h a -> Hash h a -> Hash h a
xor
                          (Hash (TestHash n) ()
 -> Hash (TestHash n) () -> Hash (TestHash n) ())
-> Maybe (Hash (TestHash n) ())
-> Maybe (Hash (TestHash n) () -> Hash (TestHash n) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Maybe (Hash (TestHash n) ())
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bs1 :: Maybe (Hash (TestHash n) ()))
                          Maybe (Hash (TestHash n) () -> Hash (TestHash n) ())
-> Maybe (Hash (TestHash n) ()) -> Maybe (Hash (TestHash n) ())
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> Maybe (Hash (TestHash n) ())
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bs2 :: Maybe (Hash (TestHash n) ()))
                      )
              )