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

module Test.Cardano.Protocol.Praos.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)
import Cardano.Protocol.Crypto (Crypto (KES, VRF))
import Cardano.Protocol.Praos.BlockHeader (Header (Header, HeaderConstr), HeaderBody (HeaderBody))
import Cardano.Protocol.Praos.VRF (InputVRF, mkInputVRF)
import Test.Cardano.Ledger.Binary.Arbitrary ()
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Arbitrary ()
import Test.Cardano.Protocol.TPraos.BlockHeader.Arbitrary ()
import Test.Crypto.Instances ()

instance Arbitrary InputVRF where
  arbitrary :: Gen InputVRF
arbitrary = SlotNo -> Nonce -> InputVRF
mkInputVRF (SlotNo -> Nonce -> InputVRF)
-> Gen SlotNo -> Gen (Nonce -> InputVRF)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary Gen (Nonce -> InputVRF) -> Gen Nonce -> Gen InputVRF
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Nonce
forall a. Arbitrary a => Gen a
arbitrary

instance
  (Crypto c, VRF.Signable (VRF c) ~ SignableRepresentation) =>
  Arbitrary (HeaderBody c)
  where
  arbitrary :: Gen (HeaderBody c)
arbitrary =
    BlockNo
-> SlotNo
-> PrevHash
-> VKey BlockIssuer
-> VerKeyVRF (VRF c)
-> CertifiedVRF (VRF c) InputVRF
-> Word32
-> Hash HASH EraIndependentBlockBody
-> OCert c
-> ProtVer
-> HeaderBody c
forall crypto.
BlockNo
-> SlotNo
-> PrevHash
-> VKey BlockIssuer
-> VerKeyVRF (VRF crypto)
-> CertifiedVRF (VRF crypto) InputVRF
-> Word32
-> Hash HASH EraIndependentBlockBody
-> OCert crypto
-> ProtVer
-> HeaderBody crypto
HeaderBody
      (BlockNo
 -> SlotNo
 -> PrevHash
 -> VKey BlockIssuer
 -> VerKeyVRF (VRF c)
 -> CertifiedVRF (VRF c) InputVRF
 -> Word32
 -> Hash HASH EraIndependentBlockBody
 -> OCert c
 -> ProtVer
 -> HeaderBody c)
-> Gen BlockNo
-> Gen
     (SlotNo
      -> PrevHash
      -> VKey BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> HeaderBody 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) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> HeaderBody c)
-> Gen SlotNo
-> Gen
     (PrevHash
      -> VKey BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> HeaderBody 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) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> HeaderBody c)
-> Gen PrevHash
-> Gen
     (VKey BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> HeaderBody 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) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> HeaderBody c)
-> Gen (VKey BlockIssuer)
-> Gen
     (VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> HeaderBody 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) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> HeaderBody c)
-> Gen (VerKeyVRF (VRF c))
-> Gen
     (CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> HeaderBody 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) InputVRF
   -> Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> HeaderBody c)
-> Gen (CertifiedVRF (VRF c) InputVRF)
-> Gen
     (Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> HeaderBody 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) InputVRF)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Word32
   -> Hash HASH EraIndependentBlockBody
   -> OCert c
   -> ProtVer
   -> HeaderBody c)
-> Gen Word32
-> Gen
     (Hash HASH EraIndependentBlockBody
      -> OCert c -> ProtVer -> HeaderBody 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 -> HeaderBody c)
-> Gen (Hash HASH EraIndependentBlockBody)
-> Gen (OCert c -> ProtVer -> HeaderBody 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 -> HeaderBody c)
-> Gen (OCert c) -> Gen (ProtVer -> HeaderBody 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 -> HeaderBody c) -> Gen ProtVer -> Gen (HeaderBody 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 (Header c)
  where
  arbitrary :: Gen (Header c)
arbitrary = do
    hBody <- Gen (HeaderBody c)
forall a. Arbitrary a => Gen a
arbitrary
    period <- arbitrary
    sKey <- arbitrary
    let hSig = ContextKES (KES c)
-> Period
-> HeaderBody c
-> UnsoundPureSignKeyKES (KES c)
-> SignedKES (KES c) (HeaderBody c)
forall v a.
(UnsoundPureKESAlgorithm v, Signable v a) =>
ContextKES v
-> Period -> a -> UnsoundPureSignKeyKES v -> SignedKES v a
KES.unsoundPureSignedKES () Period
period HeaderBody c
hBody UnsoundPureSignKeyKES (KES c)
sKey
    pure $ Header hBody hSig

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

instance
  ( Crypto c
  , EraBlockBody era
  , KES.Signable (KES c) ~ SignableRepresentation
  , VRF.Signable (VRF c) ~ SignableRepresentation
  , Arbitrary (BlockBody era)
  ) =>
  Arbitrary (Block (Header c) era)
  where
  arbitrary :: Gen (Block (Header c) era)
arbitrary = Header c -> BlockBody era -> Block (Header c) era
forall h era. h -> BlockBody era -> Block h era
Block (Header c -> BlockBody era -> Block (Header c) era)
-> Gen (Header c) -> Gen (BlockBody era -> Block (Header c) era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Header c)
forall a. Arbitrary a => Gen a
arbitrary Gen (BlockBody era -> Block (Header c) era)
-> Gen (BlockBody era) -> Gen (Block (Header 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