{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Protocol.TPraos.BlockHeader.Arbitrary () where

import qualified Cardano.Crypto.KES as KES
import Cardano.Crypto.Util (SignableRepresentation)
import qualified Cardano.Crypto.VRF as VRF
import Cardano.Ledger.Binary (DecCBOR)
import Cardano.Ledger.Block (Block (Block))
import Cardano.Ledger.Core (BlockBody, EraBlockBody, TopTx, Tx)
import Cardano.Ledger.Hashes (HashHeader (HashHeader))
import Cardano.Protocol.Crypto (Crypto (KES, VRF))
import Cardano.Protocol.TPraos.BlockHeader (
  BHBody (BHBody),
  BHeader (BHeader, BHeaderConstr),
  PrevHash (BlockHash, GenesisHash),
 )
import Cardano.Protocol.TPraos.OCert (KESPeriod (KESPeriod), OCert (..))
import Test.Cardano.Ledger.Binary.Arbitrary ()
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Arbitrary ()
import Test.Crypto.Instances ()

instance Crypto c => Arbitrary (OCert c) where
  arbitrary :: Gen (OCert c)
arbitrary =
    VerKeyKES (KES c)
-> Word64
-> KESPeriod
-> SignedDSIGN DSIGN (OCertSignable c)
-> OCert c
forall c.
VerKeyKES (KES c)
-> Word64
-> KESPeriod
-> SignedDSIGN DSIGN (OCertSignable c)
-> OCert c
OCert
      (VerKeyKES (KES c)
 -> Word64
 -> KESPeriod
 -> SignedDSIGN DSIGN (OCertSignable c)
 -> OCert c)
-> Gen (VerKeyKES (KES c))
-> Gen
     (Word64
      -> KESPeriod -> SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VerKeyKES (KES c))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Word64
   -> KESPeriod -> SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
-> Gen Word64
-> Gen
     (KESPeriod -> SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
      Gen (KESPeriod -> SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
-> Gen KESPeriod
-> Gen (SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen KESPeriod
forall a. Arbitrary a => Gen a
arbitrary
      Gen (SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
-> Gen (SignedDSIGN DSIGN (OCertSignable c)) -> Gen (OCert c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (SignedDSIGN DSIGN (OCertSignable c))
forall a. Arbitrary a => Gen a
arbitrary

deriving newtype instance Arbitrary KESPeriod

instance Arbitrary PrevHash where
  arbitrary :: Gen PrevHash
arbitrary = [(Int, Gen PrevHash)] -> Gen PrevHash
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, PrevHash -> Gen PrevHash
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrevHash
GenesisHash), (Int
9999, HashHeader -> PrevHash
BlockHash (HashHeader -> PrevHash)
-> (Hash HASH EraIndependentBlockHeader -> HashHeader)
-> Hash HASH EraIndependentBlockHeader
-> PrevHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash HASH EraIndependentBlockHeader -> HashHeader
HashHeader (Hash HASH EraIndependentBlockHeader -> PrevHash)
-> Gen (Hash HASH EraIndependentBlockHeader) -> Gen PrevHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash HASH EraIndependentBlockHeader)
forall a. Arbitrary a => Gen a
arbitrary)]

instance
  ( Crypto c
  , VRF.Signable (VRF c) ~ SignableRepresentation
  ) =>
  Arbitrary (BHBody c)
  where
  arbitrary :: Gen (BHBody c)
arbitrary =
    BlockNo
-> SlotNo
-> PrevHash
-> VKey BlockIssuer
-> VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) Nonce
-> CertifiedVRF (VRF c) Natural
-> Word32
-> Hash HASH EraIndependentBlockBody
-> OCert c
-> ProtVer
-> BHBody c
forall c.
BlockNo
-> SlotNo
-> PrevHash
-> VKey BlockIssuer
-> VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) Nonce
-> CertifiedVRF (VRF c) Natural
-> Word32
-> Hash HASH EraIndependentBlockBody
-> OCert c
-> ProtVer
-> BHBody c
BHBody
      (BlockNo
 -> SlotNo
 -> PrevHash
 -> VKey BlockIssuer
 -> VerKeyVRF (VRF c)
 -> CertifiedVRF (VRF c) Nonce
 -> CertifiedVRF (VRF c) Natural
 -> Word32
 -> Hash HASH EraIndependentBlockBody
 -> OCert c
 -> ProtVer
 -> BHBody c)
-> Gen BlockNo
-> Gen
     (SlotNo
      -> PrevHash
      -> VKey BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) Nonce
      -> CertifiedVRF (VRF c) Natural
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> BHBody c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen BlockNo
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (SlotNo
   -> PrevHash
   -> VKey BlockIssuer
   -> VerKeyVRF (VRF c)
   -> CertifiedVRF (VRF c) Nonce
   -> CertifiedVRF (VRF c) Natural
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> BHBody c)
-> Gen SlotNo
-> Gen
     (PrevHash
      -> VKey BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) Nonce
      -> CertifiedVRF (VRF c) Natural
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (PrevHash
   -> VKey BlockIssuer
   -> VerKeyVRF (VRF c)
   -> CertifiedVRF (VRF c) Nonce
   -> CertifiedVRF (VRF c) Natural
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> BHBody c)
-> Gen PrevHash
-> Gen
     (VKey BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) Nonce
      -> CertifiedVRF (VRF c) Natural
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PrevHash
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (VKey BlockIssuer
   -> VerKeyVRF (VRF c)
   -> CertifiedVRF (VRF c) Nonce
   -> CertifiedVRF (VRF c) Natural
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> BHBody c)
-> Gen (VKey BlockIssuer)
-> Gen
     (VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) Nonce
      -> CertifiedVRF (VRF c) Natural
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (VKey BlockIssuer)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (VerKeyVRF (VRF c)
   -> CertifiedVRF (VRF c) Nonce
   -> CertifiedVRF (VRF c) Natural
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> BHBody c)
-> Gen (VerKeyVRF (VRF c))
-> Gen
     (CertifiedVRF (VRF c) Nonce
      -> CertifiedVRF (VRF c) Natural
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (VerKeyVRF (VRF c))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (CertifiedVRF (VRF c) Nonce
   -> CertifiedVRF (VRF c) Natural
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> BHBody c)
-> Gen (CertifiedVRF (VRF c) Nonce)
-> Gen
     (CertifiedVRF (VRF c) Natural
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (CertifiedVRF (VRF c) Nonce)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (CertifiedVRF (VRF c) Natural
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> BHBody c)
-> Gen (CertifiedVRF (VRF c) Natural)
-> Gen
     (Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (CertifiedVRF (VRF c) Natural)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> BHBody c)
-> Gen Word32
-> Gen
     (Hash HASH EraIndependentBlockBody
      -> OCert c -> ProtVer -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Hash HASH EraIndependentBlockBody
   -> OCert c -> ProtVer -> BHBody c)
-> Gen (Hash HASH EraIndependentBlockBody)
-> Gen (OCert c -> ProtVer -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Hash HASH EraIndependentBlockBody)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (OCert c -> ProtVer -> BHBody c)
-> Gen (OCert c) -> Gen (ProtVer -> BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (OCert c)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (ProtVer -> BHBody c) -> Gen ProtVer -> Gen (BHBody c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ProtVer
forall a. Arbitrary a => Gen a
arbitrary

instance
  ( Crypto c
  , VRF.Signable (VRF c) ~ SignableRepresentation
  , KES.Signable (KES c) ~ SignableRepresentation
  ) =>
  Arbitrary (BHeader c)
  where
  arbitrary :: Gen (BHeader c)
arbitrary = do
    bhBody <- Gen (BHBody c)
forall a. Arbitrary a => Gen a
arbitrary
    hotKey <- arbitrary
    let sig = ContextKES (KES c)
-> Word
-> BHBody c
-> UnsoundPureSignKeyKES (KES c)
-> SignedKES (KES c) (BHBody c)
forall v a.
(UnsoundPureKESAlgorithm v, Signable v a) =>
ContextKES v
-> Word -> a -> UnsoundPureSignKeyKES v -> SignedKES v a
KES.unsoundPureSignedKES () Word
1 BHBody c
bhBody UnsoundPureSignKeyKES (KES c)
hotKey
    pure $ BHeader bhBody sig

instance
  ( Crypto c
  , EraBlockBody era
  , KES.Signable (KES c) ~ SignableRepresentation
  , VRF.Signable (VRF c) ~ SignableRepresentation
  , Arbitrary (Tx TopTx era)
  , Arbitrary (BlockBody era)
  ) =>
  Arbitrary (Block (BHeader c) era)
  where
  arbitrary :: Gen (Block (BHeader c) era)
arbitrary =
    BHeader c -> BlockBody era -> Block (BHeader c) era
forall h era. h -> BlockBody era -> Block h era
Block
      (BHeader c -> BlockBody era -> Block (BHeader c) era)
-> Gen (BHeader c) -> Gen (BlockBody era -> Block (BHeader c) era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (BHeader c)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (BlockBody era -> Block (BHeader c) era)
-> Gen (BlockBody era) -> Gen (Block (BHeader c) era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (BlockBody era)
forall a. Arbitrary a => Gen a
arbitrary

deriving newtype instance Crypto c => DecCBOR (BHeader c)