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

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

import Cardano.Crypto.Signing (
  deterministicKeyGen,
  fullVerificationKeyF,
  parseFullVerificationKey,
  redeemDeterministicKeyGen,
  redeemToVerification,
  safeDeterministicKeyGen,
  toVerification,
 )
import Cardano.Prelude
import Formatting (sformat)
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Cardano.Crypto.Gen (genPassPhrase, genVerificationKey)

--------------------------------------------------------------------------------
-- 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_pubKeyDerivedGenerated :: Property
prop_pubKeyParsing :: Property
prop_redeemVerKeyDerivedGenerated :: Property
prop_safeVerKeyDerivedGenerated :: Property
discover

--------------------------------------------------------------------------------
-- Key Properties
--------------------------------------------------------------------------------

-- | Derived 'VerificationKey' is the same as generated one
prop_pubKeyDerivedGenerated :: Property
prop_pubKeyDerivedGenerated :: Property
prop_pubKeyDerivedGenerated = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  seed <- Gen ByteString -> PropertyT IO ByteString
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen ByteString -> PropertyT IO ByteString)
-> Gen ByteString -> PropertyT IO ByteString
forall a b. (a -> b) -> a -> b
$ Range Int -> Gen ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Int -> Range Int
forall a. a -> Range a
Range.singleton Int
32)
  let (vk, sk) = deterministicKeyGen seed
  vk === toVerification sk

prop_pubKeyParsing :: Property
prop_pubKeyParsing :: Property
prop_pubKeyParsing = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  vk <- Gen VerificationKey -> PropertyT IO VerificationKey
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen VerificationKey
genVerificationKey
  parseFullVerificationKey (sformat fullVerificationKeyF vk) === Right vk

-- | Derived 'RedeemVerificationKey' is the same as generated one
prop_redeemVerKeyDerivedGenerated :: Property
prop_redeemVerKeyDerivedGenerated :: Property
prop_redeemVerKeyDerivedGenerated = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  seed <- Gen ByteString -> PropertyT IO ByteString
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen ByteString -> PropertyT IO ByteString)
-> Gen ByteString -> PropertyT IO ByteString
forall a b. (a -> b) -> a -> b
$ Range Int -> Gen ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Int -> Range Int
forall a. a -> Range a
Range.singleton Int
32)
  let (vk, sk) =
        fromMaybe (panic "redeem keygen failed") $ redeemDeterministicKeyGen seed
  vk === redeemToVerification sk

-- | Derived 'VerificationKey' is the same as generated one
prop_safeVerKeyDerivedGenerated :: Property
prop_safeVerKeyDerivedGenerated :: Property
prop_safeVerKeyDerivedGenerated = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  pp <- Gen PassPhrase -> PropertyT IO PassPhrase
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen PassPhrase
genPassPhrase
  seed <- forAll $ Gen.bytes (Range.singleton 32)
  let (vk, sk) = safeDeterministicKeyGen seed pp
  vk === toVerification sk