module Test.Cardano.Chain.Delegation.Gen (
  genCanonicalCertificate,
  genCertificate,
  genCanonicalCertificateDistinctList,
  genCertificateDistinctList,
  genError,
  genPayload,
) where

import Cardano.Chain.Delegation (
  ACertificate (delegateVK, issuerVK),
  Certificate,
  Payload,
  signCertificate,
  unsafePayload,
 )
import Cardano.Chain.Delegation.Validation.Scheduling (Error (..))
import Cardano.Chain.Slotting (EpochNumber (..))
import Cardano.Crypto (ProtocolMagicId)
import Cardano.Prelude
import Data.List (nub)
import Hedgehog (Gen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Cardano.Chain.Common.Gen (genKeyHash)
import Test.Cardano.Chain.Slotting.Gen (genEpochNumber, genSlotNumber)
import Test.Cardano.Crypto.Gen (genSafeSigner, genVerificationKey)

genCanonicalCertificate :: ProtocolMagicId -> Gen Certificate
genCanonicalCertificate :: ProtocolMagicId -> Gen Certificate
genCanonicalCertificate ProtocolMagicId
pm =
  ProtocolMagicId
-> VerificationKey -> EpochNumber -> SafeSigner -> Certificate
signCertificate ProtocolMagicId
pm
    (VerificationKey -> EpochNumber -> SafeSigner -> Certificate)
-> GenT Identity VerificationKey
-> GenT Identity (EpochNumber -> SafeSigner -> Certificate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity VerificationKey
genVerificationKey
    GenT Identity (EpochNumber -> SafeSigner -> Certificate)
-> GenT Identity EpochNumber
-> GenT Identity (SafeSigner -> Certificate)
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
<*> (Word64 -> EpochNumber
EpochNumber (Word64 -> EpochNumber)
-> GenT Identity Word64 -> GenT Identity EpochNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 (Word64 -> Word64 -> Range Word64
forall a. a -> a -> Range a
Range.constant Word64
0 Word64
1000000000000000))
    GenT Identity (SafeSigner -> Certificate)
-> GenT Identity SafeSigner -> Gen Certificate
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 SafeSigner
genSafeSigner

genCertificate :: ProtocolMagicId -> Gen Certificate
genCertificate :: ProtocolMagicId -> Gen Certificate
genCertificate ProtocolMagicId
pm =
  ProtocolMagicId
-> VerificationKey -> EpochNumber -> SafeSigner -> Certificate
signCertificate ProtocolMagicId
pm (VerificationKey -> EpochNumber -> SafeSigner -> Certificate)
-> GenT Identity VerificationKey
-> GenT Identity (EpochNumber -> SafeSigner -> Certificate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity VerificationKey
genVerificationKey GenT Identity (EpochNumber -> SafeSigner -> Certificate)
-> GenT Identity EpochNumber
-> GenT Identity (SafeSigner -> Certificate)
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 EpochNumber
genEpochNumber GenT Identity (SafeSigner -> Certificate)
-> GenT Identity SafeSigner -> Gen Certificate
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 SafeSigner
genSafeSigner

genCanonicalCertificateDistinctList :: ProtocolMagicId -> Gen [Certificate]
genCanonicalCertificateDistinctList :: ProtocolMagicId -> Gen [Certificate]
genCanonicalCertificateDistinctList ProtocolMagicId
pm =
  [Certificate] -> [Certificate]
noSelfSigningCerts ([Certificate] -> [Certificate])
-> Gen [Certificate] -> Gen [Certificate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Certificate] -> Bool) -> Gen [Certificate] -> Gen [Certificate]
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter [Certificate] -> Bool
forall a. Eq a => [a] -> Bool
allDistinct Gen [Certificate]
pSKList
  where
    pSKList :: Gen [Certificate]
pSKList = Range Int -> Gen Certificate -> Gen [Certificate]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
5) (ProtocolMagicId -> Gen Certificate
genCanonicalCertificate ProtocolMagicId
pm)

    allDistinct :: Eq a => [a] -> Bool
    allDistinct :: forall a. Eq a => [a] -> Bool
allDistinct [a]
ls = [a] -> Int
forall a. HasLength a => a -> Int
length ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
ls) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall a. HasLength a => a -> Int
length [a]
ls

    noSelfSigningCerts :: [Certificate] -> [Certificate]
    noSelfSigningCerts :: [Certificate] -> [Certificate]
noSelfSigningCerts = (Certificate -> Bool) -> [Certificate] -> [Certificate]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Certificate
x -> Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
issuerVK Certificate
x VerificationKey -> VerificationKey -> Bool
forall a. Eq a => a -> a -> Bool
/= Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
delegateVK Certificate
x)

genCertificateDistinctList :: ProtocolMagicId -> Gen [Certificate]
genCertificateDistinctList :: ProtocolMagicId -> Gen [Certificate]
genCertificateDistinctList ProtocolMagicId
pm =
  [Certificate] -> [Certificate]
noSelfSigningCerts ([Certificate] -> [Certificate])
-> Gen [Certificate] -> Gen [Certificate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Certificate] -> Bool) -> Gen [Certificate] -> Gen [Certificate]
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter [Certificate] -> Bool
forall a. Eq a => [a] -> Bool
allDistinct Gen [Certificate]
pSKList
  where
    pSKList :: Gen [Certificate]
pSKList = Range Int -> Gen Certificate -> Gen [Certificate]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
5) (ProtocolMagicId -> Gen Certificate
genCertificate ProtocolMagicId
pm)

    allDistinct :: Eq a => [a] -> Bool
    allDistinct :: forall a. Eq a => [a] -> Bool
allDistinct [a]
ls = [a] -> Int
forall a. HasLength a => a -> Int
length ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
ls) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall a. HasLength a => a -> Int
length [a]
ls

    noSelfSigningCerts :: [Certificate] -> [Certificate]
    noSelfSigningCerts :: [Certificate] -> [Certificate]
noSelfSigningCerts = (Certificate -> Bool) -> [Certificate] -> [Certificate]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Certificate
x -> Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
issuerVK Certificate
x VerificationKey -> VerificationKey -> Bool
forall a. Eq a => a -> a -> Bool
/= Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
delegateVK Certificate
x)

genError :: Gen Error
genError :: Gen Error
genError =
  [Gen Error] -> Gen Error
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ Error -> Gen Error
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Error
InvalidCertificate
    , EpochNumber -> KeyHash -> Error
MultipleDelegationsForEpoch (EpochNumber -> KeyHash -> Error)
-> GenT Identity EpochNumber -> GenT Identity (KeyHash -> Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity EpochNumber
genEpochNumber GenT Identity (KeyHash -> Error)
-> GenT Identity KeyHash -> Gen Error
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 KeyHash
genKeyHash
    , SlotNumber -> KeyHash -> Error
MultipleDelegationsForSlot (SlotNumber -> KeyHash -> Error)
-> GenT Identity SlotNumber -> GenT Identity (KeyHash -> Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity SlotNumber
genSlotNumber GenT Identity (KeyHash -> Error)
-> GenT Identity KeyHash -> Gen Error
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 KeyHash
genKeyHash
    , KeyHash -> Error
NonGenesisDelegator (KeyHash -> Error) -> GenT Identity KeyHash -> Gen Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity KeyHash
genKeyHash
    , EpochNumber -> EpochNumber -> Error
WrongEpoch (EpochNumber -> EpochNumber -> Error)
-> GenT Identity EpochNumber
-> GenT Identity (EpochNumber -> Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity EpochNumber
genEpochNumber GenT Identity (EpochNumber -> Error)
-> GenT Identity EpochNumber -> Gen Error
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 EpochNumber
genEpochNumber
    ]

genPayload :: ProtocolMagicId -> Gen Payload
genPayload :: ProtocolMagicId -> Gen Payload
genPayload ProtocolMagicId
pm =
  [Certificate] -> Payload
unsafePayload ([Certificate] -> Payload) -> Gen [Certificate] -> Gen Payload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> Gen Certificate -> Gen [Certificate]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
5) (ProtocolMagicId -> Gen Certificate
genCertificate ProtocolMagicId
pm)