{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Dijkstra.Binary.Annotator (

) where

import Cardano.Base.Typeable (TypeName (TypeName))
import Cardano.Crypto.Leios (decodeLeiosCert)
import Cardano.Ledger.Allegra.Scripts (invalidBeforeL, invalidHereAfterL)
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary
import Cardano.Ledger.Coin (decodePositiveCoin)
import Cardano.Ledger.Conway.Governance (VotingProcedures (..))
import Cardano.Ledger.Dijkstra (DijkstraEra)
import Cardano.Ledger.Dijkstra.BlockBody.Internal (
  DijkstraBlockBody (..),
  DijkstraBlockBodyRaw (..),
  alignedValidFlags,
 )
import Cardano.Ledger.Dijkstra.Core
import Cardano.Ledger.Dijkstra.Scripts
import Cardano.Ledger.Dijkstra.Tx (DijkstraTx (..), Tx (..))
import Cardano.Ledger.Dijkstra.TxBody
import Cardano.Ledger.MemoBytes (decodeMemoized)
import Control.Monad (forM_, unless, when)
import Data.Coerce (coerce)
import Data.Foldable (Foldable (..))
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import qualified Data.Map.Strict as Map
import qualified Data.OMap.Strict as OMap
import qualified Data.OSet.Strict as OSet
import qualified Data.Sequence as Seq
import qualified Data.Sequence.Strict as StrictSeq
import Data.Typeable (Typeable)
import Data.Word (Word16)
import Lens.Micro
import Test.Cardano.Ledger.Conway.Binary.Annotator ()

deriving newtype instance Typeable l => DecCBOR (TxBody l DijkstraEra)

instance Typeable l => DecCBOR (DijkstraTxBodyRaw l DijkstraEra) where
  decCBOR :: forall s. Decoder s (DijkstraTxBodyRaw l DijkstraEra)
decCBOR = forall (l :: TxLevel) era a.
(Typeable l, HasCallStack) =>
(STxBothLevels l era -> a) -> a
withSTxBothLevels @l ((STxBothLevels l DijkstraEra
  -> Decoder s (DijkstraTxBodyRaw l DijkstraEra))
 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra))
-> (STxBothLevels l DijkstraEra
    -> Decoder s (DijkstraTxBodyRaw l DijkstraEra))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
forall a b. (a -> b) -> a -> b
$ \STxBothLevels l DijkstraEra
sTxLevel ->
    TypeName (DijkstraTxBodyRaw l DijkstraEra)
-> [(Word, String)]
-> DijkstraTxBodyRaw l DijkstraEra
-> (DijkstraTxBodyRaw l DijkstraEra
    -> Word -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
forall a s.
TypeName a
-> [(Word, String)]
-> a
-> (a -> Word -> Maybe (Decoder s a))
-> Decoder s a
decodeSparseKeyed
      TypeName (DijkstraTxBodyRaw l DijkstraEra)
forall a. Typeable a => TypeName a
TypeName
      (STxBothLevels l DijkstraEra -> [(Word, String)]
requiredFields STxBothLevels l DijkstraEra
sTxLevel)
      (STxBothLevels l DijkstraEra -> DijkstraTxBodyRaw l DijkstraEra
forall era (l :: TxLevel).
EraTxBody era =>
STxBothLevels l era -> DijkstraTxBodyRaw l era
basicDijkstraTxBodyRaw STxBothLevels l DijkstraEra
sTxLevel)
      (STxBothLevels l DijkstraEra
-> DijkstraTxBodyRaw l DijkstraEra
-> Word
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall s.
STxBothLevels l DijkstraEra
-> DijkstraTxBodyRaw l DijkstraEra
-> Word
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
decoderByKey STxBothLevels l DijkstraEra
sTxLevel)
    where
      decoderByKey ::
        STxBothLevels l DijkstraEra ->
        DijkstraTxBodyRaw l DijkstraEra ->
        Word ->
        Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
      decoderByKey :: forall s.
STxBothLevels l DijkstraEra
-> DijkstraTxBodyRaw l DijkstraEra
-> Word
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
decoderByKey STxBothLevels l DijkstraEra
sTxLevel DijkstraTxBodyRaw l DijkstraEra
acc = \case
        Word
0 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (Set TxIn)
forall s. Decoder s (Set TxIn)
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ inputsDijkstraTxBodyRawL .~ x $ acc
        Word
1 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (StrictSeq (BabbageTxOut DijkstraEra))
forall s. Decoder s (StrictSeq (BabbageTxOut DijkstraEra))
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ outputsDijkstraTxBodyRawL .~ x $ acc
        Word
2 | STxBothLevels l DijkstraEra
STopTx <- STxBothLevels l DijkstraEra
sTxLevel -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ feeDijkstraTxBodyRawL .~ x $ acc
        Word
3 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ vldtDijkstraTxBodyRawL . invalidHereAfterL .~ SJust x $ acc
        Word
4 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (OSet (DijkstraTxCert DijkstraEra))
forall s. Decoder s (OSet (DijkstraTxCert DijkstraEra))
forall a s. DecCBOR a => Decoder s a
decCBOR
          when (OSet.null x) $ fail (emptyFailure "Certificates" "non-empty")
          pure $ certsDijkstraTxBodyRawL .~ x $ acc
        Word
5 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s Withdrawals
forall s. Decoder s Withdrawals
forall a s. DecCBOR a => Decoder s a
decCBOR
          when (null (unWithdrawals x)) $ fail (emptyFailure "Withdrawals" "non-empty")
          pure $ withdrawalsDijkstraTxBodyRawL .~ x $ acc
        Word
7 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s TxAuxDataHash
forall s. Decoder s TxAuxDataHash
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ auxDataHashDijkstraTxBodyRawL .~ SJust x $ acc
        Word
8 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ vldtDijkstraTxBodyRawL . invalidBeforeL .~ SJust x $ acc
        Word
9 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s MultiAsset
forall s. Decoder s MultiAsset
forall a s. DecCBOR a => Decoder s a
decCBOR
          when (x == mempty) $ fail (emptyFailure "Mint" "non-empty")
          pure $ mintDijkstraTxBodyRawL .~ x $ acc
        Word
11 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s ScriptIntegrityHash
forall s. Decoder s ScriptIntegrityHash
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ scriptIntegrityHashDijkstraTxBodyRawL .~ SJust x $ acc
        Word
13 | STxBothLevels l DijkstraEra
STopTx <- STxBothLevels l DijkstraEra
sTxLevel -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (Set TxIn)
forall s. Decoder s (Set TxIn)
forall a s. DecCBOR a => Decoder s a
decCBOR
          when (null x) $ fail (emptyFailure "Collateral Inputs" "non-empty")
          pure $ collateralInputsDijkstraTxBodyRawL .~ x $ acc
        Word
14 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (OSet (Credential Guard))
forall s. Decoder s (OSet (Credential Guard))
decodeGuards
          pure $ guardsDijkstraTxBodyRawL .~ x $ acc
        Word
15 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s Network
forall s. Decoder s Network
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ networkIdDijkstraTxBodyRawL .~ SJust x $ acc
        Word
16 | STxBothLevels l DijkstraEra
STopTx <- STxBothLevels l DijkstraEra
sTxLevel -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (BabbageTxOut DijkstraEra)
forall s. Decoder s (BabbageTxOut DijkstraEra)
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ collateralReturnDijkstraTxBodyRawL .~ SJust x $ acc
        Word
17 | STxBothLevels l DijkstraEra
STopTx <- STxBothLevels l DijkstraEra
sTxLevel -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ totalCollateralDijkstraTxBodyRawL .~ SJust x $ acc
        Word
18 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (Set TxIn)
forall s. Decoder s (Set TxIn)
forall a s. DecCBOR a => Decoder s a
decCBOR
          when (null x) $ fail (emptyFailure "Reference Inputs" "non-empty")
          pure $ referenceInputsDijkstraTxBodyRawL .~ x $ acc
        Word
19 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (VotingProcedures DijkstraEra)
forall s. Decoder s (VotingProcedures DijkstraEra)
forall a s. DecCBOR a => Decoder s a
decCBOR
          when (null (unVotingProcedures x)) $ fail (emptyFailure "VotingProcedures" "non-empty")
          pure $ votingProceduresDijkstraTxBodyRawL .~ x $ acc
        Word
20 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (OSet (ProposalProcedure DijkstraEra))
forall s. Decoder s (OSet (ProposalProcedure DijkstraEra))
forall a s. DecCBOR a => Decoder s a
decCBOR
          when (OSet.null x) $ fail (emptyFailure "ProposalProcedures" "non-empty")
          pure $ proposalProceduresDijkstraTxBodyRawL .~ x $ acc
        Word
21 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
          pure $ currentTreasuryValueDijkstraTxBodyRawL .~ SJust x $ acc
        Word
22 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- String -> Decoder s Coin
forall s. String -> Decoder s Coin
decodePositiveCoin (String -> Decoder s Coin) -> String -> Decoder s Coin
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall {a}. (Semigroup a, IsString a) => a -> a -> a
emptyFailure String
"Treasury Donation" String
"non-zero"
          pure $ treasuryDonationDijkstraTxBodyRawL .~ x $ acc
        Word
23 | STxBothLevels l DijkstraEra
STopTx <- STxBothLevels l DijkstraEra
sTxLevel -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          Word -> Decoder s ()
forall s. Word -> Decoder s ()
allowTag Word
setTag
          x <- Decoder s (OMap TxId (Tx SubTx DijkstraEra))
forall s. Decoder s (OMap TxId (Tx SubTx DijkstraEra))
forall a s. DecCBOR a => Decoder s a
decCBOR
          when (OMap.null x) $ fail (emptyFailure "Subtransactions" "non-empty")
          pure $ subTransactionsDijkstraTxBodyRawL .~ x $ acc
        Word
24 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (Credential Guard)
-> Decoder s (StrictMaybe (Data DijkstraEra))
-> Decoder
     s (Map (Credential Guard) (StrictMaybe (Data DijkstraEra)))
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap Decoder s (Credential Guard)
forall s. Decoder s (Credential Guard)
forall a s. DecCBOR a => Decoder s a
decCBOR (Decoder s (Data DijkstraEra)
-> Decoder s (StrictMaybe (Data DijkstraEra))
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s (Data DijkstraEra)
forall s. Decoder s (Data DijkstraEra)
forall a s. DecCBOR a => Decoder s a
decCBOR)
          when (Map.null x) $ fail (emptyFailure "RequiredTopLevelGuards" "non-empty")
          pure $ requiredTopLevelGuardsDijkstraTxBodyRawL .~ x $ acc
        Word
25 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s DirectDeposits
forall s. Decoder s DirectDeposits
forall a s. DecCBOR a => Decoder s a
decCBOR
          when (null (unDirectDeposits x)) $ fail (emptyFailure "DirectDeposits" "non-empty")
          pure $ directDepositsDijkstraTxBodyRawL .~ x $ acc
        Word
26 -> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. a -> Maybe a
Just (Decoder s (DijkstraTxBodyRaw l DijkstraEra)
 -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra)))
-> Decoder s (DijkstraTxBodyRaw l DijkstraEra)
-> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a b. (a -> b) -> a -> b
$ do
          x <- Decoder s (AccountBalanceIntervals DijkstraEra)
forall s. Decoder s (AccountBalanceIntervals DijkstraEra)
forall a s. DecCBOR a => Decoder s a
decCBOR
          when (null (unAccountBalanceIntervals x)) $
            fail (emptyFailure "AccountBalanceIntervals" "non-empty")
          pure $ accountBalanceIntervalsDijkstraTxBodyRawL .~ x $ acc
        Word
_ -> Maybe (Decoder s (DijkstraTxBodyRaw l DijkstraEra))
forall a. Maybe a
Nothing
      {-# INLINE decoderByKey #-}

      requiredFields :: STxBothLevels l DijkstraEra -> [(Word, String)]
      requiredFields :: STxBothLevels l DijkstraEra -> [(Word, String)]
requiredFields STxBothLevels l DijkstraEra
sTxLevel
        | STxBothLevels l DijkstraEra
STopTx <- STxBothLevels l DijkstraEra
sTxLevel =
            [ (Word
0, String
"inputs")
            , (Word
1, String
"outputs")
            , (Word
2, String
"fee")
            ]
        | STxBothLevels l DijkstraEra
SSubTx <- STxBothLevels l DijkstraEra
sTxLevel =
            [ (Word
0, String
"inputs")
            , (Word
1, String
"outputs")
            ]

      emptyFailure :: a -> a -> a
emptyFailure a
fieldName a
requirement =
        a
"TxBody: '" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
fieldName a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"' must be " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
requirement a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" when supplied"

instance Era era => DecCBOR (DijkstraNativeScriptRaw era) where
  decCBOR :: forall s. Decoder s (DijkstraNativeScriptRaw era)
decCBOR = Text
-> (Word -> Decoder s (Int, DijkstraNativeScriptRaw era))
-> Decoder s (DijkstraNativeScriptRaw era)
forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"DijkstraNativeScriptRaw" ((Word -> Decoder s (Int, DijkstraNativeScriptRaw era))
 -> Decoder s (DijkstraNativeScriptRaw era))
-> (Word -> Decoder s (Int, DijkstraNativeScriptRaw era))
-> Decoder s (DijkstraNativeScriptRaw era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> do
      hash <- Decoder s (KeyHash Witness)
forall s. Decoder s (KeyHash Witness)
forall a s. DecCBOR a => Decoder s a
decCBOR
      pure (2, DijkstraRequireSignature hash)
    Word
1 -> do
      xs <- Decoder s (StrictSeq (DijkstraNativeScript era))
forall s. Decoder s (StrictSeq (DijkstraNativeScript era))
forall a s. DecCBOR a => Decoder s a
decCBOR
      pure (2, DijkstraRequireAllOf xs)
    Word
2 -> do
      xs <- Decoder s (StrictSeq (DijkstraNativeScript era))
forall s. Decoder s (StrictSeq (DijkstraNativeScript era))
forall a s. DecCBOR a => Decoder s a
decCBOR
      pure (2, DijkstraRequireAnyOf xs)
    Word
3 -> do
      m <- Decoder s Int
forall s. Decoder s Int
forall a s. DecCBOR a => Decoder s a
decCBOR
      xs <- decCBOR
      pure (3, DijkstraRequireMOf m xs)
    Word
4 -> do
      m <- Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. DecCBOR a => Decoder s a
decCBOR
      pure (2, DijkstraTimeStart m)
    Word
5 -> do
      m <- Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. DecCBOR a => Decoder s a
decCBOR
      pure (2, DijkstraTimeExpire m)
    Word
6 -> do
      cred <- Decoder s (Credential Guard)
forall s. Decoder s (Credential Guard)
forall a s. DecCBOR a => Decoder s a
decCBOR
      pure (2, DijkstraRequireGuard cred)
    Word
n -> Word -> Decoder s (Int, DijkstraNativeScriptRaw era)
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
n

instance Era era => DecCBOR (DijkstraNativeScript era) where
  decCBOR :: forall s. Decoder s (DijkstraNativeScript era)
decCBOR = MemoBytes (DijkstraNativeScriptRaw era) -> DijkstraNativeScript era
forall era.
MemoBytes (DijkstraNativeScriptRaw era) -> DijkstraNativeScript era
MkDijkstraNativeScript (MemoBytes (DijkstraNativeScriptRaw era)
 -> DijkstraNativeScript era)
-> Decoder s (MemoBytes (DijkstraNativeScriptRaw era))
-> Decoder s (DijkstraNativeScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (DijkstraNativeScriptRaw era)
-> Decoder s (MemoBytes (DijkstraNativeScriptRaw era))
forall s t. Decoder s t -> Decoder s (MemoBytes t)
decodeMemoized Decoder s (DijkstraNativeScriptRaw era)
forall s. Decoder s (DijkstraNativeScriptRaw era)
forall a s. DecCBOR a => Decoder s a
decCBOR

instance Typeable l => DecCBOR (DijkstraTx l DijkstraEra) where
  decCBOR :: forall s. Decoder s (DijkstraTx l DijkstraEra)
decCBOR =
    forall (l :: TxLevel) era a.
(Typeable l, HasCallStack) =>
(STxBothLevels l era -> a) -> a
withSTxBothLevels @l ((STxBothLevels l (ZonkAny 0)
  -> Decoder s (DijkstraTx l DijkstraEra))
 -> Decoder s (DijkstraTx l DijkstraEra))
-> (STxBothLevels l (ZonkAny 0)
    -> Decoder s (DijkstraTx l DijkstraEra))
-> Decoder s (DijkstraTx l DijkstraEra)
forall a b. (a -> b) -> a -> b
$ \case
      STxBothLevels l (ZonkAny 0)
STopTx -> Bool -> Decoder s (DijkstraTx TopTx DijkstraEra)
forall era s.
(DecCBOR (TxBody TopTx era), DecCBOR (TxWits era),
 DecCBOR (TxAuxData era)) =>
Bool -> Decoder s (DijkstraTx TopTx era)
decodeDijkstraTopTx Bool
True
      STxBothLevels l (ZonkAny 0)
SSubTx -> Text
-> (DijkstraTx l DijkstraEra -> Int)
-> Decoder s (DijkstraTx l DijkstraEra)
-> Decoder s (DijkstraTx l DijkstraEra)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"DijkstraSubTx" (Int -> DijkstraTx l DijkstraEra -> Int
forall a b. a -> b -> a
const Int
3) (Decoder s (DijkstraTx l DijkstraEra)
 -> Decoder s (DijkstraTx l DijkstraEra))
-> Decoder s (DijkstraTx l DijkstraEra)
-> Decoder s (DijkstraTx l DijkstraEra)
forall a b. (a -> b) -> a -> b
$ do
        body <- Decoder s (TxBody SubTx DijkstraEra)
forall s. Decoder s (TxBody SubTx DijkstraEra)
forall a s. DecCBOR a => Decoder s a
decCBOR
        wits <- decCBOR
        aux <- decodeNullStrictMaybe decCBOR
        pure $ DijkstraSubTx body wits aux
  {-# INLINE decCBOR #-}

deriving newtype instance Typeable l => DecCBOR (Tx l DijkstraEra)

decodeDijkstraTopTx ::
  ( DecCBOR (TxBody TopTx era)
  , DecCBOR (TxWits era)
  , DecCBOR (TxAuxData era)
  ) =>
  Bool -> Decoder s (DijkstraTx TopTx era)
decodeDijkstraTopTx :: forall era s.
(DecCBOR (TxBody TopTx era), DecCBOR (TxWits era),
 DecCBOR (TxAuxData era)) =>
Bool -> Decoder s (DijkstraTx TopTx era)
decodeDijkstraTopTx Bool
allowIsValid =
  (DijkstraTx TopTx era, Bool) -> DijkstraTx TopTx era
forall a b. (a, b) -> a
fst ((DijkstraTx TopTx era, Bool) -> DijkstraTx TopTx era)
-> Decoder s (DijkstraTx TopTx era, Bool)
-> Decoder s (DijkstraTx TopTx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    let isValidBackwardsCompatibleLength :: Bool -> a
isValidBackwardsCompatibleLength Bool
isValidFlagSupplied = if Bool
isValidFlagSupplied then a
4 else a
3
    Text
-> ((DijkstraTx TopTx era, Bool) -> Int)
-> Decoder s (DijkstraTx TopTx era, Bool)
-> Decoder s (DijkstraTx TopTx era, Bool)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"DijkstraTx" (Bool -> Int
forall {a}. Num a => Bool -> a
isValidBackwardsCompatibleLength (Bool -> Int)
-> ((DijkstraTx TopTx era, Bool) -> Bool)
-> (DijkstraTx TopTx era, Bool)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DijkstraTx TopTx era, Bool) -> Bool
forall a b. (a, b) -> b
snd) (Decoder s (DijkstraTx TopTx era, Bool)
 -> Decoder s (DijkstraTx TopTx era, Bool))
-> Decoder s (DijkstraTx TopTx era, Bool)
-> Decoder s (DijkstraTx TopTx era, Bool)
forall a b. (a -> b) -> a -> b
$ do
      body <- Decoder s (TxBody TopTx era)
forall s. Decoder s (TxBody TopTx era)
forall a s. DecCBOR a => Decoder s a
decCBOR
      wits <- decCBOR
      isValidFlagSupplied <-
        if allowIsValid
          then
            peekTokenType >>= \case
              TokenType
TypeBool ->
                Decoder s Bool
forall s. Decoder s Bool
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s Bool -> (Bool -> Decoder s Bool) -> Decoder s Bool
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Bool
True -> Bool -> Decoder s Bool
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
                  Bool
False -> String -> Decoder s Bool
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Value `false` not allowed for `isValid`"
              TokenType
_ -> Bool -> Decoder s Bool
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
          else pure False
      aux <- decodeNullStrictMaybe decCBOR
      pure (DijkstraTx body wits (IsValid True) aux, isValidFlagSupplied)

instance DecCBOR (DijkstraBlockBodyRaw DijkstraEra) where
  decCBOR :: forall s. Decoder s (DijkstraBlockBodyRaw DijkstraEra)
decCBOR = Text
-> (DijkstraBlockBodyRaw DijkstraEra -> Int)
-> Decoder s (DijkstraBlockBodyRaw DijkstraEra)
-> Decoder s (DijkstraBlockBodyRaw DijkstraEra)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"DijkstraBlockBodyRaw" (Int -> DijkstraBlockBodyRaw DijkstraEra -> Int
forall a b. a -> b -> a
const Int
4) (Decoder s (DijkstraBlockBodyRaw DijkstraEra)
 -> Decoder s (DijkstraBlockBodyRaw DijkstraEra))
-> Decoder s (DijkstraBlockBodyRaw DijkstraEra)
-> Decoder s (DijkstraBlockBodyRaw DijkstraEra)
forall a b. (a -> b) -> a -> b
$ do
    let
      decodeInvalidTxs :: Decoder s IntSet
decodeInvalidTxs =
        (Word16 -> IntSet -> IntSet)
-> (IntSet -> (Int, IntSet))
-> Decoder s Word16
-> Decoder s IntSet
forall s a b c.
Monoid b =>
(a -> b -> b) -> (b -> (Int, c)) -> Decoder s a -> Decoder s c
decodeNonEmptySetLikeEnforceNoDuplicates
          (Int -> IntSet -> IntSet
IntSet.insert (Int -> IntSet -> IntSet)
-> (Word16 -> Int) -> Word16 -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int)
          (\IntSet
x -> (IntSet -> Int
IntSet.size IntSet
x, IntSet
x))
          (forall a s. DecCBOR a => Decoder s a
decCBOR @Word16)
    invalidTxs :: IntSet <- Maybe IntSet -> IntSet
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe IntSet -> IntSet)
-> Decoder s (Maybe IntSet) -> Decoder s IntSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s IntSet -> Decoder s (Maybe IntSet)
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s IntSet
forall {s}. Decoder s IntSet
decodeInvalidTxs
    txs <- decodeSeq (decodeDijkstraTopTx @DijkstraEra False)
    mbLeiosCert <- decodeNullStrictMaybe (fromPlainDecoder decodeLeiosCert)
    mbPerasCert <- decodeNullStrictMaybe decCBOR

    let txsLength = Seq (DijkstraTx TopTx DijkstraEra) -> Int
forall a. Seq a -> Int
Seq.length Seq (DijkstraTx TopTx DijkstraEra)
txs
        inRange Int
x = Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
txsLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    forM_ (IntSet.toList invalidTxs) $ \Int
i ->
      Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Bool
inRange Int
i) (Decoder s () -> Decoder s ())
-> (String -> Decoder s ()) -> String -> Decoder s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
        String
"index is out of range: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i
    let
      validityFlags = Int -> IntSet -> Seq IsValid
alignedValidFlags Int
txsLength IntSet
invalidTxs
      txsWithIsValid = (IsValid -> Tx TopTx DijkstraEra -> Tx TopTx DijkstraEra)
-> Seq IsValid
-> Seq (Tx TopTx DijkstraEra)
-> Seq (Tx TopTx DijkstraEra)
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith (ASetter
  (Tx TopTx DijkstraEra) (Tx TopTx DijkstraEra) IsValid IsValid
-> IsValid -> Tx TopTx DijkstraEra -> Tx TopTx DijkstraEra
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (Tx TopTx DijkstraEra) (Tx TopTx DijkstraEra) IsValid IsValid
forall era. AlonzoEraTx era => Lens' (Tx TopTx era) IsValid
Lens' (Tx TopTx DijkstraEra) IsValid
isValidTxL) Seq IsValid
validityFlags (DijkstraTx TopTx DijkstraEra -> Tx TopTx DijkstraEra
forall a b. Coercible a b => a -> b
coerce (DijkstraTx TopTx DijkstraEra -> Tx TopTx DijkstraEra)
-> Seq (DijkstraTx TopTx DijkstraEra) -> Seq (Tx TopTx DijkstraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (DijkstraTx TopTx DijkstraEra)
txs)
    pure $ DijkstraBlockBodyRaw (StrictSeq.forceToStrict txsWithIsValid) mbLeiosCert mbPerasCert

instance DecCBOR (DijkstraBlockBody DijkstraEra) where
  decCBOR :: forall s. Decoder s (DijkstraBlockBody DijkstraEra)
decCBOR = MemoBytes (DijkstraBlockBodyRaw DijkstraEra)
-> DijkstraBlockBody DijkstraEra
forall era.
MemoBytes (DijkstraBlockBodyRaw era) -> DijkstraBlockBody era
MkDijkstraBlockBody (MemoBytes (DijkstraBlockBodyRaw DijkstraEra)
 -> DijkstraBlockBody DijkstraEra)
-> Decoder s (MemoBytes (DijkstraBlockBodyRaw DijkstraEra))
-> Decoder s (DijkstraBlockBody DijkstraEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (DijkstraBlockBodyRaw DijkstraEra)
-> Decoder s (MemoBytes (DijkstraBlockBodyRaw DijkstraEra))
forall s t. Decoder s t -> Decoder s (MemoBytes t)
decodeMemoized Decoder s (DijkstraBlockBodyRaw DijkstraEra)
forall s. Decoder s (DijkstraBlockBodyRaw DijkstraEra)
forall a s. DecCBOR a => Decoder s a
decCBOR