{-# 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 = forall (m :: * -> *). MonadIO m => Group -> m Bool
checkParallel $$String
[(PropertyName, Property)]
Property
String -> PropertyName
String -> GroupName
GroupName -> [(PropertyName, Property)] -> Group
prop_safeVerKeyDerivedGenerated :: Property
prop_redeemVerKeyDerivedGenerated :: Property
prop_pubKeyParsing :: Property
prop_pubKeyDerivedGenerated :: Property
discover

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

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

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

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

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