{-# 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
  ByteString
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 (VerificationKey
vk, SigningKey
sk) = ByteString -> (VerificationKey, SigningKey)
deterministicKeyGen ByteString
seed
  VerificationKey
vk VerificationKey -> VerificationKey -> PropertyT IO ()
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
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  VerificationKey
vk <- Gen VerificationKey -> PropertyT IO VerificationKey
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen VerificationKey
genVerificationKey
  Text -> Either VerificationKeyParseError VerificationKey
parseFullVerificationKey (Format Text (VerificationKey -> Text) -> VerificationKey -> Text
forall a. Format Text a -> a
sformat Format Text (VerificationKey -> Text)
forall r. Format r (VerificationKey -> r)
fullVerificationKeyF VerificationKey
vk) Either VerificationKeyParseError VerificationKey
-> Either VerificationKeyParseError VerificationKey
-> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== VerificationKey -> Either VerificationKeyParseError VerificationKey
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
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  ByteString
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 (RedeemVerificationKey
vk, RedeemSigningKey
sk) =
        (RedeemVerificationKey, RedeemSigningKey)
-> Maybe (RedeemVerificationKey, RedeemSigningKey)
-> (RedeemVerificationKey, RedeemSigningKey)
forall a. a -> Maybe a -> a
fromMaybe (Text -> (RedeemVerificationKey, RedeemSigningKey)
forall a. HasCallStack => Text -> a
panic Text
"redeem keygen failed") (Maybe (RedeemVerificationKey, RedeemSigningKey)
 -> (RedeemVerificationKey, RedeemSigningKey))
-> Maybe (RedeemVerificationKey, RedeemSigningKey)
-> (RedeemVerificationKey, RedeemSigningKey)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (RedeemVerificationKey, RedeemSigningKey)
redeemDeterministicKeyGen ByteString
seed
  RedeemVerificationKey
vk RedeemVerificationKey -> RedeemVerificationKey -> PropertyT IO ()
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
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  PassPhrase
pp <- Gen PassPhrase -> PropertyT IO PassPhrase
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen PassPhrase
genPassPhrase
  ByteString
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 (VerificationKey
vk, SigningKey
sk) = ByteString -> PassPhrase -> (VerificationKey, SigningKey)
safeDeterministicKeyGen ByteString
seed PassPhrase
pp
  VerificationKey
vk VerificationKey -> VerificationKey -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== SigningKey -> VerificationKey
toVerification SigningKey
sk