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

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

genCanonicalCertificateDistinctList :: ProtocolMagicId -> Gen [Certificate]
genCanonicalCertificateDistinctList :: ProtocolMagicId -> Gen [Certificate]
genCanonicalCertificateDistinctList ProtocolMagicId
pm =
  [Certificate] -> [Certificate]
noSelfSigningCerts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter forall a. Eq a => [a] -> Bool
allDistinct Gen [Certificate]
pSKList
  where
    pSKList :: Gen [Certificate]
pSKList = forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (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 = forall a. HasLength a => a -> Int
length (forall a. Eq a => [a] -> [a]
nub [a]
ls) forall a. Eq a => a -> a -> Bool
== forall a. HasLength a => a -> Int
length [a]
ls

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

genCertificateDistinctList :: ProtocolMagicId -> Gen [Certificate]
genCertificateDistinctList :: ProtocolMagicId -> Gen [Certificate]
genCertificateDistinctList ProtocolMagicId
pm =
  [Certificate] -> [Certificate]
noSelfSigningCerts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter forall a. Eq a => [a] -> Bool
allDistinct Gen [Certificate]
pSKList
  where
    pSKList :: Gen [Certificate]
pSKList = forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (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 = forall a. HasLength a => a -> Int
length (forall a. Eq a => [a] -> [a]
nub [a]
ls) forall a. Eq a => a -> a -> Bool
== forall a. HasLength a => a -> Int
length [a]
ls

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

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