{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Test.Cardano.Crypto.Hashing (
  tests,
)
where

import Cardano.Crypto (decodeAbstractHash, hashHexF, serializeCborHash)
import Cardano.Ledger.Binary (EncCBOR)
import Cardano.Prelude
import Formatting (sformat)
import Hedgehog (
  Gen,
  Property,
  checkParallel,
  discover,
  forAll,
  property,
  withTests,
  (/==),
  (===),
 )
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

--------------------------------------------------------------------------------
-- Main Test Action
--------------------------------------------------------------------------------

tests :: IO Bool
tests :: IO Bool
tests = forall (m :: * -> *). MonadIO m => Group -> m Bool
checkParallel $$String
[(PropertyName, Property)]
Property
String -> PropertyName
String -> GroupName
GroupName -> [(PropertyName, Property)] -> Group
prop_decodeAbstractHash :: Property
prop_goldenHash :: Property
prop_hashInequalityListOfList :: Property
prop_hashInequalityUnitList :: Property
prop_hashInequalityBool :: Property
discover

--------------------------------------------------------------------------------
-- Hashing Properties
--------------------------------------------------------------------------------

prop_hashInequalityBool :: Property
prop_hashInequalityBool :: Property
prop_hashInequalityBool = forall a. (Eq a, Show a, EncCBOR a) => Gen a -> Property
hashInequality forall (m :: * -> *). MonadGen m => m Bool
Gen.bool

prop_hashInequalityUnitList :: Property
prop_hashInequalityUnitList :: Property
prop_hashInequalityUnitList =
  forall a. (Eq a, Show a, EncCBOR a) => Gen a -> Property
hashInequality forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (forall a. a -> a -> Range a
Range.constant Int
0 Int
50) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

prop_hashInequalityListOfList :: Property
prop_hashInequalityListOfList :: Property
prop_hashInequalityListOfList =
  forall a. (Eq a, Show a, EncCBOR a) => Gen a -> Property
hashInequality forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list
      (forall a. a -> a -> Range a
Range.constant Int
0 Int
10)
      (forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (forall a. a -> a -> Range a
Range.constant Int
0 Int
20) (forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int forall a. (Bounded a, Num a) => Range a
Range.constantBounded))

-- | A golden test so that tests fail if the hash function changes
prop_goldenHash :: Property
prop_goldenHash :: Property
prop_goldenHash =
  TestLimit -> Property -> Property
withTests TestLimit
1
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
property
    forall a b. (a -> b) -> a -> b
$ forall a. Format Text a -> a
sformat forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF (forall a. EncCBOR a => a -> Hash a
serializeCborHash (Word64
1 :: Word64))
      forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== Text
"ee155ace9c40292074cb6aff8c9ccdd273c81648ff1149ef36bcea6ebb8a3e25"

-- | Check that 'decodeAbstractHash' correctly decodes hash values
prop_decodeAbstractHash :: Property
prop_decodeAbstractHash :: Property
prop_decodeAbstractHash = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  AbstractHash Blake2b_256 Int
a <- forall a. EncCBOR a => a -> Hash a
serializeCborHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int forall a. (Bounded a, Num a) => Range a
Range.constantBounded)
  forall algo a.
HashAlgorithm algo =>
Text -> Either Text (AbstractHash algo a)
decodeAbstractHash (forall a. Format Text a -> a
sformat forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF AbstractHash Blake2b_256 Int
a) forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== forall a b. b -> Either a b
Right AbstractHash Blake2b_256 Int
a

--------------------------------------------------------------------------------
-- Helpers
--------------------------------------------------------------------------------

-- | Check that hashing two different @a@ values gives different hashes
hashInequality :: (Eq a, Show a, EncCBOR a) => Gen a -> Property
hashInequality :: forall a. (Eq a, Show a, EncCBOR a) => Gen a -> Property
hashInequality Gen a
genA = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  a
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
genA
  a
b <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter (forall a. Eq a => a -> a -> Bool
/= a
a) Gen a
genA
  forall a. EncCBOR a => a -> Hash a
serializeCborHash a
a forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
/== forall a. EncCBOR a => a -> Hash a
serializeCborHash a
b