module Test.Cardano.Crypto.Gen (
  -- * Protocol Magic Generator
  genProtocolMagic,
  genProtocolMagicId,
  genRequiresNetworkMagic,

  -- * Sign Tag Generator
  genSignTag,

  -- * Key Generators
  genKeypair,
  genVerificationKey,
  genSigningKey,

  -- * Redeem Key Generators
  genRedeemKeypair,
  genRedeemVerificationKey,
  genCompactRedeemVerificationKey,
  genRedeemSigningKey,

  -- * Signature Generators
  genSignature,
  genSignatureEncoded,
  genRedeemSignature,

  -- * Hash Generators
  genAbstractHash,

  -- * SafeSigner Generators
  genSafeSigner,

  -- * PassPhrase Generators
  genPassPhrase,

  -- * Helper Generators
  genHashRaw,
  genTextHash,
  feedPM,
) where

import Cardano.Crypto (PassPhrase)
import Cardano.Crypto.Hashing (
  AbstractHash,
  Hash,
  HashAlgorithm,
  abstractHash,
  serializeCborHash,
 )
import Cardano.Crypto.ProtocolMagic (
  AProtocolMagic (..),
  ProtocolMagic,
  ProtocolMagicId (..),
  RequiresNetworkMagic (..),
 )
import Cardano.Crypto.Raw (Raw (..))
import Cardano.Crypto.Signing (
  SafeSigner (..),
  SignTag (..),
  Signature,
  SigningKey,
  VerificationKey,
  deterministicKeyGen,
  emptyPassphrase,
  sign,
  signRaw,
 )
import Cardano.Crypto.Signing.Redeem (
  CompactRedeemVerificationKey,
  RedeemSignature,
  RedeemSigningKey,
  RedeemVerificationKey,
  redeemDeterministicKeyGen,
  redeemSign,
  toCompactRedeemVerificationKey,
 )
import Cardano.Ledger.Binary (Annotated (..), EncCBOR)
import Cardano.Prelude
import qualified Data.ByteArray as ByteArray
import Data.Coerce (coerce)
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Cardano.Crypto.Orphans ()
import Test.Cardano.Prelude

--------------------------------------------------------------------------------
-- Protocol Magic Generator
--------------------------------------------------------------------------------

genProtocolMagic :: Gen ProtocolMagic
genProtocolMagic :: Gen ProtocolMagic
genProtocolMagic =
  Annotated ProtocolMagicId ()
-> RequiresNetworkMagic -> ProtocolMagic
forall a.
Annotated ProtocolMagicId a
-> RequiresNetworkMagic -> AProtocolMagic a
AProtocolMagic
    (Annotated ProtocolMagicId ()
 -> RequiresNetworkMagic -> ProtocolMagic)
-> GenT Identity (Annotated ProtocolMagicId ())
-> GenT Identity (RequiresNetworkMagic -> ProtocolMagic)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProtocolMagicId -> () -> Annotated ProtocolMagicId ()
forall b a. b -> a -> Annotated b a
Annotated (ProtocolMagicId -> () -> Annotated ProtocolMagicId ())
-> GenT Identity ProtocolMagicId
-> GenT Identity (() -> Annotated ProtocolMagicId ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity ProtocolMagicId
genProtocolMagicId GenT Identity (() -> Annotated ProtocolMagicId ())
-> GenT Identity () -> GenT Identity (Annotated ProtocolMagicId ())
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> GenT Identity ()
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    GenT Identity (RequiresNetworkMagic -> ProtocolMagic)
-> GenT Identity RequiresNetworkMagic -> Gen ProtocolMagic
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity RequiresNetworkMagic
genRequiresNetworkMagic

-- | Whilst 'ProtocolMagicId' is represented as a 'Word32' in cardano-ledger,
-- in @cardano-sl@ it was an 'Int32'. In order to tolerate this, and since we
-- don't care about testing compatibility with negative values, we only
-- generate values between @0@ and @(maxBound :: Int32) - 1@, inclusive.
genProtocolMagicId :: Gen ProtocolMagicId
genProtocolMagicId :: GenT Identity ProtocolMagicId
genProtocolMagicId =
  Word32 -> ProtocolMagicId
ProtocolMagicId
    (Word32 -> ProtocolMagicId)
-> GenT Identity Word32 -> GenT Identity ProtocolMagicId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word32 -> GenT Identity Word32
forall (m :: * -> *). MonadGen m => Range Word32 -> m Word32
Gen.word32 (Word32 -> Word32 -> Range Word32
forall a. a -> a -> Range a
Range.constant Word32
0 (Word32 -> Range Word32) -> Word32 -> Range Word32
forall a b. (a -> b) -> a -> b
$ Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
forall a. Bounded a => a
maxBound :: Int32) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1)

genRequiresNetworkMagic :: Gen RequiresNetworkMagic
genRequiresNetworkMagic :: GenT Identity RequiresNetworkMagic
genRequiresNetworkMagic = [RequiresNetworkMagic] -> GenT Identity RequiresNetworkMagic
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, MonadGen m) =>
f a -> m a
Gen.element [RequiresNetworkMagic
RequiresNoMagic, RequiresNetworkMagic
RequiresMagic]

--------------------------------------------------------------------------------
-- Sign Tag Generator
--------------------------------------------------------------------------------

genSignTag :: Gen SignTag
genSignTag :: Gen SignTag
genSignTag =
  [Gen SignTag] -> Gen SignTag
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ SignTag -> Gen SignTag
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignForTestingOnly
    , SignTag -> Gen SignTag
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignTx
    , SignTag -> Gen SignTag
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignRedeemTx
    , SignTag -> Gen SignTag
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignVssCert
    , SignTag -> Gen SignTag
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignUSProposal
    , SignTag -> Gen SignTag
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignCommitment
    , SignTag -> Gen SignTag
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignUSVote
    , VerificationKey -> SignTag
SignBlock (VerificationKey -> SignTag)
-> GenT Identity VerificationKey -> Gen SignTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity VerificationKey
genVerificationKey
    , SignTag -> Gen SignTag
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignCertificate
    ]

--------------------------------------------------------------------------------
-- Key Generators
--------------------------------------------------------------------------------

genKeypair :: Gen (VerificationKey, SigningKey)
genKeypair :: Gen (VerificationKey, SigningKey)
genKeypair = ByteString -> (VerificationKey, SigningKey)
deterministicKeyGen (ByteString -> (VerificationKey, SigningKey))
-> GenT Identity ByteString -> Gen (VerificationKey, SigningKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity ByteString
gen32Bytes

genVerificationKey :: Gen VerificationKey
genVerificationKey :: GenT Identity VerificationKey
genVerificationKey = (VerificationKey, SigningKey) -> VerificationKey
forall a b. (a, b) -> a
fst ((VerificationKey, SigningKey) -> VerificationKey)
-> Gen (VerificationKey, SigningKey)
-> GenT Identity VerificationKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VerificationKey, SigningKey)
genKeypair

genSigningKey :: Gen SigningKey
genSigningKey :: Gen SigningKey
genSigningKey = (VerificationKey, SigningKey) -> SigningKey
forall a b. (a, b) -> b
snd ((VerificationKey, SigningKey) -> SigningKey)
-> Gen (VerificationKey, SigningKey) -> Gen SigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VerificationKey, SigningKey)
genKeypair

--------------------------------------------------------------------------------
-- Redeem Key Generators
--------------------------------------------------------------------------------

genRedeemKeypair :: Gen (RedeemVerificationKey, RedeemSigningKey)
genRedeemKeypair :: Gen (RedeemVerificationKey, RedeemSigningKey)
genRedeemKeypair = GenT Identity (Maybe (RedeemVerificationKey, RedeemSigningKey))
-> Gen (RedeemVerificationKey, RedeemSigningKey)
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
m (Maybe a) -> m a
Gen.just (GenT Identity (Maybe (RedeemVerificationKey, RedeemSigningKey))
 -> Gen (RedeemVerificationKey, RedeemSigningKey))
-> GenT Identity (Maybe (RedeemVerificationKey, RedeemSigningKey))
-> Gen (RedeemVerificationKey, RedeemSigningKey)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (RedeemVerificationKey, RedeemSigningKey)
redeemDeterministicKeyGen (ByteString -> Maybe (RedeemVerificationKey, RedeemSigningKey))
-> GenT Identity ByteString
-> GenT Identity (Maybe (RedeemVerificationKey, RedeemSigningKey))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity ByteString
gen32Bytes

genRedeemVerificationKey :: Gen RedeemVerificationKey
genRedeemVerificationKey :: Gen RedeemVerificationKey
genRedeemVerificationKey = (RedeemVerificationKey, RedeemSigningKey) -> RedeemVerificationKey
forall a b. (a, b) -> a
fst ((RedeemVerificationKey, RedeemSigningKey)
 -> RedeemVerificationKey)
-> Gen (RedeemVerificationKey, RedeemSigningKey)
-> Gen RedeemVerificationKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (RedeemVerificationKey, RedeemSigningKey)
genRedeemKeypair

genCompactRedeemVerificationKey :: Gen CompactRedeemVerificationKey
genCompactRedeemVerificationKey :: Gen CompactRedeemVerificationKey
genCompactRedeemVerificationKey =
  RedeemVerificationKey -> CompactRedeemVerificationKey
toCompactRedeemVerificationKey (RedeemVerificationKey -> CompactRedeemVerificationKey)
-> Gen RedeemVerificationKey -> Gen CompactRedeemVerificationKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen RedeemVerificationKey
genRedeemVerificationKey

genRedeemSigningKey :: Gen RedeemSigningKey
genRedeemSigningKey :: Gen RedeemSigningKey
genRedeemSigningKey = (RedeemVerificationKey, RedeemSigningKey) -> RedeemSigningKey
forall a b. (a, b) -> b
snd ((RedeemVerificationKey, RedeemSigningKey) -> RedeemSigningKey)
-> Gen (RedeemVerificationKey, RedeemSigningKey)
-> Gen RedeemSigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (RedeemVerificationKey, RedeemSigningKey)
genRedeemKeypair

--------------------------------------------------------------------------------
-- Signature Generators
--------------------------------------------------------------------------------

genSignature :: EncCBOR a => ProtocolMagicId -> Gen a -> Gen (Signature a)
genSignature :: forall a.
EncCBOR a =>
ProtocolMagicId -> Gen a -> Gen (Signature a)
genSignature ProtocolMagicId
pm Gen a
genA = ProtocolMagicId -> SignTag -> SigningKey -> a -> Signature a
forall a.
EncCBOR a =>
ProtocolMagicId -> SignTag -> SigningKey -> a -> Signature a
sign ProtocolMagicId
pm (SignTag -> SigningKey -> a -> Signature a)
-> Gen SignTag -> GenT Identity (SigningKey -> a -> Signature a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SignTag
genSignTag GenT Identity (SigningKey -> a -> Signature a)
-> Gen SigningKey -> GenT Identity (a -> Signature a)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SigningKey
genSigningKey GenT Identity (a -> Signature a)
-> Gen a -> GenT Identity (Signature a)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
genA

genSignatureEncoded :: Gen ByteString -> Gen (Signature a)
genSignatureEncoded :: forall a. GenT Identity ByteString -> Gen (Signature a)
genSignatureEncoded GenT Identity ByteString
genB =
  (Maybe SignTag -> SigningKey -> ByteString -> Signature Raw)
-> Maybe SignTag -> SigningKey -> ByteString -> Signature a
forall a b. Coercible a b => a -> b
coerce ((Maybe SignTag -> SigningKey -> ByteString -> Signature Raw)
 -> Maybe SignTag -> SigningKey -> ByteString -> Signature a)
-> (ProtocolMagicId
    -> Maybe SignTag -> SigningKey -> ByteString -> Signature Raw)
-> ProtocolMagicId
-> Maybe SignTag
-> SigningKey
-> ByteString
-> Signature a
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
. ProtocolMagicId
-> Maybe SignTag -> SigningKey -> ByteString -> Signature Raw
signRaw (ProtocolMagicId
 -> Maybe SignTag -> SigningKey -> ByteString -> Signature a)
-> GenT Identity ProtocolMagicId
-> GenT
     Identity (Maybe SignTag -> SigningKey -> ByteString -> Signature a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity ProtocolMagicId
genProtocolMagicId GenT
  Identity (Maybe SignTag -> SigningKey -> ByteString -> Signature a)
-> GenT Identity (Maybe SignTag)
-> GenT Identity (SigningKey -> ByteString -> Signature a)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SignTag -> Maybe SignTag
forall a. a -> Maybe a
Just (SignTag -> Maybe SignTag)
-> Gen SignTag -> GenT Identity (Maybe SignTag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SignTag
genSignTag) GenT Identity (SigningKey -> ByteString -> Signature a)
-> Gen SigningKey -> GenT Identity (ByteString -> Signature a)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SigningKey
genSigningKey GenT Identity (ByteString -> Signature a)
-> GenT Identity ByteString -> GenT Identity (Signature a)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity ByteString
genB

genRedeemSignature ::
  EncCBOR a => ProtocolMagicId -> Gen a -> Gen (RedeemSignature a)
genRedeemSignature :: forall a.
EncCBOR a =>
ProtocolMagicId -> Gen a -> Gen (RedeemSignature a)
genRedeemSignature ProtocolMagicId
pm Gen a
genA = ProtocolMagicId
-> SignTag -> RedeemSigningKey -> a -> RedeemSignature a
forall a.
EncCBOR a =>
ProtocolMagicId
-> SignTag -> RedeemSigningKey -> a -> RedeemSignature a
redeemSign ProtocolMagicId
pm (SignTag -> RedeemSigningKey -> a -> RedeemSignature a)
-> Gen SignTag
-> GenT Identity (RedeemSigningKey -> a -> RedeemSignature a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SignTag
gst GenT Identity (RedeemSigningKey -> a -> RedeemSignature a)
-> Gen RedeemSigningKey -> GenT Identity (a -> RedeemSignature a)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen RedeemSigningKey
grsk GenT Identity (a -> RedeemSignature a)
-> Gen a -> GenT Identity (RedeemSignature a)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
genA
  where
    gst :: Gen SignTag
gst = Gen SignTag
genSignTag
    grsk :: Gen RedeemSigningKey
grsk = Gen RedeemSigningKey
genRedeemSigningKey

--------------------------------------------------------------------------------
-- Hash Generators
--------------------------------------------------------------------------------

genAbstractHash ::
  (EncCBOR a, HashAlgorithm algo) => Gen a -> Gen (AbstractHash algo a)
genAbstractHash :: forall a algo.
(EncCBOR a, HashAlgorithm algo) =>
Gen a -> Gen (AbstractHash algo a)
genAbstractHash Gen a
genA = a -> AbstractHash algo a
forall algo a.
(HashAlgorithm algo, EncCBOR a) =>
a -> AbstractHash algo a
abstractHash (a -> AbstractHash algo a)
-> Gen a -> GenT Identity (AbstractHash algo a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
genA

--------------------------------------------------------------------------------
-- PassPhrase Generators
--------------------------------------------------------------------------------

genPassPhrase :: Gen PassPhrase
genPassPhrase :: Gen PassPhrase
genPassPhrase = [Word8] -> PassPhrase
forall a. ByteArray a => [Word8] -> a
ByteArray.pack ([Word8] -> PassPhrase) -> GenT Identity [Word8] -> Gen PassPhrase
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity [Word8]
genWord8List
  where
    genWord8List :: Gen [Word8]
    genWord8List :: GenT Identity [Word8]
genWord8List =
      Range Int -> GenT Identity Word8 -> GenT Identity [Word8]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Range Int
forall a. a -> Range a
Range.singleton Int
32) (Range Word8 -> GenT Identity Word8
forall (m :: * -> *). MonadGen m => Range Word8 -> m Word8
Gen.word8 Range Word8
forall a. (Bounded a, Num a) => Range a
Range.constantBounded)

--------------------------------------------------------------------------------
-- SafeSigner Generators
--------------------------------------------------------------------------------

genSafeSigner :: Gen SafeSigner
genSafeSigner :: Gen SafeSigner
genSafeSigner = SigningKey -> PassPhrase -> SafeSigner
SafeSigner (SigningKey -> PassPhrase -> SafeSigner)
-> Gen SigningKey -> GenT Identity (PassPhrase -> SafeSigner)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SigningKey
genSigningKey GenT Identity (PassPhrase -> SafeSigner)
-> Gen PassPhrase -> Gen SafeSigner
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PassPhrase -> Gen PassPhrase
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PassPhrase
emptyPassphrase

--------------------------------------------------------------------------------
-- Helper Generators
--------------------------------------------------------------------------------

genHashRaw :: Gen (Hash Raw)
genHashRaw :: Gen (Hash Raw)
genHashRaw = Gen Raw -> Gen (Hash Raw)
forall a algo.
(EncCBOR a, HashAlgorithm algo) =>
Gen a -> Gen (AbstractHash algo a)
genAbstractHash (Gen Raw -> Gen (Hash Raw)) -> Gen Raw -> Gen (Hash Raw)
forall a b. (a -> b) -> a -> b
$ ByteString -> Raw
Raw (ByteString -> Raw) -> GenT Identity ByteString -> Gen Raw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity ByteString
gen32Bytes

genTextHash :: Gen (Hash Text)
genTextHash :: Gen (Hash Text)
genTextHash = Text -> Hash Text
forall a. EncCBOR a => a -> Hash a
serializeCborHash (Text -> Hash Text) -> GenT Identity Text -> Gen (Hash Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Char -> GenT Identity Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum

feedPM :: (ProtocolMagicId -> Gen a) -> Gen a
feedPM :: forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen a
genA = ProtocolMagicId -> Gen a
genA (ProtocolMagicId -> Gen a)
-> GenT Identity ProtocolMagicId -> Gen a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenT Identity ProtocolMagicId
genProtocolMagicId