{-# 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 = Group -> IO Bool
forall (m :: * -> *). MonadIO m => Group -> m Bool
checkParallel $$String
[(PropertyName, Property)]
Property
String -> GroupName
String -> PropertyName
GroupName -> [(PropertyName, Property)] -> Group
prop_hashInequalityBool :: Property
prop_hashInequalityUnitList :: Property
prop_hashInequalityListOfList :: Property
prop_goldenHash :: Property
prop_decodeAbstractHash :: Property
discover

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

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

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

prop_hashInequalityListOfList :: Property
prop_hashInequalityListOfList :: Property
prop_hashInequalityListOfList =
  Gen [[Maybe Int]] -> Property
forall a. (Eq a, Show a, EncCBOR a) => Gen a -> Property
hashInequality
    (Gen [[Maybe Int]] -> Property) -> Gen [[Maybe Int]] -> Property
forall a b. (a -> b) -> a -> b
$ Range Int -> GenT Identity [Maybe Int] -> Gen [[Maybe Int]]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list
      (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 Int
10)
      (Range Int -> GenT Identity (Maybe Int) -> GenT Identity [Maybe Int]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 Int
20) (GenT Identity Int -> GenT Identity (Maybe Int)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe (GenT Identity Int -> GenT Identity (Maybe Int))
-> GenT Identity Int -> GenT Identity (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Range Int -> GenT Identity Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int Range 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
    (Property -> Property)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
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
PropertyT IO () -> Property
property
    (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ Format Text (AbstractHash Blake2b_256 Word64 -> Text)
-> AbstractHash Blake2b_256 Word64 -> Text
forall a. Format Text a -> a
sformat Format Text (AbstractHash Blake2b_256 Word64 -> Text)
forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF (Word64 -> AbstractHash Blake2b_256 Word64
forall a. EncCBOR a => a -> Hash a
serializeCborHash (Word64
1 :: Word64))
    Text -> Text -> PropertyT IO ()
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
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  AbstractHash Blake2b_256 Int
a <- Int -> AbstractHash Blake2b_256 Int
forall a. EncCBOR a => a -> Hash a
serializeCborHash (Int -> AbstractHash Blake2b_256 Int)
-> PropertyT IO Int -> PropertyT IO (AbstractHash Blake2b_256 Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Int -> PropertyT IO Int
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Range Int -> GenT Identity Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int Range Int
forall a. (Bounded a, Num a) => Range a
Range.constantBounded)
  Text -> Either Text (AbstractHash Blake2b_256 Int)
forall algo a.
HashAlgorithm algo =>
Text -> Either Text (AbstractHash algo a)
decodeAbstractHash (Format Text (AbstractHash Blake2b_256 Int -> Text)
-> AbstractHash Blake2b_256 Int -> Text
forall a. Format Text a -> a
sformat Format Text (AbstractHash Blake2b_256 Int -> Text)
forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF AbstractHash Blake2b_256 Int
a) Either Text (AbstractHash Blake2b_256 Int)
-> Either Text (AbstractHash Blake2b_256 Int) -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== AbstractHash Blake2b_256 Int
-> Either Text (AbstractHash Blake2b_256 Int)
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
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  a
a <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
genA
  a
b <- Gen a -> PropertyT IO a
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen a -> PropertyT IO a) -> Gen a -> PropertyT IO a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> Gen a -> Gen a
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
a) Gen a
genA
  a -> Hash a
forall a. EncCBOR a => a -> Hash a
serializeCborHash a
a Hash a -> Hash a -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
/== a -> Hash a
forall a. EncCBOR a => a -> Hash a
serializeCborHash a
b