{-# LANGUAGE TemplateHaskell #-}

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

import Cardano.Crypto.Signing (SignTag (..), sign, toVerification, verifySignature)
import Cardano.Ledger.Binary (encCBOR)
import Cardano.Prelude
import Hedgehog (
  Gen,
  Property,
  assert,
  checkParallel,
  discover,
  forAll,
  property,
 )
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import qualified Test.Cardano.Crypto.Dummy as Dummy
import Test.Cardano.Crypto.Gen (
  genKeypair,
  genSigningKey,
  genVerificationKey,
 )

--------------------------------------------------------------------------------
-- 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_signDifferentData :: Property
prop_signDifferentKey :: Property
prop_sign :: Property
discover

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

-- | Signing and verification works
prop_sign :: Property
prop_sign :: Property
prop_sign = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  (VerificationKey
vk, SigningKey
sk) <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen (VerificationKey, SigningKey)
genKeypair
  [Int32]
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen [Int32]
genData

  forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert forall a b. (a -> b) -> a -> b
$
    forall a.
(a -> Encoding)
-> ProtocolMagicId
-> SignTag
-> VerificationKey
-> a
-> Signature a
-> Bool
verifySignature forall a. EncCBOR a => a -> Encoding
encCBOR ProtocolMagicId
Dummy.protocolMagicId SignTag
SignForTestingOnly VerificationKey
vk [Int32]
a forall a b. (a -> b) -> a -> b
$
      forall a.
EncCBOR a =>
ProtocolMagicId -> SignTag -> SigningKey -> a -> Signature a
sign ProtocolMagicId
Dummy.protocolMagicId SignTag
SignForTestingOnly SigningKey
sk [Int32]
a

-- | Signing fails when the wrong 'VerificationKey' is used
prop_signDifferentKey :: Property
prop_signDifferentKey :: Property
prop_signDifferentKey = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  SigningKey
sk <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen SigningKey
genSigningKey
  VerificationKey
vk <- 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
/= SigningKey -> VerificationKey
toVerification SigningKey
sk) Gen VerificationKey
genVerificationKey
  [Int32]
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen [Int32]
genData

  forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert
    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
    forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Encoding)
-> ProtocolMagicId
-> SignTag
-> VerificationKey
-> a
-> Signature a
-> Bool
verifySignature forall a. EncCBOR a => a -> Encoding
encCBOR ProtocolMagicId
Dummy.protocolMagicId SignTag
SignForTestingOnly VerificationKey
vk [Int32]
a
    forall a b. (a -> b) -> a -> b
$ forall a.
EncCBOR a =>
ProtocolMagicId -> SignTag -> SigningKey -> a -> Signature a
sign ProtocolMagicId
Dummy.protocolMagicId SignTag
SignForTestingOnly SigningKey
sk [Int32]
a

-- | Signing fails when then wrong signature data is used
prop_signDifferentData :: Property
prop_signDifferentData :: Property
prop_signDifferentData = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  (VerificationKey
vk, SigningKey
sk) <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen (VerificationKey, SigningKey)
genKeypair
  [Int32]
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen [Int32]
genData
  [Int32]
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
/= [Int32]
a) Gen [Int32]
genData

  forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert
    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
    forall a b. (a -> b) -> a -> b
$ forall a.
(a -> Encoding)
-> ProtocolMagicId
-> SignTag
-> VerificationKey
-> a
-> Signature a
-> Bool
verifySignature forall a. EncCBOR a => a -> Encoding
encCBOR ProtocolMagicId
Dummy.protocolMagicId SignTag
SignForTestingOnly VerificationKey
vk [Int32]
b
    forall a b. (a -> b) -> a -> b
$ forall a.
EncCBOR a =>
ProtocolMagicId -> SignTag -> SigningKey -> a -> Signature a
sign ProtocolMagicId
Dummy.protocolMagicId SignTag
SignForTestingOnly SigningKey
sk [Int32]
a

genData :: Gen [Int32]
genData :: Gen [Int32]
genData = 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 (m :: * -> *). MonadGen m => Range Int32 -> m Int32
Gen.int32 forall a. (Bounded a, Num a) => Range a
Range.constantBounded)