{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Allegra.Binary.Golden (
  spec,
  allegraDecodeDuplicateDelegCertSucceeds,
  module Test.Cardano.Ledger.Shelley.Binary.Golden,
) where

import Cardano.Ledger.Allegra.Core (
  AllegraEraTxBody (..),
  ShelleyEraTxCert,
  ValidityInterval (..),
  pattern DelegStakeTxCert,
 )
import Cardano.Ledger.Binary (Version)
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.MemoBytes (EqRaw (..))
import Cardano.Ledger.Shelley.Core (EraTxBody (..), TxLevel (..))
import Data.Maybe.Strict (StrictMaybe (..))
import qualified Data.Sequence.Strict as SSeq
import Lens.Micro ((&), (.~))
import Test.Cardano.Ledger.Allegra.Era (AllegraEraTest)
import Test.Cardano.Ledger.Common (Spec, describe, it, prop)
import Test.Cardano.Ledger.Core.KeyPair (mkKeyHash)
import Test.Cardano.Ledger.Imp.Common (forEachEraVersion)
import Test.Cardano.Ledger.Shelley.Binary.Golden

allegraDecodeDuplicateDelegCertSucceeds ::
  forall era. (AllegraEraTest era, ShelleyEraTxCert era) => Version -> Spec
allegraDecodeDuplicateDelegCertSucceeds :: forall era.
(AllegraEraTest era, ShelleyEraTxCert era) =>
Version -> Spec
allegraDecodeDuplicateDelegCertSucceeds Version
version =
  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Decodes duplicate delegation certificates successfully" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    let testCert :: TxCert era
testCert = forall era.
ShelleyEraTxCert era =>
Credential Staking -> KeyHash StakePool -> TxCert era
DelegStakeTxCert @era (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> KeyHash Staking -> Credential Staking
forall a b. (a -> b) -> a -> b
$ Int -> KeyHash Staking
forall (kd :: KeyRole). Int -> KeyHash kd
mkKeyHash Int
0) (Int -> KeyHash StakePool
forall (kd :: KeyRole). Int -> KeyHash kd
mkKeyHash Int
1)
    (TxBody TopTx era -> TxBody TopTx era -> Bool)
-> Version -> Enc -> TxBody TopTx era -> Expectation
forall a.
(DecCBOR (Annotator a), HasCallStack, Show a, Eq a) =>
(a -> a -> Bool) -> Version -> Enc -> a -> Expectation
expectDecoderSuccessAnnWith TxBody TopTx era -> TxBody TopTx era -> Bool
forall a. EqRaw a => a -> a -> Bool
eqRaw Version
version (forall era. ShelleyEraTest era => Version -> Enc
duplicateDelegCertsTxBody @era Version
version) (TxBody TopTx era -> Expectation)
-> TxBody TopTx era -> Expectation
forall a b. (a -> b) -> a -> b
$
      forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
mkBasicTxBody @era @TopTx
        TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> StrictSeq (TxCert era) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
SSeq.fromList [TxCert era
testCert, TxCert era
testCert]
        TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (ValidityInterval -> Identity ValidityInterval)
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel). Lens' (TxBody l era) ValidityInterval
vldtTxBodyL ((ValidityInterval -> Identity ValidityInterval)
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> ValidityInterval -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
300)

spec ::
  forall era.
  ( AllegraEraTest era
  , ShelleyEraTxCert era
  ) =>
  Spec
spec :: forall era. (AllegraEraTest era, ShelleyEraTxCert era) => Spec
spec =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Golden" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> (NewEpochState era -> Expectation) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"NewEpochState" ((NewEpochState era -> Expectation) -> Spec)
-> (NewEpochState era -> Expectation) -> Spec
forall a b. (a -> b) -> a -> b
$ forall era.
(HasCallStack, EraTxOut era, EraGov era, EraStake era,
 ToCBOR (StashedAVVMAddresses era),
 EncCBOR (StashedAVVMAddresses era), EraCertState era) =>
NewEpochState era -> Expectation
goldenNewEpochStateExpectation @era
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"TxCerts" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      forall era. (Era era, HasCallStack) => (Version -> Spec) -> Spec
forEachEraVersion @era ((Version -> Spec) -> Spec) -> (Version -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$ forall era.
(AllegraEraTest era, ShelleyEraTxCert era) =>
Version -> Spec
allegraDecodeDuplicateDelegCertSucceeds @era