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

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

instance Arbitrary EbAnnouncement where
  arbitrary :: Gen EbAnnouncement
arbitrary = SafeHash EraIndependentEb -> Word32 -> EbAnnouncement
EbAnnouncement (SafeHash EraIndependentEb -> Word32 -> EbAnnouncement)
-> Gen (SafeHash EraIndependentEb)
-> Gen (Word32 -> EbAnnouncement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SafeHash EraIndependentEb)
forall a. Arbitrary a => Gen a
arbitrary Gen (Word32 -> EbAnnouncement) -> Gen Word32 -> Gen EbAnnouncement
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

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
-> Bool
-> StrictMaybe EbAnnouncement
-> HeaderBody c
forall crypto.
BlockNo
-> SlotNo
-> PrevHash
-> VKey BlockIssuer
-> VerKeyVRF (VRF crypto)
-> CertifiedVRF (VRF crypto) InputVRF
-> Word32
-> Hash HASH EraIndependentBlockBody
-> OCert crypto
-> ProtVer
-> Bool
-> StrictMaybe EbAnnouncement
-> HeaderBody crypto
HeaderBody
      (BlockNo
 -> SlotNo
 -> PrevHash
 -> VKey BlockIssuer
 -> VerKeyVRF (VRF c)
 -> CertifiedVRF (VRF c) InputVRF
 -> Word32
 -> Hash HASH EraIndependentBlockBody
 -> OCert c
 -> ProtVer
 -> Bool
 -> StrictMaybe EbAnnouncement
 -> HeaderBody c)
-> Gen BlockNo
-> Gen
     (SlotNo
      -> PrevHash
      -> VKey BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> Bool
      -> StrictMaybe EbAnnouncement
      -> 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
   -> Bool
   -> StrictMaybe EbAnnouncement
   -> HeaderBody c)
-> Gen SlotNo
-> Gen
     (PrevHash
      -> VKey BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> Bool
      -> StrictMaybe EbAnnouncement
      -> 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
   -> Bool
   -> StrictMaybe EbAnnouncement
   -> HeaderBody c)
-> Gen PrevHash
-> Gen
     (VKey BlockIssuer
      -> VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> Bool
      -> StrictMaybe EbAnnouncement
      -> 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
   -> Bool
   -> StrictMaybe EbAnnouncement
   -> HeaderBody c)
-> Gen (VKey BlockIssuer)
-> Gen
     (VerKeyVRF (VRF c)
      -> CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> Bool
      -> StrictMaybe EbAnnouncement
      -> 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
   -> Bool
   -> StrictMaybe EbAnnouncement
   -> HeaderBody c)
-> Gen (VerKeyVRF (VRF c))
-> Gen
     (CertifiedVRF (VRF c) InputVRF
      -> Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> Bool
      -> StrictMaybe EbAnnouncement
      -> 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
   -> Bool
   -> StrictMaybe EbAnnouncement
   -> HeaderBody c)
-> Gen (CertifiedVRF (VRF c) InputVRF)
-> Gen
     (Word32
      -> Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> Bool
      -> StrictMaybe EbAnnouncement
      -> 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
   -> Bool
   -> StrictMaybe EbAnnouncement
   -> HeaderBody c)
-> Gen Word32
-> Gen
     (Hash HASH EraIndependentBlockBody
      -> OCert c
      -> ProtVer
      -> Bool
      -> StrictMaybe EbAnnouncement
      -> 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
   -> Bool
   -> StrictMaybe EbAnnouncement
   -> HeaderBody c)
-> Gen (Hash HASH EraIndependentBlockBody)
-> Gen
     (OCert c
      -> ProtVer -> Bool -> StrictMaybe EbAnnouncement -> 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 -> Bool -> StrictMaybe EbAnnouncement -> HeaderBody c)
-> Gen (OCert c)
-> Gen
     (ProtVer -> Bool -> StrictMaybe EbAnnouncement -> 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 -> Bool -> StrictMaybe EbAnnouncement -> HeaderBody c)
-> Gen ProtVer
-> Gen (Bool -> StrictMaybe EbAnnouncement -> 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
      Gen (Bool -> StrictMaybe EbAnnouncement -> HeaderBody c)
-> Gen Bool -> Gen (StrictMaybe EbAnnouncement -> 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 Bool
forall a. Arbitrary a => Gen a
arbitrary
      Gen (StrictMaybe EbAnnouncement -> HeaderBody c)
-> Gen (StrictMaybe EbAnnouncement) -> 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 (StrictMaybe EbAnnouncement)
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