{-# LANGUAGE TemplateHaskell #-}

module Test.Cardano.Crypto.Signing.Redeem (
  tests,
) where

import Cardano.Crypto.Signing (SignTag (..))
import Cardano.Crypto.Signing.Redeem (
  redeemSign,
  redeemToVerification,
  verifyRedeemSig,
 )
import Cardano.Prelude
import Hedgehog (
  Property,
  assert,
  checkParallel,
  discover,
  forAll,
  property,
 )
import qualified Hedgehog.Gen as Gen
import qualified Test.Cardano.Crypto.Dummy as Dummy
import Test.Cardano.Crypto.Gen (
  genRedeemKeypair,
  genRedeemSigningKey,
  genRedeemVerificationKey,
 )
import Test.Cardano.Crypto.Signing.Signing (genData)

--------------------------------------------------------------------------------
-- 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_redeemSign :: Property
prop_redeemSignDifferentKey :: Property
prop_redeemSignDifferentData :: Property
discover

--------------------------------------------------------------------------------
-- Redeem Signature Properties
--------------------------------------------------------------------------------

-- | Signing and verification with a redeem keys works
prop_redeemSign :: Property
prop_redeemSign :: Property
prop_redeemSign = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  (RedeemVerificationKey
vk, RedeemSigningKey
sk) <- Gen (RedeemVerificationKey, RedeemSigningKey)
-> PropertyT IO (RedeemVerificationKey, RedeemSigningKey)
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen (RedeemVerificationKey, RedeemSigningKey)
genRedeemKeypair
  [Int32]
a <- Gen [Int32] -> PropertyT IO [Int32]
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen [Int32]
genData

  Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert
    (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ ProtocolMagicId
-> SignTag
-> RedeemVerificationKey
-> [Int32]
-> RedeemSignature [Int32]
-> Bool
forall a.
EncCBOR a =>
ProtocolMagicId
-> SignTag
-> RedeemVerificationKey
-> a
-> RedeemSignature a
-> Bool
verifyRedeemSig ProtocolMagicId
Dummy.protocolMagicId SignTag
SignForTestingOnly RedeemVerificationKey
vk [Int32]
a
    (RedeemSignature [Int32] -> Bool)
-> RedeemSignature [Int32] -> Bool
forall a b. (a -> b) -> a -> b
$ ProtocolMagicId
-> SignTag
-> RedeemSigningKey
-> [Int32]
-> RedeemSignature [Int32]
forall a.
EncCBOR a =>
ProtocolMagicId
-> SignTag -> RedeemSigningKey -> a -> RedeemSignature a
redeemSign ProtocolMagicId
Dummy.protocolMagicId SignTag
SignForTestingOnly RedeemSigningKey
sk [Int32]
a

-- | Signing fails when the wrong 'RedeemVerificationKey' is used
prop_redeemSignDifferentKey :: Property
prop_redeemSignDifferentKey :: Property
prop_redeemSignDifferentKey = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  RedeemSigningKey
sk <- Gen RedeemSigningKey -> PropertyT IO RedeemSigningKey
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen RedeemSigningKey
genRedeemSigningKey
  RedeemVerificationKey
vk <- Gen RedeemVerificationKey -> PropertyT IO RedeemVerificationKey
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen RedeemVerificationKey -> PropertyT IO RedeemVerificationKey)
-> Gen RedeemVerificationKey -> PropertyT IO RedeemVerificationKey
forall a b. (a -> b) -> a -> b
$ (RedeemVerificationKey -> Bool)
-> Gen RedeemVerificationKey -> Gen RedeemVerificationKey
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter (RedeemVerificationKey -> RedeemVerificationKey -> Bool
forall a. Eq a => a -> a -> Bool
/= RedeemSigningKey -> RedeemVerificationKey
redeemToVerification RedeemSigningKey
sk) Gen RedeemVerificationKey
genRedeemVerificationKey
  [Int32]
a <- Gen [Int32] -> PropertyT IO [Int32]
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen [Int32]
genData

  Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert
    (Bool -> PropertyT IO ())
-> (Bool -> Bool) -> Bool -> PropertyT IO ()
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
. Bool -> Bool
not
    (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ ProtocolMagicId
-> SignTag
-> RedeemVerificationKey
-> [Int32]
-> RedeemSignature [Int32]
-> Bool
forall a.
EncCBOR a =>
ProtocolMagicId
-> SignTag
-> RedeemVerificationKey
-> a
-> RedeemSignature a
-> Bool
verifyRedeemSig ProtocolMagicId
Dummy.protocolMagicId SignTag
SignForTestingOnly RedeemVerificationKey
vk [Int32]
a
    (RedeemSignature [Int32] -> Bool)
-> RedeemSignature [Int32] -> Bool
forall a b. (a -> b) -> a -> b
$ ProtocolMagicId
-> SignTag
-> RedeemSigningKey
-> [Int32]
-> RedeemSignature [Int32]
forall a.
EncCBOR a =>
ProtocolMagicId
-> SignTag -> RedeemSigningKey -> a -> RedeemSignature a
redeemSign ProtocolMagicId
Dummy.protocolMagicId SignTag
SignForTestingOnly RedeemSigningKey
sk [Int32]
a

-- | Signing fails when then wrong signature data is used
prop_redeemSignDifferentData :: Property
prop_redeemSignDifferentData :: Property
prop_redeemSignDifferentData = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  (RedeemVerificationKey
vk, RedeemSigningKey
sk) <- Gen (RedeemVerificationKey, RedeemSigningKey)
-> PropertyT IO (RedeemVerificationKey, RedeemSigningKey)
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen (RedeemVerificationKey, RedeemSigningKey)
genRedeemKeypair
  [Int32]
a <- Gen [Int32] -> PropertyT IO [Int32]
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen [Int32]
genData
  [Int32]
b <- Gen [Int32] -> PropertyT IO [Int32]
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen [Int32] -> PropertyT IO [Int32])
-> Gen [Int32] -> PropertyT IO [Int32]
forall a b. (a -> b) -> a -> b
$ ([Int32] -> Bool) -> Gen [Int32] -> Gen [Int32]
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter ([Int32] -> [Int32] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int32]
a) Gen [Int32]
genData

  Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert
    (Bool -> PropertyT IO ())
-> (Bool -> Bool) -> Bool -> PropertyT IO ()
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
. Bool -> Bool
not
    (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ ProtocolMagicId
-> SignTag
-> RedeemVerificationKey
-> [Int32]
-> RedeemSignature [Int32]
-> Bool
forall a.
EncCBOR a =>
ProtocolMagicId
-> SignTag
-> RedeemVerificationKey
-> a
-> RedeemSignature a
-> Bool
verifyRedeemSig ProtocolMagicId
Dummy.protocolMagicId SignTag
SignForTestingOnly RedeemVerificationKey
vk [Int32]
b
    (RedeemSignature [Int32] -> Bool)
-> RedeemSignature [Int32] -> Bool
forall a b. (a -> b) -> a -> b
$ ProtocolMagicId
-> SignTag
-> RedeemSigningKey
-> [Int32]
-> RedeemSignature [Int32]
forall a.
EncCBOR a =>
ProtocolMagicId
-> SignTag -> RedeemSigningKey -> a -> RedeemSignature a
redeemSign ProtocolMagicId
Dummy.protocolMagicId SignTag
SignForTestingOnly RedeemSigningKey
sk [Int32]
a