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 =
  forall a.
Annotated ProtocolMagicId a
-> RequiresNetworkMagic -> AProtocolMagic a
AProtocolMagic
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall b a. b -> a -> Annotated b a
Annotated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ProtocolMagicId
genProtocolMagicId forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen 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 :: Gen ProtocolMagicId
genProtocolMagicId =
  Word32 -> ProtocolMagicId
ProtocolMagicId
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => Range Word32 -> m Word32
Gen.word32 (forall a. a -> a -> Range a
Range.constant Word32
0 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int32) forall a. Num a => a -> a -> a
- Word32
1)

genRequiresNetworkMagic :: Gen RequiresNetworkMagic
genRequiresNetworkMagic :: Gen RequiresNetworkMagic
genRequiresNetworkMagic = 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 =
  forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignForTestingOnly
    , forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignTx
    , forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignRedeemTx
    , forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignVssCert
    , forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignUSProposal
    , forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignCommitment
    , forall (f :: * -> *) a. Applicative f => a -> f a
pure SignTag
SignUSVote
    , VerificationKey -> SignTag
SignBlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen VerificationKey
genVerificationKey
    , 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
gen32Bytes

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

genSigningKey :: Gen SigningKey
genSigningKey :: Gen SigningKey
genSigningKey = forall a b. (a, b) -> b
snd 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 = forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
m (Maybe a) -> m a
Gen.just forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (RedeemVerificationKey, RedeemSigningKey)
redeemDeterministicKeyGen forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
gen32Bytes

genRedeemVerificationKey :: Gen RedeemVerificationKey
genRedeemVerificationKey :: Gen RedeemVerificationKey
genRedeemVerificationKey = forall a b. (a, b) -> a
fst 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen RedeemVerificationKey
genRedeemVerificationKey

genRedeemSigningKey :: Gen RedeemSigningKey
genRedeemSigningKey :: Gen RedeemSigningKey
genRedeemSigningKey = forall a b. (a, b) -> b
snd 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 = forall a.
EncCBOR a =>
ProtocolMagicId -> SignTag -> SigningKey -> a -> Signature a
sign ProtocolMagicId
pm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SignTag
genSignTag forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SigningKey
genSigningKey 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. Gen ByteString -> Gen (Signature a)
genSignatureEncoded Gen ByteString
genB =
  coerce :: forall a b. Coercible a b => a -> b
coerce 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ProtocolMagicId
genProtocolMagicId forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SignTag
genSignTag) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SigningKey
genSigningKey forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen 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 = forall a.
EncCBOR a =>
ProtocolMagicId
-> SignTag -> RedeemSigningKey -> a -> RedeemSignature a
redeemSign ProtocolMagicId
pm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SignTag
gst forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen RedeemSigningKey
grsk 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 = forall algo a.
(HashAlgorithm algo, EncCBOR a) =>
a -> AbstractHash algo a
abstractHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
genA

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

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

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

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

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

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

genTextHash :: Gen (Hash Text)
genTextHash :: Gen (Hash Text)
genTextHash = forall a. EncCBOR a => a -> Hash a
serializeCborHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10) 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 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen ProtocolMagicId
genProtocolMagicId