{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}


-- | Transaction bodies
--
module Bcc.Api.TxBody (

    -- * Transaction bodies
    TxBody(.., TxBody),
    makeTransactionBody,
    TxBodyContent(..),
    TxBodyError(..),
    TxBodyScriptData(..),
    TxScriptValidity(..),
    TxScriptValiditySupportedInEra(..),

    ScriptValidity(..),
    scriptValidityToIsValid,
    isValidToScriptValidity,
    scriptValidityToTxScriptValidity,
    txScriptValidityToIsValid,
    txScriptValidityToScriptValidity,

    -- * Transaction Ids
    TxId(..),
    getTxId,
    getTxIdSophie,

    -- * Transaction inputs
    TxIn(..),
    TxIx(..),
    genesisUTxOPseudoTxIn,

    -- * Transaction outputs
    TxOut(..),
    TxOutValue(..),
    entropicToTxOutValue,
    prettyRenderTxOut,
    txOutValueToEntropic,
    txOutValueToValue,
    serialiseAddressForTxOut,
    TxOutDatumHash(..),
    TxOutInAnyEra(..),
    txOutInAnyEra,

    -- * Other transaction body types
    TxInsCollateral(..),
    TxFee(..),
    TxValidityLowerBound(..),
    TxValidityUpperBound(..),
    TxMetadataInEra(..),
    TxAuxScripts(..),
    TxExtraScriptData(..),
    TxExtraKeyWitnesses(..),
    TxWithdrawals(..),
    TxCertificates(..),
    TxUpdateProposal(..),
    TxMintValue(..),

    -- ** Building vs viewing transactions
    BuildTxWith(..),
    BuildTx,
    ViewTx,

    -- * Era-dependent transaction body features
    CollateralSupportedInEra(..),
    MultiAssetSupportedInEra(..),
    OnlyBccSupportedInEra(..),
    TxFeesExplicitInEra(..),
    TxFeesImplicitInEra(..),
    ValidityUpperBoundSupportedInEra(..),
    ValidityNoUpperBoundSupportedInEra(..),
    ValidityLowerBoundSupportedInEra(..),
    TxMetadataSupportedInEra(..),
    AuxScriptsSupportedInEra(..),
    TxExtraKeyWitnessesSupportedInEra(..),
    ScriptDataSupportedInEra(..),
    WithdrawalsSupportedInEra(..),
    CertificatesSupportedInEra(..),
    UpdateProposalSupportedInEra(..),

    -- ** Feature availability functions
    collateralSupportedInEra,
    multiAssetSupportedInEra,
    txFeesExplicitInEra,
    validityUpperBoundSupportedInEra,
    validityNoUpperBoundSupportedInEra,
    validityLowerBoundSupportedInEra,
    txMetadataSupportedInEra,
    auxScriptsSupportedInEra,
    extraKeyWitnessesSupportedInEra,
    scriptDataSupportedInEra,
    withdrawalsSupportedInEra,
    certificatesSupportedInEra,
    updateProposalSupportedInEra,
    txScriptValiditySupportedInSophieBasedEra,
    txScriptValiditySupportedInBccEra,

    -- * Inspecting 'ScriptWitness'es
    AnyScriptWitness(..),
    ScriptWitnessIndex(..),
    renderScriptWitnessIndex,
    collectTxBodyScriptWitnesses,
    mapTxScriptWitnesses,

    -- * Internal conversion functions & types
    toSophieTxId,
    toSophieTxIn,
    toSophieTxOut,
    fromSophieTxId,
    fromSophieTxIn,
    fromSophieTxOut,
    toAurumRdmrPtr,
    fromAurumRdmrPtr,
    fromColeTxIn,
    fromLedgerTxOuts,
    renderTxIn,

    -- * Data family instances
    AsType(AsTxId, AsTxBody, AsColeTxBody, AsSophieTxBody, AsJenTxBody),
  ) where

import           Prelude

import           Control.Monad (guard)
import           Data.Aeson (object, (.=))
import qualified Data.Aeson as Aeson
import           Data.Aeson.Types (ToJSONKey (..), toJSONKeyText)
import           Data.Bifunctor (first)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import           Data.Foldable (toList)
import           Data.Function (on)
import           Data.List (intercalate, sortBy)
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (fromMaybe, maybeToList)
import qualified Data.Sequence.Strict as Seq
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.String (IsString)
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Word (Word64)
import           GHC.Generics

import           Bcc.Binary (Annotated (..), reAnnotate, recoverBytes)
import qualified Bcc.Binary as CBOR
import qualified Bcc.Crypto.Hash.Class as Crypto
import qualified Bcc.Ledger.Serialization as CBOR (decodeNullMaybe, encodeNullMaybe)
import           Bcc.Slotting.Slot (SlotNo (..))

import qualified Bcc.Chain.Common as Cole
import qualified Bcc.Chain.UTxO as Cole
import qualified Bcc.Crypto.Hashing as Cole

import qualified Bcc.Ledger.Address as Sophie
import qualified Bcc.Ledger.AuxiliaryData as Ledger (hashAuxiliaryData)
import           Bcc.Ledger.BaseTypes (StrictMaybe (..), maybeToStrictMaybe)
import qualified Bcc.Ledger.Core as Core
import qualified Bcc.Ledger.Core as Ledger
import qualified Bcc.Ledger.Credential as Sophie
import qualified Bcc.Ledger.Era as Ledger
import qualified Bcc.Ledger.Keys as Sophie
import qualified Bcc.Ledger.SafeHash as SafeHash
import qualified Bcc.Ledger.Sophie.Constraints as Ledger

import qualified Sophie.Spec.Ledger.Genesis as Sophie
import qualified Sophie.Spec.Ledger.Metadata as Sophie
import qualified Sophie.Spec.Ledger.Tx as Sophie
import qualified Sophie.Spec.Ledger.TxBody as Sophie
import qualified Sophie.Spec.Ledger.UTxO as Sophie

import qualified Bcc.Ledger.SophieMA.AuxiliaryData as Evie
import qualified Bcc.Ledger.SophieMA.AuxiliaryData as Jen
import qualified Bcc.Ledger.SophieMA.TxBody as Evie
import qualified Bcc.Ledger.SophieMA.TxBody as Jen
import           Bcc.Ledger.Val (isZero)

import qualified Bcc.Ledger.Aurum as Aurum
import qualified Bcc.Ledger.Aurum.Data as Aurum
import qualified Bcc.Ledger.Aurum.Language as Aurum
import qualified Bcc.Ledger.Aurum.Scripts as Aurum
import qualified Bcc.Ledger.Aurum.Tx as Aurum
import qualified Bcc.Ledger.Aurum.TxBody as Aurum
import qualified Bcc.Ledger.Aurum.TxWitness as Aurum

import           Shardagnostic.Consensus.Sophie.Eras (StandardEvie, StandardAurum, StandardJen,
                   StandardSophie)

import           Bcc.Api.Address
import           Bcc.Api.Certificate
import           Bcc.Api.Eras
import           Bcc.Api.Error
import           Bcc.Api.HasTypeProxy
import           Bcc.Api.Hash
import           Bcc.Api.KeysCole
import           Bcc.Api.KeysSophie
import           Bcc.Api.NetworkId
import           Bcc.Api.ProtocolParameters
import           Bcc.Api.Script
import           Bcc.Api.SerialiseBech32
import           Bcc.Api.SerialiseCBOR
import           Bcc.Api.SerialiseJSON
import           Bcc.Api.SerialiseRaw
import           Bcc.Api.SerialiseTextEnvelope
import           Bcc.Api.SerialiseUsing
import           Bcc.Api.TxMetadata
import           Bcc.Api.Utils
import           Bcc.Api.Value
import           Bcc.Ledger.Crypto (StandardCrypto)

{- HLINT ignore "Redundant flip" -}
{- HLINT ignore "Use section" -}

-- | Indicates whether a script is expected to fail or pass validation.
data ScriptValidity
  = ScriptInvalid -- ^ Script is expected to fail validation.
                  -- Transactions marked as such can include scripts that fail validation.
                  -- Such transactions may be submitted to the chain, in which case the
                  -- collateral will be taken upon on chain script validation failure.

  | ScriptValid   -- ^ Script is expected to pass validation.
                  -- Transactions marked as such cannot include scripts that fail validation.

  deriving (ScriptValidity -> ScriptValidity -> Bool
(ScriptValidity -> ScriptValidity -> Bool)
-> (ScriptValidity -> ScriptValidity -> Bool) -> Eq ScriptValidity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptValidity -> ScriptValidity -> Bool
$c/= :: ScriptValidity -> ScriptValidity -> Bool
== :: ScriptValidity -> ScriptValidity -> Bool
$c== :: ScriptValidity -> ScriptValidity -> Bool
Eq, Int -> ScriptValidity -> ShowS
[ScriptValidity] -> ShowS
ScriptValidity -> String
(Int -> ScriptValidity -> ShowS)
-> (ScriptValidity -> String)
-> ([ScriptValidity] -> ShowS)
-> Show ScriptValidity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptValidity] -> ShowS
$cshowList :: [ScriptValidity] -> ShowS
show :: ScriptValidity -> String
$cshow :: ScriptValidity -> String
showsPrec :: Int -> ScriptValidity -> ShowS
$cshowsPrec :: Int -> ScriptValidity -> ShowS
Show)

instance ToCBOR ScriptValidity where
  toCBOR :: ScriptValidity -> Encoding
toCBOR = IsValid -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (IsValid -> Encoding)
-> (ScriptValidity -> IsValid) -> ScriptValidity -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptValidity -> IsValid
scriptValidityToIsValid

instance FromCBOR ScriptValidity where
  fromCBOR :: Decoder s ScriptValidity
fromCBOR = IsValid -> ScriptValidity
isValidToScriptValidity (IsValid -> ScriptValidity)
-> Decoder s IsValid -> Decoder s ScriptValidity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s IsValid
forall a s. FromCBOR a => Decoder s a
fromCBOR

scriptValidityToIsValid :: ScriptValidity -> Aurum.IsValid
scriptValidityToIsValid :: ScriptValidity -> IsValid
scriptValidityToIsValid ScriptValidity
ScriptInvalid = Bool -> IsValid
Aurum.IsValid Bool
False
scriptValidityToIsValid ScriptValidity
ScriptValid = Bool -> IsValid
Aurum.IsValid Bool
True

isValidToScriptValidity :: Aurum.IsValid -> ScriptValidity
isValidToScriptValidity :: IsValid -> ScriptValidity
isValidToScriptValidity (Aurum.IsValid Bool
False) = ScriptValidity
ScriptInvalid
isValidToScriptValidity (Aurum.IsValid Bool
True) = ScriptValidity
ScriptValid

-- | A representation of whether the era supports tx script validity.
--
-- The Jen and subsequent eras support script validity.
--
data TxScriptValidity era where
  TxScriptValidityNone :: TxScriptValidity era

  -- | Tx script validity is supported in transactions in the 'Aurum' era onwards.
  TxScriptValidity
    :: TxScriptValiditySupportedInEra era
    -> ScriptValidity
    -> TxScriptValidity era

deriving instance Eq   (TxScriptValiditySupportedInEra era)
deriving instance Show (TxScriptValiditySupportedInEra era)

data TxScriptValiditySupportedInEra era where
  TxScriptValiditySupportedInAurumEra :: TxScriptValiditySupportedInEra AurumEra

deriving instance Eq   (TxScriptValidity era)
deriving instance Show (TxScriptValidity era)

txScriptValiditySupportedInBccEra :: BccEra era -> Maybe (TxScriptValiditySupportedInEra era)
txScriptValiditySupportedInBccEra :: BccEra era -> Maybe (TxScriptValiditySupportedInEra era)
txScriptValiditySupportedInBccEra BccEra era
ColeEra   = Maybe (TxScriptValiditySupportedInEra era)
forall a. Maybe a
Nothing
txScriptValiditySupportedInBccEra BccEra era
SophieEra = Maybe (TxScriptValiditySupportedInEra era)
forall a. Maybe a
Nothing
txScriptValiditySupportedInBccEra BccEra era
EvieEra = Maybe (TxScriptValiditySupportedInEra era)
forall a. Maybe a
Nothing
txScriptValiditySupportedInBccEra BccEra era
JenEra    = Maybe (TxScriptValiditySupportedInEra era)
forall a. Maybe a
Nothing
txScriptValiditySupportedInBccEra BccEra era
AurumEra  = TxScriptValiditySupportedInEra AurumEra
-> Maybe (TxScriptValiditySupportedInEra AurumEra)
forall a. a -> Maybe a
Just TxScriptValiditySupportedInEra AurumEra
TxScriptValiditySupportedInAurumEra

txScriptValiditySupportedInSophieBasedEra :: SophieBasedEra era -> Maybe (TxScriptValiditySupportedInEra era)
txScriptValiditySupportedInSophieBasedEra :: SophieBasedEra era -> Maybe (TxScriptValiditySupportedInEra era)
txScriptValiditySupportedInSophieBasedEra SophieBasedEra era
SophieBasedEraSophie = Maybe (TxScriptValiditySupportedInEra era)
forall a. Maybe a
Nothing
txScriptValiditySupportedInSophieBasedEra SophieBasedEra era
SophieBasedEraEvie = Maybe (TxScriptValiditySupportedInEra era)
forall a. Maybe a
Nothing
txScriptValiditySupportedInSophieBasedEra SophieBasedEra era
SophieBasedEraJen    = Maybe (TxScriptValiditySupportedInEra era)
forall a. Maybe a
Nothing
txScriptValiditySupportedInSophieBasedEra SophieBasedEra era
SophieBasedEraAurum  = TxScriptValiditySupportedInEra AurumEra
-> Maybe (TxScriptValiditySupportedInEra AurumEra)
forall a. a -> Maybe a
Just TxScriptValiditySupportedInEra AurumEra
TxScriptValiditySupportedInAurumEra

txScriptValidityToScriptValidity :: TxScriptValidity era -> ScriptValidity
txScriptValidityToScriptValidity :: TxScriptValidity era -> ScriptValidity
txScriptValidityToScriptValidity TxScriptValidity era
TxScriptValidityNone = ScriptValidity
ScriptValid
txScriptValidityToScriptValidity (TxScriptValidity TxScriptValiditySupportedInEra era
_ ScriptValidity
scriptValidity) = ScriptValidity
scriptValidity

scriptValidityToTxScriptValidity :: SophieBasedEra era -> ScriptValidity -> TxScriptValidity era
scriptValidityToTxScriptValidity :: SophieBasedEra era -> ScriptValidity -> TxScriptValidity era
scriptValidityToTxScriptValidity SophieBasedEra era
era ScriptValidity
scriptValidity = case SophieBasedEra era -> Maybe (TxScriptValiditySupportedInEra era)
forall era.
SophieBasedEra era -> Maybe (TxScriptValiditySupportedInEra era)
txScriptValiditySupportedInSophieBasedEra SophieBasedEra era
era of
  Maybe (TxScriptValiditySupportedInEra era)
Nothing -> TxScriptValidity era
forall era. TxScriptValidity era
TxScriptValidityNone
  Just TxScriptValiditySupportedInEra era
witness -> TxScriptValiditySupportedInEra era
-> ScriptValidity -> TxScriptValidity era
forall era.
TxScriptValiditySupportedInEra era
-> ScriptValidity -> TxScriptValidity era
TxScriptValidity TxScriptValiditySupportedInEra era
witness ScriptValidity
scriptValidity

txScriptValidityToIsValid :: TxScriptValidity era -> Aurum.IsValid
txScriptValidityToIsValid :: TxScriptValidity era -> IsValid
txScriptValidityToIsValid = ScriptValidity -> IsValid
scriptValidityToIsValid (ScriptValidity -> IsValid)
-> (TxScriptValidity era -> ScriptValidity)
-> TxScriptValidity era
-> IsValid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxScriptValidity era -> ScriptValidity
forall era. TxScriptValidity era -> ScriptValidity
txScriptValidityToScriptValidity

-- ----------------------------------------------------------------------------
-- Transaction Ids
--

newtype TxId = TxId (Sophie.Hash StandardCrypto Sophie.EraIndependentTxBody)
  -- We use the Sophie representation and convert to/from the Cole one
  deriving stock (TxId -> TxId -> Bool
(TxId -> TxId -> Bool) -> (TxId -> TxId -> Bool) -> Eq TxId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxId -> TxId -> Bool
$c/= :: TxId -> TxId -> Bool
== :: TxId -> TxId -> Bool
$c== :: TxId -> TxId -> Bool
Eq, Eq TxId
Eq TxId
-> (TxId -> TxId -> Ordering)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> Bool)
-> (TxId -> TxId -> TxId)
-> (TxId -> TxId -> TxId)
-> Ord TxId
TxId -> TxId -> Bool
TxId -> TxId -> Ordering
TxId -> TxId -> TxId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxId -> TxId -> TxId
$cmin :: TxId -> TxId -> TxId
max :: TxId -> TxId -> TxId
$cmax :: TxId -> TxId -> TxId
>= :: TxId -> TxId -> Bool
$c>= :: TxId -> TxId -> Bool
> :: TxId -> TxId -> Bool
$c> :: TxId -> TxId -> Bool
<= :: TxId -> TxId -> Bool
$c<= :: TxId -> TxId -> Bool
< :: TxId -> TxId -> Bool
$c< :: TxId -> TxId -> Bool
compare :: TxId -> TxId -> Ordering
$ccompare :: TxId -> TxId -> Ordering
$cp1Ord :: Eq TxId
Ord)
  deriving (Int -> TxId -> ShowS
[TxId] -> ShowS
TxId -> String
(Int -> TxId -> ShowS)
-> (TxId -> String) -> ([TxId] -> ShowS) -> Show TxId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxId] -> ShowS
$cshowList :: [TxId] -> ShowS
show :: TxId -> String
$cshow :: TxId -> String
showsPrec :: Int -> TxId -> ShowS
$cshowsPrec :: Int -> TxId -> ShowS
Show, String -> TxId
(String -> TxId) -> IsString TxId
forall a. (String -> a) -> IsString a
fromString :: String -> TxId
$cfromString :: String -> TxId
IsString)         via UsingRawBytesHex TxId
  deriving ([TxId] -> Value
[TxId] -> Encoding
TxId -> Value
TxId -> Encoding
(TxId -> Value)
-> (TxId -> Encoding)
-> ([TxId] -> Value)
-> ([TxId] -> Encoding)
-> ToJSON TxId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TxId] -> Encoding
$ctoEncodingList :: [TxId] -> Encoding
toJSONList :: [TxId] -> Value
$ctoJSONList :: [TxId] -> Value
toEncoding :: TxId -> Encoding
$ctoEncoding :: TxId -> Encoding
toJSON :: TxId -> Value
$ctoJSON :: TxId -> Value
ToJSON, Value -> Parser [TxId]
Value -> Parser TxId
(Value -> Parser TxId) -> (Value -> Parser [TxId]) -> FromJSON TxId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TxId]
$cparseJSONList :: Value -> Parser [TxId]
parseJSON :: Value -> Parser TxId
$cparseJSON :: Value -> Parser TxId
FromJSON)       via UsingRawBytesHex TxId
  deriving (ToJSONKeyFunction [TxId]
ToJSONKeyFunction TxId
ToJSONKeyFunction TxId
-> ToJSONKeyFunction [TxId] -> ToJSONKey TxId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [TxId]
$ctoJSONKeyList :: ToJSONKeyFunction [TxId]
toJSONKey :: ToJSONKeyFunction TxId
$ctoJSONKey :: ToJSONKeyFunction TxId
ToJSONKey, FromJSONKeyFunction [TxId]
FromJSONKeyFunction TxId
FromJSONKeyFunction TxId
-> FromJSONKeyFunction [TxId] -> FromJSONKey TxId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [TxId]
$cfromJSONKeyList :: FromJSONKeyFunction [TxId]
fromJSONKey :: FromJSONKeyFunction TxId
$cfromJSONKey :: FromJSONKeyFunction TxId
FromJSONKey) via UsingRawBytesHex TxId

instance HasTypeProxy TxId where
    data AsType TxId = AsTxId
    proxyToAsType :: Proxy TxId -> AsType TxId
proxyToAsType Proxy TxId
_ = AsType TxId
AsTxId

instance SerialiseAsRawBytes TxId where
    serialiseToRawBytes :: TxId -> ByteString
serialiseToRawBytes (TxId Hash StandardCrypto EraIndependentTxBody
h) = Hash Blake2b_256 EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 EraIndependentTxBody
h
    deserialiseFromRawBytes :: AsType TxId -> ByteString -> Maybe TxId
deserialiseFromRawBytes AsType TxId
AsTxId ByteString
bs = Hash StandardCrypto EraIndependentTxBody -> TxId
Hash Blake2b_256 EraIndependentTxBody -> TxId
TxId (Hash Blake2b_256 EraIndependentTxBody -> TxId)
-> Maybe (Hash Blake2b_256 EraIndependentTxBody) -> Maybe TxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_256 EraIndependentTxBody)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

toColeTxId :: TxId -> Cole.TxId
toColeTxId :: TxId -> TxId
toColeTxId (TxId Hash StandardCrypto EraIndependentTxBody
h) =
    ByteString -> TxId
forall a. ByteString -> Hash a
Cole.unsafeHashFromBytes (Hash Blake2b_256 EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 EraIndependentTxBody
h)

toSophieTxId :: TxId -> Sophie.TxId StandardCrypto
toSophieTxId :: TxId -> TxId StandardCrypto
toSophieTxId (TxId Hash StandardCrypto EraIndependentTxBody
h) =
    SafeHash StandardCrypto EraIndependentTxBody -> TxId StandardCrypto
forall crypto. SafeHash crypto EraIndependentTxBody -> TxId crypto
Sophie.TxId (Hash StandardCrypto EraIndependentTxBody
-> SafeHash StandardCrypto EraIndependentTxBody
forall crypto index.
Hash (HASH crypto) index -> SafeHash crypto index
SafeHash.unsafeMakeSafeHash (Hash Blake2b_256 EraIndependentTxBody
-> Hash Blake2b_256 EraIndependentTxBody
forall h a b. Hash h a -> Hash h b
Crypto.castHash Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 EraIndependentTxBody
h))

fromSophieTxId :: Sophie.TxId StandardCrypto -> TxId
fromSophieTxId :: TxId StandardCrypto -> TxId
fromSophieTxId (Sophie.TxId SafeHash StandardCrypto EraIndependentTxBody
h) =
    Hash StandardCrypto EraIndependentTxBody -> TxId
TxId (Hash Blake2b_256 EraIndependentTxBody
-> Hash Blake2b_256 EraIndependentTxBody
forall h a b. Hash h a -> Hash h b
Crypto.castHash (SafeHash StandardCrypto EraIndependentTxBody
-> Hash StandardCrypto EraIndependentTxBody
forall crypto i. SafeHash crypto i -> Hash (HASH crypto) i
SafeHash.extractHash SafeHash StandardCrypto EraIndependentTxBody
h))

-- | Calculate the transaction identifier for a 'TxBody'.
--
getTxId :: forall era. TxBody era -> TxId
getTxId :: TxBody era -> TxId
getTxId (ColeTxBody Annotated Tx ByteString
tx) =
    Hash StandardCrypto EraIndependentTxBody -> TxId
Hash Blake2b_256 EraIndependentTxBody -> TxId
TxId
  (Hash Blake2b_256 EraIndependentTxBody -> TxId)
-> (Annotated Tx ByteString
    -> Hash Blake2b_256 EraIndependentTxBody)
-> Annotated Tx ByteString
-> TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_256 EraIndependentTxBody
-> Maybe (Hash Blake2b_256 EraIndependentTxBody)
-> Hash Blake2b_256 EraIndependentTxBody
forall a. a -> Maybe a -> a
fromMaybe Hash Blake2b_256 EraIndependentTxBody
forall a. a
impossible
  (Maybe (Hash Blake2b_256 EraIndependentTxBody)
 -> Hash Blake2b_256 EraIndependentTxBody)
-> (Annotated Tx ByteString
    -> Maybe (Hash Blake2b_256 EraIndependentTxBody))
-> Annotated Tx ByteString
-> Hash Blake2b_256 EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Maybe (Hash Blake2b_256 EraIndependentTxBody)
forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
Crypto.hashFromBytesShort
  (ShortByteString -> Maybe (Hash Blake2b_256 EraIndependentTxBody))
-> (Annotated Tx ByteString -> ShortByteString)
-> Annotated Tx ByteString
-> Maybe (Hash Blake2b_256 EraIndependentTxBody)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> ShortByteString
forall algo a. AbstractHash algo a -> ShortByteString
Cole.abstractHashToShort
  (TxId -> ShortByteString)
-> (Annotated Tx ByteString -> TxId)
-> Annotated Tx ByteString
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotated Tx ByteString -> TxId
forall t. Decoded t => t -> Hash (BaseType t)
Cole.hashDecoded
  (Annotated Tx ByteString -> TxId)
-> Annotated Tx ByteString -> TxId
forall a b. (a -> b) -> a -> b
$ Annotated Tx ByteString
tx
  where
    impossible :: a
impossible =
      String -> a
forall a. HasCallStack => String -> a
error String
"getTxId: cole and sophie hash sizes do not match"

getTxId (SophieTxBody SophieBasedEra era
era TxBody (SophieLedgerEra era)
tx [Script (SophieLedgerEra era)]
_ TxBodyScriptData era
_ Maybe (AuxiliaryData (SophieLedgerEra era))
_ TxScriptValidity era
_) =
  SophieBasedEra era
-> ((Crypto (SophieLedgerEra era) ~ StandardCrypto,
     UsesTxBody (SophieLedgerEra era)) =>
    TxId)
-> TxId
forall a.
SophieBasedEra era
-> ((Crypto (SophieLedgerEra era) ~ StandardCrypto,
     UsesTxBody (SophieLedgerEra era)) =>
    a)
-> a
obtainConstraints SophieBasedEra era
era (((Crypto (SophieLedgerEra era) ~ StandardCrypto,
   UsesTxBody (SophieLedgerEra era)) =>
  TxId)
 -> TxId)
-> ((Crypto (SophieLedgerEra era) ~ StandardCrypto,
     UsesTxBody (SophieLedgerEra era)) =>
    TxId)
-> TxId
forall a b. (a -> b) -> a -> b
$ SophieBasedEra era -> TxBody (SophieLedgerEra era) -> TxId
forall era.
(Crypto (SophieLedgerEra era) ~ StandardCrypto,
 UsesTxBody (SophieLedgerEra era)) =>
SophieBasedEra era -> TxBody (SophieLedgerEra era) -> TxId
getTxIdSophie SophieBasedEra era
era TxBody (SophieLedgerEra era)
tx
 where
  obtainConstraints
    :: SophieBasedEra era
    -> (( Ledger.Crypto (SophieLedgerEra era) ~ StandardCrypto
        , Ledger.UsesTxBody (SophieLedgerEra era)
        ) => a)
    -> a
  obtainConstraints :: SophieBasedEra era
-> ((Crypto (SophieLedgerEra era) ~ StandardCrypto,
     UsesTxBody (SophieLedgerEra era)) =>
    a)
-> a
obtainConstraints SophieBasedEra era
SophieBasedEraSophie (Crypto (SophieLedgerEra era) ~ StandardCrypto,
 UsesTxBody (SophieLedgerEra era)) =>
a
f = a
(Crypto (SophieLedgerEra era) ~ StandardCrypto,
 UsesTxBody (SophieLedgerEra era)) =>
a
f
  obtainConstraints SophieBasedEra era
SophieBasedEraEvie (Crypto (SophieLedgerEra era) ~ StandardCrypto,
 UsesTxBody (SophieLedgerEra era)) =>
a
f = a
(Crypto (SophieLedgerEra era) ~ StandardCrypto,
 UsesTxBody (SophieLedgerEra era)) =>
a
f
  obtainConstraints SophieBasedEra era
SophieBasedEraJen    (Crypto (SophieLedgerEra era) ~ StandardCrypto,
 UsesTxBody (SophieLedgerEra era)) =>
a
f = a
(Crypto (SophieLedgerEra era) ~ StandardCrypto,
 UsesTxBody (SophieLedgerEra era)) =>
a
f
  obtainConstraints SophieBasedEra era
SophieBasedEraAurum  (Crypto (SophieLedgerEra era) ~ StandardCrypto,
 UsesTxBody (SophieLedgerEra era)) =>
a
f = a
(Crypto (SophieLedgerEra era) ~ StandardCrypto,
 UsesTxBody (SophieLedgerEra era)) =>
a
f

getTxIdSophie
  :: Ledger.Crypto (SophieLedgerEra era) ~ StandardCrypto
  => Ledger.UsesTxBody (SophieLedgerEra era)
  => SophieBasedEra era -> Ledger.TxBody (SophieLedgerEra era) -> TxId
getTxIdSophie :: SophieBasedEra era -> TxBody (SophieLedgerEra era) -> TxId
getTxIdSophie SophieBasedEra era
_ TxBody (SophieLedgerEra era)
tx =
    Hash StandardCrypto EraIndependentTxBody -> TxId
Hash Blake2b_256 EraIndependentTxBody -> TxId
TxId
  (Hash Blake2b_256 EraIndependentTxBody -> TxId)
-> (TxId StandardCrypto -> Hash Blake2b_256 EraIndependentTxBody)
-> TxId StandardCrypto
-> TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_256 EraIndependentTxBody
-> Hash Blake2b_256 EraIndependentTxBody
forall h a b. Hash h a -> Hash h b
Crypto.castHash
  (Hash Blake2b_256 EraIndependentTxBody
 -> Hash Blake2b_256 EraIndependentTxBody)
-> (TxId StandardCrypto -> Hash Blake2b_256 EraIndependentTxBody)
-> TxId StandardCrypto
-> Hash Blake2b_256 EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Sophie.TxId SafeHash StandardCrypto EraIndependentTxBody
txhash) -> SafeHash StandardCrypto EraIndependentTxBody
-> Hash StandardCrypto EraIndependentTxBody
forall crypto i. SafeHash crypto i -> Hash (HASH crypto) i
SafeHash.extractHash SafeHash StandardCrypto EraIndependentTxBody
txhash)
  (TxId StandardCrypto -> TxId) -> TxId StandardCrypto -> TxId
forall a b. (a -> b) -> a -> b
$ TxBody (SophieLedgerEra era) -> TxId (Crypto (SophieLedgerEra era))
forall era. Era era => TxBody era -> TxId (Crypto era)
Sophie.txid TxBody (SophieLedgerEra era)
tx


-- ----------------------------------------------------------------------------
-- Transaction inputs
--

data TxIn = TxIn TxId TxIx
  deriving (TxIn -> TxIn -> Bool
(TxIn -> TxIn -> Bool) -> (TxIn -> TxIn -> Bool) -> Eq TxIn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxIn -> TxIn -> Bool
$c/= :: TxIn -> TxIn -> Bool
== :: TxIn -> TxIn -> Bool
$c== :: TxIn -> TxIn -> Bool
Eq, Eq TxIn
Eq TxIn
-> (TxIn -> TxIn -> Ordering)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> Bool)
-> (TxIn -> TxIn -> TxIn)
-> (TxIn -> TxIn -> TxIn)
-> Ord TxIn
TxIn -> TxIn -> Bool
TxIn -> TxIn -> Ordering
TxIn -> TxIn -> TxIn
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxIn -> TxIn -> TxIn
$cmin :: TxIn -> TxIn -> TxIn
max :: TxIn -> TxIn -> TxIn
$cmax :: TxIn -> TxIn -> TxIn
>= :: TxIn -> TxIn -> Bool
$c>= :: TxIn -> TxIn -> Bool
> :: TxIn -> TxIn -> Bool
$c> :: TxIn -> TxIn -> Bool
<= :: TxIn -> TxIn -> Bool
$c<= :: TxIn -> TxIn -> Bool
< :: TxIn -> TxIn -> Bool
$c< :: TxIn -> TxIn -> Bool
compare :: TxIn -> TxIn -> Ordering
$ccompare :: TxIn -> TxIn -> Ordering
$cp1Ord :: Eq TxIn
Ord, Int -> TxIn -> ShowS
[TxIn] -> ShowS
TxIn -> String
(Int -> TxIn -> ShowS)
-> (TxIn -> String) -> ([TxIn] -> ShowS) -> Show TxIn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxIn] -> ShowS
$cshowList :: [TxIn] -> ShowS
show :: TxIn -> String
$cshow :: TxIn -> String
showsPrec :: Int -> TxIn -> ShowS
$cshowsPrec :: Int -> TxIn -> ShowS
Show)

instance ToJSON TxIn where
  toJSON :: TxIn -> Value
toJSON TxIn
txIn = Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ TxIn -> Text
renderTxIn TxIn
txIn

instance ToJSONKey TxIn where
  toJSONKey :: ToJSONKeyFunction TxIn
toJSONKey = (TxIn -> Text) -> ToJSONKeyFunction TxIn
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText TxIn -> Text
renderTxIn

renderTxIn :: TxIn -> Text
renderTxIn :: TxIn -> Text
renderTxIn (TxIn TxId
txId (TxIx Word
ix)) =
  TxId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText TxId
txId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Word -> String
forall a. Show a => a -> String
show Word
ix)


newtype TxIx = TxIx Word
  deriving stock (TxIx -> TxIx -> Bool
(TxIx -> TxIx -> Bool) -> (TxIx -> TxIx -> Bool) -> Eq TxIx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxIx -> TxIx -> Bool
$c/= :: TxIx -> TxIx -> Bool
== :: TxIx -> TxIx -> Bool
$c== :: TxIx -> TxIx -> Bool
Eq, Eq TxIx
Eq TxIx
-> (TxIx -> TxIx -> Ordering)
-> (TxIx -> TxIx -> Bool)
-> (TxIx -> TxIx -> Bool)
-> (TxIx -> TxIx -> Bool)
-> (TxIx -> TxIx -> Bool)
-> (TxIx -> TxIx -> TxIx)
-> (TxIx -> TxIx -> TxIx)
-> Ord TxIx
TxIx -> TxIx -> Bool
TxIx -> TxIx -> Ordering
TxIx -> TxIx -> TxIx
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxIx -> TxIx -> TxIx
$cmin :: TxIx -> TxIx -> TxIx
max :: TxIx -> TxIx -> TxIx
$cmax :: TxIx -> TxIx -> TxIx
>= :: TxIx -> TxIx -> Bool
$c>= :: TxIx -> TxIx -> Bool
> :: TxIx -> TxIx -> Bool
$c> :: TxIx -> TxIx -> Bool
<= :: TxIx -> TxIx -> Bool
$c<= :: TxIx -> TxIx -> Bool
< :: TxIx -> TxIx -> Bool
$c< :: TxIx -> TxIx -> Bool
compare :: TxIx -> TxIx -> Ordering
$ccompare :: TxIx -> TxIx -> Ordering
$cp1Ord :: Eq TxIx
Ord, Int -> TxIx -> ShowS
[TxIx] -> ShowS
TxIx -> String
(Int -> TxIx -> ShowS)
-> (TxIx -> String) -> ([TxIx] -> ShowS) -> Show TxIx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxIx] -> ShowS
$cshowList :: [TxIx] -> ShowS
show :: TxIx -> String
$cshow :: TxIx -> String
showsPrec :: Int -> TxIx -> ShowS
$cshowsPrec :: Int -> TxIx -> ShowS
Show)
  deriving newtype (Int -> TxIx
TxIx -> Int
TxIx -> [TxIx]
TxIx -> TxIx
TxIx -> TxIx -> [TxIx]
TxIx -> TxIx -> TxIx -> [TxIx]
(TxIx -> TxIx)
-> (TxIx -> TxIx)
-> (Int -> TxIx)
-> (TxIx -> Int)
-> (TxIx -> [TxIx])
-> (TxIx -> TxIx -> [TxIx])
-> (TxIx -> TxIx -> [TxIx])
-> (TxIx -> TxIx -> TxIx -> [TxIx])
-> Enum TxIx
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TxIx -> TxIx -> TxIx -> [TxIx]
$cenumFromThenTo :: TxIx -> TxIx -> TxIx -> [TxIx]
enumFromTo :: TxIx -> TxIx -> [TxIx]
$cenumFromTo :: TxIx -> TxIx -> [TxIx]
enumFromThen :: TxIx -> TxIx -> [TxIx]
$cenumFromThen :: TxIx -> TxIx -> [TxIx]
enumFrom :: TxIx -> [TxIx]
$cenumFrom :: TxIx -> [TxIx]
fromEnum :: TxIx -> Int
$cfromEnum :: TxIx -> Int
toEnum :: Int -> TxIx
$ctoEnum :: Int -> TxIx
pred :: TxIx -> TxIx
$cpred :: TxIx -> TxIx
succ :: TxIx -> TxIx
$csucc :: TxIx -> TxIx
Enum)
  deriving newtype ([TxIx] -> Value
[TxIx] -> Encoding
TxIx -> Value
TxIx -> Encoding
(TxIx -> Value)
-> (TxIx -> Encoding)
-> ([TxIx] -> Value)
-> ([TxIx] -> Encoding)
-> ToJSON TxIx
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TxIx] -> Encoding
$ctoEncodingList :: [TxIx] -> Encoding
toJSONList :: [TxIx] -> Value
$ctoJSONList :: [TxIx] -> Value
toEncoding :: TxIx -> Encoding
$ctoEncoding :: TxIx -> Encoding
toJSON :: TxIx -> Value
$ctoJSON :: TxIx -> Value
ToJSON, Value -> Parser [TxIx]
Value -> Parser TxIx
(Value -> Parser TxIx) -> (Value -> Parser [TxIx]) -> FromJSON TxIx
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TxIx]
$cparseJSONList :: Value -> Parser [TxIx]
parseJSON :: Value -> Parser TxIx
$cparseJSON :: Value -> Parser TxIx
FromJSON)

fromColeTxIn :: Cole.TxIn -> TxIn
fromColeTxIn :: TxIn -> TxIn
fromColeTxIn (Cole.TxInUtxo TxId
txId Word32
index) =
  let shortBs :: ShortByteString
shortBs = TxId -> ShortByteString
forall algo a. AbstractHash algo a -> ShortByteString
Cole.abstractHashToShort TxId
txId
      mApiHash :: Maybe (Hash Blake2b_256 EraIndependentTxBody)
mApiHash = ShortByteString -> Maybe (Hash Blake2b_256 EraIndependentTxBody)
forall h a. HashAlgorithm h => ShortByteString -> Maybe (Hash h a)
Crypto.hashFromBytesShort ShortByteString
shortBs
  in case Maybe (Hash Blake2b_256 EraIndependentTxBody)
mApiHash of
       Just Hash Blake2b_256 EraIndependentTxBody
apiHash -> TxId -> TxIx -> TxIn
TxIn (Hash StandardCrypto EraIndependentTxBody -> TxId
TxId Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 EraIndependentTxBody
apiHash) (Word -> TxIx
TxIx (Word -> TxIx) -> (Integer -> Word) -> Integer -> TxIx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> TxIx) -> Integer -> TxIx
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
index)
       Maybe (Hash Blake2b_256 EraIndependentTxBody)
Nothing -> String -> TxIn
forall a. HasCallStack => String -> a
error (String -> TxIn) -> String -> TxIn
forall a b. (a -> b) -> a -> b
$ String
"Error converting Cole era TxId: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TxId -> String
forall a. Show a => a -> String
show TxId
txId

toColeTxIn :: TxIn -> Cole.TxIn
toColeTxIn :: TxIn -> TxIn
toColeTxIn (TxIn TxId
txid (TxIx Word
txix)) =
    TxId -> Word32 -> TxIn
Cole.TxInUtxo (TxId -> TxId
toColeTxId TxId
txid) (Word -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
txix)

toSophieTxIn :: TxIn -> Sophie.TxIn StandardCrypto
toSophieTxIn :: TxIn -> TxIn StandardCrypto
toSophieTxIn (TxIn TxId
txid (TxIx Word
txix)) =
    TxId StandardCrypto -> Natural -> TxIn StandardCrypto
forall crypto.
Crypto crypto =>
TxId crypto -> Natural -> TxIn crypto
Sophie.TxIn (TxId -> TxId StandardCrypto
toSophieTxId TxId
txid) (Word -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
txix)

fromSophieTxIn :: Sophie.TxIn StandardCrypto -> TxIn
fromSophieTxIn :: TxIn StandardCrypto -> TxIn
fromSophieTxIn (Sophie.TxIn TxId StandardCrypto
txid Natural
txix) =
    TxId -> TxIx -> TxIn
TxIn (TxId StandardCrypto -> TxId
fromSophieTxId TxId StandardCrypto
txid) (Word -> TxIx
TxIx (Natural -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
txix))


-- ----------------------------------------------------------------------------
-- Transaction outputs
--

data TxOut era = TxOut (AddressInEra era)
                       (TxOutValue era)
                       (TxOutDatumHash era)
  deriving (forall x. TxOut era -> Rep (TxOut era) x)
-> (forall x. Rep (TxOut era) x -> TxOut era)
-> Generic (TxOut era)
forall x. Rep (TxOut era) x -> TxOut era
forall x. TxOut era -> Rep (TxOut era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (TxOut era) x -> TxOut era
forall era x. TxOut era -> Rep (TxOut era) x
$cto :: forall era x. Rep (TxOut era) x -> TxOut era
$cfrom :: forall era x. TxOut era -> Rep (TxOut era) x
Generic

deriving instance Eq   (TxOut era)
deriving instance Show (TxOut era)

data TxOutInAnyEra where
     TxOutInAnyEra :: BccEra era
                   -> TxOut era
                   -> TxOutInAnyEra

deriving instance Show TxOutInAnyEra

-- | Convenience constructor for 'TxOutInAnyEra'
txOutInAnyEra :: IsBccEra era => TxOut era -> TxOutInAnyEra
txOutInAnyEra :: TxOut era -> TxOutInAnyEra
txOutInAnyEra = BccEra era -> TxOut era -> TxOutInAnyEra
forall era. BccEra era -> TxOut era -> TxOutInAnyEra
TxOutInAnyEra BccEra era
forall era. IsBccEra era => BccEra era
bccEra

instance IsBccEra era => ToJSON (TxOut era) where
  toJSON :: TxOut era -> Value
toJSON (TxOut AddressInEra era
addr TxOutValue era
val TxOutDatumHash era
TxOutDatumHashNone) =
    [Pair] -> Value
object [ Text
"address" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AddressInEra era -> Text
forall era. AddressInEra era -> Text
serialiseAddressForTxOut AddressInEra era
addr
           , Text
"value"   Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxOutValue era -> Value
forall a. ToJSON a => a -> Value
toJSON TxOutValue era
val
           ]
  toJSON (TxOut AddressInEra era
addr TxOutValue era
val (TxOutDatumHash ScriptDataSupportedInEra era
_ Hash ScriptData
d)) =
    [Pair] -> Value
object [ Text
"address" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AddressInEra era -> Text
forall era. AddressInEra era -> Text
serialiseAddressForTxOut AddressInEra era
addr
           , Text
"value"   Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxOutValue era -> Value
forall a. ToJSON a => a -> Value
toJSON TxOutValue era
val
           , Text
"data"    Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Hash ScriptData -> Value
forall a. ToJSON a => a -> Value
toJSON Hash ScriptData
d
           ]

serialiseAddressForTxOut :: AddressInEra era -> Text
serialiseAddressForTxOut :: AddressInEra era -> Text
serialiseAddressForTxOut (AddressInEra AddressTypeInEra addrtype era
addrType Address addrtype
addr) =
  case AddressTypeInEra addrtype era
addrType of
    AddressTypeInEra addrtype era
ColeAddressInAnyEra  -> Address addrtype -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Address addrtype
addr
    SophieAddressInEra SophieBasedEra era
_ -> Address addrtype -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 Address addrtype
addr


fromColeTxOut :: Cole.TxOut -> TxOut ColeEra
fromColeTxOut :: TxOut -> TxOut ColeEra
fromColeTxOut (Cole.TxOut Address
addr Entropic
value) =
  AddressInEra ColeEra
-> TxOutValue ColeEra -> TxOutDatumHash ColeEra -> TxOut ColeEra
forall era.
AddressInEra era
-> TxOutValue era -> TxOutDatumHash era -> TxOut era
TxOut
    (AddressTypeInEra ColeAddr ColeEra
-> Address ColeAddr -> AddressInEra ColeEra
forall addrtype era.
AddressTypeInEra addrtype era
-> Address addrtype -> AddressInEra era
AddressInEra AddressTypeInEra ColeAddr ColeEra
forall era. AddressTypeInEra ColeAddr era
ColeAddressInAnyEra (Address -> Address ColeAddr
ColeAddress Address
addr))
    (OnlyBccSupportedInEra ColeEra -> Entropic -> TxOutValue ColeEra
forall era. OnlyBccSupportedInEra era -> Entropic -> TxOutValue era
TxOutBccOnly OnlyBccSupportedInEra ColeEra
BccOnlyInColeEra (Entropic -> Entropic
fromColeEntropic Entropic
value))
     TxOutDatumHash ColeEra
forall era. TxOutDatumHash era
TxOutDatumHashNone


toColeTxOut :: TxOut ColeEra -> Maybe Cole.TxOut
toColeTxOut :: TxOut ColeEra -> Maybe TxOut
toColeTxOut (TxOut (AddressInEra AddressTypeInEra addrtype ColeEra
ColeAddressInAnyEra (ColeAddress Address
addr))
                    (TxOutBccOnly OnlyBccSupportedInEra ColeEra
BccOnlyInColeEra Entropic
value) TxOutDatumHash ColeEra
_) =
    Address -> Entropic -> TxOut
Cole.TxOut Address
addr (Entropic -> TxOut) -> Maybe Entropic -> Maybe TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Entropic -> Maybe Entropic
toColeEntropic Entropic
value

toColeTxOut (TxOut (AddressInEra AddressTypeInEra addrtype ColeEra
ColeAddressInAnyEra (ColeAddress Address
_))
                    (TxOutValue MultiAssetSupportedInEra ColeEra
era Value
_) TxOutDatumHash ColeEra
_) = case MultiAssetSupportedInEra ColeEra
era of {}

toColeTxOut (TxOut (AddressInEra (SophieAddressInEra SophieBasedEra ColeEra
era) SophieAddress{})
                    TxOutValue ColeEra
_ TxOutDatumHash ColeEra
_) = case SophieBasedEra ColeEra
era of {}


toSophieTxOut :: forall era ledgerera.
                  SophieLedgerEra era ~ ledgerera
               => SophieBasedEra era
               -> TxOut era
               -> Ledger.TxOut ledgerera
toSophieTxOut :: SophieBasedEra era -> TxOut era -> TxOut ledgerera
toSophieTxOut SophieBasedEra era
era (TxOut AddressInEra era
_ (TxOutBccOnly OnlyBccSupportedInEra era
BccOnlyInColeEra Entropic
_) TxOutDatumHash era
_) =
    case SophieBasedEra era
era of {}

toSophieTxOut SophieBasedEra era
_ (TxOut AddressInEra era
addr (TxOutBccOnly OnlyBccSupportedInEra era
BccOnlyInSophieEra Entropic
value) TxOutDatumHash era
_) =
    Addr (Crypto (SophieEra StandardCrypto))
-> Value (SophieEra StandardCrypto)
-> TxOut (SophieEra StandardCrypto)
forall era.
(Era era, Show (Value era), Compactible (Value era)) =>
Addr (Crypto era) -> Value era -> TxOut era
Sophie.TxOut (AddressInEra era -> Addr StandardCrypto
forall era. AddressInEra era -> Addr StandardCrypto
toSophieAddr AddressInEra era
addr) (Entropic -> Coin
toSophieEntropic Entropic
value)

toSophieTxOut SophieBasedEra era
_ (TxOut AddressInEra era
addr (TxOutBccOnly OnlyBccSupportedInEra era
BccOnlyInEvieEra Entropic
value) TxOutDatumHash era
_) =
    Addr (Crypto (SophieMAEra 'Evie StandardCrypto))
-> Value (SophieMAEra 'Evie StandardCrypto)
-> TxOut (SophieMAEra 'Evie StandardCrypto)
forall era.
(Era era, Show (Value era), Compactible (Value era)) =>
Addr (Crypto era) -> Value era -> TxOut era
Sophie.TxOut (AddressInEra era -> Addr StandardCrypto
forall era. AddressInEra era -> Addr StandardCrypto
toSophieAddr AddressInEra era
addr) (Entropic -> Coin
toSophieEntropic Entropic
value)

toSophieTxOut SophieBasedEra era
_ (TxOut AddressInEra era
addr (TxOutValue MultiAssetSupportedInEra era
MultiAssetInJenEra Value
value) TxOutDatumHash era
_) =
    Addr (Crypto (SophieMAEra 'Jen StandardCrypto))
-> Value (SophieMAEra 'Jen StandardCrypto)
-> TxOut (SophieMAEra 'Jen StandardCrypto)
forall era.
(Era era, Show (Value era), Compactible (Value era)) =>
Addr (Crypto era) -> Value era -> TxOut era
Sophie.TxOut (AddressInEra era -> Addr StandardCrypto
forall era. AddressInEra era -> Addr StandardCrypto
toSophieAddr AddressInEra era
addr) (Value -> Value StandardCrypto
toJenValue Value
value)

toSophieTxOut SophieBasedEra era
_ (TxOut AddressInEra era
addr (TxOutValue MultiAssetSupportedInEra era
MultiAssetInAurumEra Value
value) TxOutDatumHash era
txoutdata) =
    Addr (Crypto (AurumEra StandardCrypto))
-> Value (AurumEra StandardCrypto)
-> StrictMaybe (DataHash (Crypto (AurumEra StandardCrypto)))
-> TxOut (AurumEra StandardCrypto)
forall era.
(Era era, Compactible (Value era), Show (Value era),
 HasCallStack) =>
Addr (Crypto era)
-> Value era -> StrictMaybe (DataHash (Crypto era)) -> TxOut era
Aurum.TxOut (AddressInEra era -> Addr StandardCrypto
forall era. AddressInEra era -> Addr StandardCrypto
toSophieAddr AddressInEra era
addr) (Value -> Value StandardCrypto
toJenValue Value
value)
                 (TxOutDatumHash era -> StrictMaybe (DataHash StandardCrypto)
forall era.
TxOutDatumHash era -> StrictMaybe (DataHash StandardCrypto)
toAurumTxOutDataHash TxOutDatumHash era
txoutdata)

fromSophieTxOut :: SophieLedgerEra era ~ ledgerera
                 => SophieBasedEra era
                 -> Core.TxOut ledgerera
                 -> TxOut era
fromSophieTxOut :: SophieBasedEra era -> TxOut ledgerera -> TxOut era
fromSophieTxOut SophieBasedEra era
era TxOut ledgerera
ledgerTxOut =
  case SophieBasedEra era
era of
    SophieBasedEra era
SophieBasedEraSophie ->
        AddressInEra SophieEra
-> TxOutValue SophieEra
-> TxOutDatumHash SophieEra
-> TxOut SophieEra
forall era.
AddressInEra era
-> TxOutValue era -> TxOutDatumHash era -> TxOut era
TxOut (Addr StandardCrypto -> AddressInEra SophieEra
forall era.
IsSophieBasedEra era =>
Addr StandardCrypto -> AddressInEra era
fromSophieAddr Addr StandardCrypto
Addr (Crypto (SophieEra StandardCrypto))
addr)
              (OnlyBccSupportedInEra SophieEra -> Entropic -> TxOutValue SophieEra
forall era. OnlyBccSupportedInEra era -> Entropic -> TxOutValue era
TxOutBccOnly OnlyBccSupportedInEra SophieEra
BccOnlyInSophieEra
                            (Coin -> Entropic
fromSophieEntropic Coin
Value (SophieEra StandardCrypto)
value))
               TxOutDatumHash SophieEra
forall era. TxOutDatumHash era
TxOutDatumHashNone
      where
        Sophie.TxOut Addr (Crypto (SophieEra StandardCrypto))
addr Value (SophieEra StandardCrypto)
value = TxOut (SophieEra StandardCrypto)
TxOut ledgerera
ledgerTxOut

    SophieBasedEra era
SophieBasedEraEvie ->
        AddressInEra EvieEra
-> TxOutValue EvieEra -> TxOutDatumHash EvieEra -> TxOut EvieEra
forall era.
AddressInEra era
-> TxOutValue era -> TxOutDatumHash era -> TxOut era
TxOut (Addr StandardCrypto -> AddressInEra EvieEra
forall era.
IsSophieBasedEra era =>
Addr StandardCrypto -> AddressInEra era
fromSophieAddr Addr StandardCrypto
Addr (Crypto (SophieMAEra 'Evie StandardCrypto))
addr)
              (OnlyBccSupportedInEra EvieEra -> Entropic -> TxOutValue EvieEra
forall era. OnlyBccSupportedInEra era -> Entropic -> TxOutValue era
TxOutBccOnly OnlyBccSupportedInEra EvieEra
BccOnlyInEvieEra
                            (Coin -> Entropic
fromSophieEntropic Coin
Value (SophieMAEra 'Evie StandardCrypto)
value))
               TxOutDatumHash EvieEra
forall era. TxOutDatumHash era
TxOutDatumHashNone
      where
        Sophie.TxOut Addr (Crypto (SophieMAEra 'Evie StandardCrypto))
addr Value (SophieMAEra 'Evie StandardCrypto)
value = TxOut (SophieMAEra 'Evie StandardCrypto)
TxOut ledgerera
ledgerTxOut

    SophieBasedEra era
SophieBasedEraJen ->
        AddressInEra JenEra
-> TxOutValue JenEra -> TxOutDatumHash JenEra -> TxOut JenEra
forall era.
AddressInEra era
-> TxOutValue era -> TxOutDatumHash era -> TxOut era
TxOut (Addr StandardCrypto -> AddressInEra JenEra
forall era.
IsSophieBasedEra era =>
Addr StandardCrypto -> AddressInEra era
fromSophieAddr Addr StandardCrypto
Addr (Crypto (SophieMAEra 'Jen StandardCrypto))
addr)
              (MultiAssetSupportedInEra JenEra -> Value -> TxOutValue JenEra
forall era. MultiAssetSupportedInEra era -> Value -> TxOutValue era
TxOutValue MultiAssetSupportedInEra JenEra
MultiAssetInJenEra
                          (Value StandardCrypto -> Value
fromJenValue Value (SophieMAEra 'Jen StandardCrypto)
Value StandardCrypto
value))
               TxOutDatumHash JenEra
forall era. TxOutDatumHash era
TxOutDatumHashNone
      where
        Sophie.TxOut Addr (Crypto (SophieMAEra 'Jen StandardCrypto))
addr Value (SophieMAEra 'Jen StandardCrypto)
value = TxOut (SophieMAEra 'Jen StandardCrypto)
TxOut ledgerera
ledgerTxOut

    SophieBasedEra era
SophieBasedEraAurum ->
       AddressInEra AurumEra
-> TxOutValue AurumEra -> TxOutDatumHash AurumEra -> TxOut AurumEra
forall era.
AddressInEra era
-> TxOutValue era -> TxOutDatumHash era -> TxOut era
TxOut (Addr StandardCrypto -> AddressInEra AurumEra
forall era.
IsSophieBasedEra era =>
Addr StandardCrypto -> AddressInEra era
fromSophieAddr Addr StandardCrypto
Addr (Crypto (AurumEra StandardCrypto))
addr)
             (MultiAssetSupportedInEra AurumEra -> Value -> TxOutValue AurumEra
forall era. MultiAssetSupportedInEra era -> Value -> TxOutValue era
TxOutValue MultiAssetSupportedInEra AurumEra
MultiAssetInAurumEra
                         (Value StandardCrypto -> Value
fromJenValue Value (AurumEra StandardCrypto)
Value StandardCrypto
value))
             (ScriptDataSupportedInEra AurumEra
-> StrictMaybe (DataHash StandardCrypto) -> TxOutDatumHash AurumEra
forall era.
ScriptDataSupportedInEra era
-> StrictMaybe (DataHash StandardCrypto) -> TxOutDatumHash era
fromAurumTxOutDataHash ScriptDataSupportedInEra AurumEra
ScriptDataInAurumEra StrictMaybe (DataHash StandardCrypto)
StrictMaybe (DataHash (Crypto (AurumEra StandardCrypto)))
datahash)
      where
        Aurum.TxOut Addr (Crypto (AurumEra StandardCrypto))
addr Value (AurumEra StandardCrypto)
value StrictMaybe (DataHash (Crypto (AurumEra StandardCrypto)))
datahash = TxOut (AurumEra StandardCrypto)
TxOut ledgerera
ledgerTxOut

toAurumTxOutDataHash :: TxOutDatumHash era
                      -> StrictMaybe (Aurum.DataHash StandardCrypto)
toAurumTxOutDataHash :: TxOutDatumHash era -> StrictMaybe (DataHash StandardCrypto)
toAurumTxOutDataHash TxOutDatumHash era
TxOutDatumHashNone    = StrictMaybe (DataHash StandardCrypto)
forall a. StrictMaybe a
SNothing
toAurumTxOutDataHash (TxOutDatumHash ScriptDataSupportedInEra era
_ (ScriptDataHash dh)) = DataHash StandardCrypto -> StrictMaybe (DataHash StandardCrypto)
forall a. a -> StrictMaybe a
SJust DataHash StandardCrypto
dh

fromAurumTxOutDataHash :: ScriptDataSupportedInEra era
                        -> StrictMaybe (Aurum.DataHash StandardCrypto)
                        -> TxOutDatumHash era
fromAurumTxOutDataHash :: ScriptDataSupportedInEra era
-> StrictMaybe (DataHash StandardCrypto) -> TxOutDatumHash era
fromAurumTxOutDataHash ScriptDataSupportedInEra era
_    StrictMaybe (DataHash StandardCrypto)
SNothing  = TxOutDatumHash era
forall era. TxOutDatumHash era
TxOutDatumHashNone
fromAurumTxOutDataHash ScriptDataSupportedInEra era
era (SJust DataHash StandardCrypto
dh) = ScriptDataSupportedInEra era
-> Hash ScriptData -> TxOutDatumHash era
forall era.
ScriptDataSupportedInEra era
-> Hash ScriptData -> TxOutDatumHash era
TxOutDatumHash ScriptDataSupportedInEra era
era (DataHash StandardCrypto -> Hash ScriptData
ScriptDataHash DataHash StandardCrypto
dh)


-- ----------------------------------------------------------------------------
-- Era-dependent transaction body features
--

-- | A representation of whether the era supports transactions with inputs used
-- only for collateral for script fees.
--
-- The Aurum and subsequent eras support collateral inputs.
--
data CollateralSupportedInEra era where

     CollateralInAurumEra :: CollateralSupportedInEra AurumEra

deriving instance Eq   (CollateralSupportedInEra era)
deriving instance Show (CollateralSupportedInEra era)

collateralSupportedInEra :: BccEra era
                         -> Maybe (CollateralSupportedInEra era)
collateralSupportedInEra :: BccEra era -> Maybe (CollateralSupportedInEra era)
collateralSupportedInEra BccEra era
ColeEra   = Maybe (CollateralSupportedInEra era)
forall a. Maybe a
Nothing
collateralSupportedInEra BccEra era
SophieEra = Maybe (CollateralSupportedInEra era)
forall a. Maybe a
Nothing
collateralSupportedInEra BccEra era
EvieEra = Maybe (CollateralSupportedInEra era)
forall a. Maybe a
Nothing
collateralSupportedInEra BccEra era
JenEra    = Maybe (CollateralSupportedInEra era)
forall a. Maybe a
Nothing
collateralSupportedInEra BccEra era
AurumEra  = CollateralSupportedInEra AurumEra
-> Maybe (CollateralSupportedInEra AurumEra)
forall a. a -> Maybe a
Just CollateralSupportedInEra AurumEra
CollateralInAurumEra


-- | A representation of whether the era supports multi-asset transactions.
--
-- The Jen and subsequent eras support multi-asset transactions.
--
-- The negation of this is 'OnlyBccSupportedInEra'.
--
data MultiAssetSupportedInEra era where

     -- | Multi-asset transactions are supported in the 'Jen' era.
     MultiAssetInJenEra :: MultiAssetSupportedInEra JenEra

     -- | Multi-asset transactions are supported in the 'Aurum' era.
     MultiAssetInAurumEra :: MultiAssetSupportedInEra AurumEra

deriving instance Eq   (MultiAssetSupportedInEra era)
deriving instance Show (MultiAssetSupportedInEra era)

instance ToJSON (MultiAssetSupportedInEra era) where
  toJSON :: MultiAssetSupportedInEra era -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value)
-> (MultiAssetSupportedInEra era -> Text)
-> MultiAssetSupportedInEra era
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text)
-> (MultiAssetSupportedInEra era -> String)
-> MultiAssetSupportedInEra era
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiAssetSupportedInEra era -> String
forall a. Show a => a -> String
show

-- | A representation of whether the era supports only bcc transactions.
--
-- Prior to the Jen era only bcc transactions are supported. Multi-assets are
-- supported from the Jen era onwards.
--
-- This is the negation of 'MultiAssetSupportedInEra'. It exists since we need
-- evidence to be positive.
--
data OnlyBccSupportedInEra era where

     BccOnlyInColeEra   :: OnlyBccSupportedInEra ColeEra
     BccOnlyInSophieEra :: OnlyBccSupportedInEra SophieEra
     BccOnlyInEvieEra :: OnlyBccSupportedInEra EvieEra

deriving instance Eq   (OnlyBccSupportedInEra era)
deriving instance Show (OnlyBccSupportedInEra era)

multiAssetSupportedInEra :: BccEra era
                         -> Either (OnlyBccSupportedInEra era)
                                   (MultiAssetSupportedInEra era)
multiAssetSupportedInEra :: BccEra era
-> Either
     (OnlyBccSupportedInEra era) (MultiAssetSupportedInEra era)
multiAssetSupportedInEra BccEra era
ColeEra   = OnlyBccSupportedInEra ColeEra
-> Either
     (OnlyBccSupportedInEra ColeEra) (MultiAssetSupportedInEra era)
forall a b. a -> Either a b
Left OnlyBccSupportedInEra ColeEra
BccOnlyInColeEra
multiAssetSupportedInEra BccEra era
SophieEra = OnlyBccSupportedInEra SophieEra
-> Either
     (OnlyBccSupportedInEra SophieEra) (MultiAssetSupportedInEra era)
forall a b. a -> Either a b
Left OnlyBccSupportedInEra SophieEra
BccOnlyInSophieEra
multiAssetSupportedInEra BccEra era
EvieEra = OnlyBccSupportedInEra EvieEra
-> Either
     (OnlyBccSupportedInEra EvieEra) (MultiAssetSupportedInEra era)
forall a b. a -> Either a b
Left OnlyBccSupportedInEra EvieEra
BccOnlyInEvieEra
multiAssetSupportedInEra BccEra era
JenEra    = MultiAssetSupportedInEra JenEra
-> Either
     (OnlyBccSupportedInEra era) (MultiAssetSupportedInEra JenEra)
forall a b. b -> Either a b
Right MultiAssetSupportedInEra JenEra
MultiAssetInJenEra
multiAssetSupportedInEra BccEra era
AurumEra  = MultiAssetSupportedInEra AurumEra
-> Either
     (OnlyBccSupportedInEra era) (MultiAssetSupportedInEra AurumEra)
forall a b. b -> Either a b
Right MultiAssetSupportedInEra AurumEra
MultiAssetInAurumEra


-- | A representation of whether the era requires explicitly specified fees in
-- transactions.
--
-- The Cole era tx fees are implicit (as the difference bettween the sum of
-- outputs and sum of inputs), but all later eras the fees are specified in the
-- transaction explicitly.
--
data TxFeesExplicitInEra era where

     TxFeesExplicitInSophieEra :: TxFeesExplicitInEra SophieEra
     TxFeesExplicitInEvieEra :: TxFeesExplicitInEra EvieEra
     TxFeesExplicitInJenEra    :: TxFeesExplicitInEra JenEra
     TxFeesExplicitInAurumEra  :: TxFeesExplicitInEra AurumEra

deriving instance Eq   (TxFeesExplicitInEra era)
deriving instance Show (TxFeesExplicitInEra era)

-- | A representation of whether the era requires implicitly specified fees in
-- transactions.
--
-- This is the negation of 'TxFeesExplicitInEra'.
--
data TxFeesImplicitInEra era where
     TxFeesImplicitInColeEra :: TxFeesImplicitInEra ColeEra

deriving instance Eq   (TxFeesImplicitInEra era)
deriving instance Show (TxFeesImplicitInEra era)

txFeesExplicitInEra :: BccEra era
                    -> Either (TxFeesImplicitInEra era)
                              (TxFeesExplicitInEra era)
txFeesExplicitInEra :: BccEra era
-> Either (TxFeesImplicitInEra era) (TxFeesExplicitInEra era)
txFeesExplicitInEra BccEra era
ColeEra   = TxFeesImplicitInEra ColeEra
-> Either (TxFeesImplicitInEra ColeEra) (TxFeesExplicitInEra era)
forall a b. a -> Either a b
Left  TxFeesImplicitInEra ColeEra
TxFeesImplicitInColeEra
txFeesExplicitInEra BccEra era
SophieEra = TxFeesExplicitInEra SophieEra
-> Either (TxFeesImplicitInEra era) (TxFeesExplicitInEra SophieEra)
forall a b. b -> Either a b
Right TxFeesExplicitInEra SophieEra
TxFeesExplicitInSophieEra
txFeesExplicitInEra BccEra era
EvieEra = TxFeesExplicitInEra EvieEra
-> Either (TxFeesImplicitInEra era) (TxFeesExplicitInEra EvieEra)
forall a b. b -> Either a b
Right TxFeesExplicitInEra EvieEra
TxFeesExplicitInEvieEra
txFeesExplicitInEra BccEra era
JenEra    = TxFeesExplicitInEra JenEra
-> Either (TxFeesImplicitInEra era) (TxFeesExplicitInEra JenEra)
forall a b. b -> Either a b
Right TxFeesExplicitInEra JenEra
TxFeesExplicitInJenEra
txFeesExplicitInEra BccEra era
AurumEra  = TxFeesExplicitInEra AurumEra
-> Either (TxFeesImplicitInEra era) (TxFeesExplicitInEra AurumEra)
forall a b. b -> Either a b
Right TxFeesExplicitInEra AurumEra
TxFeesExplicitInAurumEra


-- | A representation of whether the era supports transactions with an upper
-- bound on the range of slots in which they are valid.
--
-- The Sophie and subsequent eras support an upper bound on the validity
-- range. In the Sophie era specifically it is actually required. It is
-- optional in later eras.
--
data ValidityUpperBoundSupportedInEra era where

     ValidityUpperBoundInSophieEra :: ValidityUpperBoundSupportedInEra SophieEra
     ValidityUpperBoundInEvieEra :: ValidityUpperBoundSupportedInEra EvieEra
     ValidityUpperBoundInJenEra    :: ValidityUpperBoundSupportedInEra JenEra
     ValidityUpperBoundInAurumEra  :: ValidityUpperBoundSupportedInEra AurumEra

deriving instance Eq   (ValidityUpperBoundSupportedInEra era)
deriving instance Show (ValidityUpperBoundSupportedInEra era)

validityUpperBoundSupportedInEra :: BccEra era
                                 -> Maybe (ValidityUpperBoundSupportedInEra era)
validityUpperBoundSupportedInEra :: BccEra era -> Maybe (ValidityUpperBoundSupportedInEra era)
validityUpperBoundSupportedInEra BccEra era
ColeEra   = Maybe (ValidityUpperBoundSupportedInEra era)
forall a. Maybe a
Nothing
validityUpperBoundSupportedInEra BccEra era
SophieEra = ValidityUpperBoundSupportedInEra SophieEra
-> Maybe (ValidityUpperBoundSupportedInEra SophieEra)
forall a. a -> Maybe a
Just ValidityUpperBoundSupportedInEra SophieEra
ValidityUpperBoundInSophieEra
validityUpperBoundSupportedInEra BccEra era
EvieEra = ValidityUpperBoundSupportedInEra EvieEra
-> Maybe (ValidityUpperBoundSupportedInEra EvieEra)
forall a. a -> Maybe a
Just ValidityUpperBoundSupportedInEra EvieEra
ValidityUpperBoundInEvieEra
validityUpperBoundSupportedInEra BccEra era
JenEra    = ValidityUpperBoundSupportedInEra JenEra
-> Maybe (ValidityUpperBoundSupportedInEra JenEra)
forall a. a -> Maybe a
Just ValidityUpperBoundSupportedInEra JenEra
ValidityUpperBoundInJenEra
validityUpperBoundSupportedInEra BccEra era
AurumEra  = ValidityUpperBoundSupportedInEra AurumEra
-> Maybe (ValidityUpperBoundSupportedInEra AurumEra)
forall a. a -> Maybe a
Just ValidityUpperBoundSupportedInEra AurumEra
ValidityUpperBoundInAurumEra


-- | A representation of whether the era supports transactions having /no/
-- upper bound on the range of slots in which they are valid.
--
-- Note that the 'SophieEra' /does not support/ omitting a validity upper
-- bound. It was introduced as a /required/ field in Sophie and then made
-- optional in Evie and subsequent eras.
--
-- The Cole era supports this by virtue of the fact that it does not support
-- validity ranges at all.
--
data ValidityNoUpperBoundSupportedInEra era where

     ValidityNoUpperBoundInColeEra   :: ValidityNoUpperBoundSupportedInEra ColeEra
     ValidityNoUpperBoundInEvieEra :: ValidityNoUpperBoundSupportedInEra EvieEra
     ValidityNoUpperBoundInJenEra    :: ValidityNoUpperBoundSupportedInEra JenEra
     ValidityNoUpperBoundInAurumEra  :: ValidityNoUpperBoundSupportedInEra AurumEra

deriving instance Eq   (ValidityNoUpperBoundSupportedInEra era)
deriving instance Show (ValidityNoUpperBoundSupportedInEra era)

validityNoUpperBoundSupportedInEra :: BccEra era
                                   -> Maybe (ValidityNoUpperBoundSupportedInEra era)
validityNoUpperBoundSupportedInEra :: BccEra era -> Maybe (ValidityNoUpperBoundSupportedInEra era)
validityNoUpperBoundSupportedInEra BccEra era
ColeEra   = ValidityNoUpperBoundSupportedInEra ColeEra
-> Maybe (ValidityNoUpperBoundSupportedInEra ColeEra)
forall a. a -> Maybe a
Just ValidityNoUpperBoundSupportedInEra ColeEra
ValidityNoUpperBoundInColeEra
validityNoUpperBoundSupportedInEra BccEra era
SophieEra = Maybe (ValidityNoUpperBoundSupportedInEra era)
forall a. Maybe a
Nothing
validityNoUpperBoundSupportedInEra BccEra era
EvieEra = ValidityNoUpperBoundSupportedInEra EvieEra
-> Maybe (ValidityNoUpperBoundSupportedInEra EvieEra)
forall a. a -> Maybe a
Just ValidityNoUpperBoundSupportedInEra EvieEra
ValidityNoUpperBoundInEvieEra
validityNoUpperBoundSupportedInEra BccEra era
JenEra    = ValidityNoUpperBoundSupportedInEra JenEra
-> Maybe (ValidityNoUpperBoundSupportedInEra JenEra)
forall a. a -> Maybe a
Just ValidityNoUpperBoundSupportedInEra JenEra
ValidityNoUpperBoundInJenEra
validityNoUpperBoundSupportedInEra BccEra era
AurumEra  = ValidityNoUpperBoundSupportedInEra AurumEra
-> Maybe (ValidityNoUpperBoundSupportedInEra AurumEra)
forall a. a -> Maybe a
Just ValidityNoUpperBoundSupportedInEra AurumEra
ValidityNoUpperBoundInAurumEra


-- | A representation of whether the era supports transactions with a lower
-- bound on the range of slots in which they are valid.
--
-- The Evie and subsequent eras support an optional lower bound on the
-- validity range. No equivalent of 'ValidityNoUpperBoundSupportedInEra' is
-- needed since all eras support having no lower bound.
--
data ValidityLowerBoundSupportedInEra era where

     ValidityLowerBoundInEvieEra :: ValidityLowerBoundSupportedInEra EvieEra
     ValidityLowerBoundInJenEra    :: ValidityLowerBoundSupportedInEra JenEra
     ValidityLowerBoundInAurumEra  :: ValidityLowerBoundSupportedInEra AurumEra

deriving instance Eq   (ValidityLowerBoundSupportedInEra era)
deriving instance Show (ValidityLowerBoundSupportedInEra era)

validityLowerBoundSupportedInEra :: BccEra era
                                 -> Maybe (ValidityLowerBoundSupportedInEra era)
validityLowerBoundSupportedInEra :: BccEra era -> Maybe (ValidityLowerBoundSupportedInEra era)
validityLowerBoundSupportedInEra BccEra era
ColeEra   = Maybe (ValidityLowerBoundSupportedInEra era)
forall a. Maybe a
Nothing
validityLowerBoundSupportedInEra BccEra era
SophieEra = Maybe (ValidityLowerBoundSupportedInEra era)
forall a. Maybe a
Nothing
validityLowerBoundSupportedInEra BccEra era
EvieEra = ValidityLowerBoundSupportedInEra EvieEra
-> Maybe (ValidityLowerBoundSupportedInEra EvieEra)
forall a. a -> Maybe a
Just ValidityLowerBoundSupportedInEra EvieEra
ValidityLowerBoundInEvieEra
validityLowerBoundSupportedInEra BccEra era
JenEra    = ValidityLowerBoundSupportedInEra JenEra
-> Maybe (ValidityLowerBoundSupportedInEra JenEra)
forall a. a -> Maybe a
Just ValidityLowerBoundSupportedInEra JenEra
ValidityLowerBoundInJenEra
validityLowerBoundSupportedInEra BccEra era
AurumEra  = ValidityLowerBoundSupportedInEra AurumEra
-> Maybe (ValidityLowerBoundSupportedInEra AurumEra)
forall a. a -> Maybe a
Just ValidityLowerBoundSupportedInEra AurumEra
ValidityLowerBoundInAurumEra

-- | A representation of whether the era supports transaction metadata.
--
-- Transaction metadata is supported from the Sophie era onwards.
--
data TxMetadataSupportedInEra era where

     TxMetadataInSophieEra :: TxMetadataSupportedInEra SophieEra
     TxMetadataInEvieEra :: TxMetadataSupportedInEra EvieEra
     TxMetadataInJenEra    :: TxMetadataSupportedInEra JenEra
     TxMetadataInAurumEra  :: TxMetadataSupportedInEra AurumEra

deriving instance Eq   (TxMetadataSupportedInEra era)
deriving instance Show (TxMetadataSupportedInEra era)

txMetadataSupportedInEra :: BccEra era
                         -> Maybe (TxMetadataSupportedInEra era)
txMetadataSupportedInEra :: BccEra era -> Maybe (TxMetadataSupportedInEra era)
txMetadataSupportedInEra BccEra era
ColeEra   = Maybe (TxMetadataSupportedInEra era)
forall a. Maybe a
Nothing
txMetadataSupportedInEra BccEra era
SophieEra = TxMetadataSupportedInEra SophieEra
-> Maybe (TxMetadataSupportedInEra SophieEra)
forall a. a -> Maybe a
Just TxMetadataSupportedInEra SophieEra
TxMetadataInSophieEra
txMetadataSupportedInEra BccEra era
EvieEra = TxMetadataSupportedInEra EvieEra
-> Maybe (TxMetadataSupportedInEra EvieEra)
forall a. a -> Maybe a
Just TxMetadataSupportedInEra EvieEra
TxMetadataInEvieEra
txMetadataSupportedInEra BccEra era
JenEra    = TxMetadataSupportedInEra JenEra
-> Maybe (TxMetadataSupportedInEra JenEra)
forall a. a -> Maybe a
Just TxMetadataSupportedInEra JenEra
TxMetadataInJenEra
txMetadataSupportedInEra BccEra era
AurumEra  = TxMetadataSupportedInEra AurumEra
-> Maybe (TxMetadataSupportedInEra AurumEra)
forall a. a -> Maybe a
Just TxMetadataSupportedInEra AurumEra
TxMetadataInAurumEra


-- | A representation of whether the era supports auxiliary scripts in
-- transactions.
--
-- Auxiliary scripts are supported from the Evie era onwards.
--
data AuxScriptsSupportedInEra era where

     AuxScriptsInEvieEra :: AuxScriptsSupportedInEra EvieEra
     AuxScriptsInJenEra    :: AuxScriptsSupportedInEra JenEra
     AuxScriptsInAurumEra  :: AuxScriptsSupportedInEra AurumEra

deriving instance Eq   (AuxScriptsSupportedInEra era)
deriving instance Show (AuxScriptsSupportedInEra era)

auxScriptsSupportedInEra :: BccEra era
                         -> Maybe (AuxScriptsSupportedInEra era)
auxScriptsSupportedInEra :: BccEra era -> Maybe (AuxScriptsSupportedInEra era)
auxScriptsSupportedInEra BccEra era
ColeEra   = Maybe (AuxScriptsSupportedInEra era)
forall a. Maybe a
Nothing
auxScriptsSupportedInEra BccEra era
SophieEra = Maybe (AuxScriptsSupportedInEra era)
forall a. Maybe a
Nothing
auxScriptsSupportedInEra BccEra era
EvieEra = AuxScriptsSupportedInEra EvieEra
-> Maybe (AuxScriptsSupportedInEra EvieEra)
forall a. a -> Maybe a
Just AuxScriptsSupportedInEra EvieEra
AuxScriptsInEvieEra
auxScriptsSupportedInEra BccEra era
JenEra    = AuxScriptsSupportedInEra JenEra
-> Maybe (AuxScriptsSupportedInEra JenEra)
forall a. a -> Maybe a
Just AuxScriptsSupportedInEra JenEra
AuxScriptsInJenEra
auxScriptsSupportedInEra BccEra era
AurumEra  = AuxScriptsSupportedInEra AurumEra
-> Maybe (AuxScriptsSupportedInEra AurumEra)
forall a. a -> Maybe a
Just AuxScriptsSupportedInEra AurumEra
AuxScriptsInAurumEra


-- | A representation of whether the era supports transactions that specify
-- in the body that they need extra key witnesses, and where this fact is
-- visible to scripts.
--
-- Extra key witnesses visible to scripts are supported from the Aurum era
-- onwards.
--
data TxExtraKeyWitnessesSupportedInEra era where

     ExtraKeyWitnessesInAurumEra :: TxExtraKeyWitnessesSupportedInEra AurumEra


deriving instance Eq   (TxExtraKeyWitnessesSupportedInEra era)
deriving instance Show (TxExtraKeyWitnessesSupportedInEra era)

extraKeyWitnessesSupportedInEra :: BccEra era
                                -> Maybe (TxExtraKeyWitnessesSupportedInEra era)
extraKeyWitnessesSupportedInEra :: BccEra era -> Maybe (TxExtraKeyWitnessesSupportedInEra era)
extraKeyWitnessesSupportedInEra BccEra era
ColeEra   = Maybe (TxExtraKeyWitnessesSupportedInEra era)
forall a. Maybe a
Nothing
extraKeyWitnessesSupportedInEra BccEra era
SophieEra = Maybe (TxExtraKeyWitnessesSupportedInEra era)
forall a. Maybe a
Nothing
extraKeyWitnessesSupportedInEra BccEra era
EvieEra = Maybe (TxExtraKeyWitnessesSupportedInEra era)
forall a. Maybe a
Nothing
extraKeyWitnessesSupportedInEra BccEra era
JenEra    = Maybe (TxExtraKeyWitnessesSupportedInEra era)
forall a. Maybe a
Nothing
extraKeyWitnessesSupportedInEra BccEra era
AurumEra  = TxExtraKeyWitnessesSupportedInEra AurumEra
-> Maybe (TxExtraKeyWitnessesSupportedInEra AurumEra)
forall a. a -> Maybe a
Just TxExtraKeyWitnessesSupportedInEra AurumEra
ExtraKeyWitnessesInAurumEra


-- | A representation of whether the era supports multi-asset transactions.
--
-- The Jen and subsequent eras support multi-asset transactions.
--
-- The negation of this is 'OnlyBccSupportedInEra'.
--
data ScriptDataSupportedInEra era where

     -- | Script data is supported in transactions in the 'Aurum' era.
     ScriptDataInAurumEra :: ScriptDataSupportedInEra AurumEra

deriving instance Eq   (ScriptDataSupportedInEra era)
deriving instance Show (ScriptDataSupportedInEra era)

scriptDataSupportedInEra :: BccEra era
                         -> Maybe (ScriptDataSupportedInEra era)
scriptDataSupportedInEra :: BccEra era -> Maybe (ScriptDataSupportedInEra era)
scriptDataSupportedInEra BccEra era
ColeEra   = Maybe (ScriptDataSupportedInEra era)
forall a. Maybe a
Nothing
scriptDataSupportedInEra BccEra era
SophieEra = Maybe (ScriptDataSupportedInEra era)
forall a. Maybe a
Nothing
scriptDataSupportedInEra BccEra era
EvieEra = Maybe (ScriptDataSupportedInEra era)
forall a. Maybe a
Nothing
scriptDataSupportedInEra BccEra era
JenEra    = Maybe (ScriptDataSupportedInEra era)
forall a. Maybe a
Nothing
scriptDataSupportedInEra BccEra era
AurumEra  = ScriptDataSupportedInEra AurumEra
-> Maybe (ScriptDataSupportedInEra AurumEra)
forall a. a -> Maybe a
Just ScriptDataSupportedInEra AurumEra
ScriptDataInAurumEra


-- | A representation of whether the era supports withdrawals from reward
-- accounts.
--
-- The Sophie and subsequent eras support stake addresses, their associated
-- reward accounts and support for withdrawals from them.
--
data WithdrawalsSupportedInEra era where

     WithdrawalsInSophieEra :: WithdrawalsSupportedInEra SophieEra
     WithdrawalsInEvieEra :: WithdrawalsSupportedInEra EvieEra
     WithdrawalsInJenEra    :: WithdrawalsSupportedInEra JenEra
     WithdrawalsInAurumEra  :: WithdrawalsSupportedInEra AurumEra

deriving instance Eq   (WithdrawalsSupportedInEra era)
deriving instance Show (WithdrawalsSupportedInEra era)

withdrawalsSupportedInEra :: BccEra era
                          -> Maybe (WithdrawalsSupportedInEra era)
withdrawalsSupportedInEra :: BccEra era -> Maybe (WithdrawalsSupportedInEra era)
withdrawalsSupportedInEra BccEra era
ColeEra   = Maybe (WithdrawalsSupportedInEra era)
forall a. Maybe a
Nothing
withdrawalsSupportedInEra BccEra era
SophieEra = WithdrawalsSupportedInEra SophieEra
-> Maybe (WithdrawalsSupportedInEra SophieEra)
forall a. a -> Maybe a
Just WithdrawalsSupportedInEra SophieEra
WithdrawalsInSophieEra
withdrawalsSupportedInEra BccEra era
EvieEra = WithdrawalsSupportedInEra EvieEra
-> Maybe (WithdrawalsSupportedInEra EvieEra)
forall a. a -> Maybe a
Just WithdrawalsSupportedInEra EvieEra
WithdrawalsInEvieEra
withdrawalsSupportedInEra BccEra era
JenEra    = WithdrawalsSupportedInEra JenEra
-> Maybe (WithdrawalsSupportedInEra JenEra)
forall a. a -> Maybe a
Just WithdrawalsSupportedInEra JenEra
WithdrawalsInJenEra
withdrawalsSupportedInEra BccEra era
AurumEra  = WithdrawalsSupportedInEra AurumEra
-> Maybe (WithdrawalsSupportedInEra AurumEra)
forall a. a -> Maybe a
Just WithdrawalsSupportedInEra AurumEra
WithdrawalsInAurumEra


-- | A representation of whether the era supports 'Certificate's embedded in
-- transactions.
--
-- The Sophie and subsequent eras support such certificates.
--
data CertificatesSupportedInEra era where

     CertificatesInSophieEra :: CertificatesSupportedInEra SophieEra
     CertificatesInEvieEra :: CertificatesSupportedInEra EvieEra
     CertificatesInJenEra    :: CertificatesSupportedInEra JenEra
     CertificatesInAurumEra  :: CertificatesSupportedInEra AurumEra

deriving instance Eq   (CertificatesSupportedInEra era)
deriving instance Show (CertificatesSupportedInEra era)

certificatesSupportedInEra :: BccEra era
                           -> Maybe (CertificatesSupportedInEra era)
certificatesSupportedInEra :: BccEra era -> Maybe (CertificatesSupportedInEra era)
certificatesSupportedInEra BccEra era
ColeEra   = Maybe (CertificatesSupportedInEra era)
forall a. Maybe a
Nothing
certificatesSupportedInEra BccEra era
SophieEra = CertificatesSupportedInEra SophieEra
-> Maybe (CertificatesSupportedInEra SophieEra)
forall a. a -> Maybe a
Just CertificatesSupportedInEra SophieEra
CertificatesInSophieEra
certificatesSupportedInEra BccEra era
EvieEra = CertificatesSupportedInEra EvieEra
-> Maybe (CertificatesSupportedInEra EvieEra)
forall a. a -> Maybe a
Just CertificatesSupportedInEra EvieEra
CertificatesInEvieEra
certificatesSupportedInEra BccEra era
JenEra    = CertificatesSupportedInEra JenEra
-> Maybe (CertificatesSupportedInEra JenEra)
forall a. a -> Maybe a
Just CertificatesSupportedInEra JenEra
CertificatesInJenEra
certificatesSupportedInEra BccEra era
AurumEra  = CertificatesSupportedInEra AurumEra
-> Maybe (CertificatesSupportedInEra AurumEra)
forall a. a -> Maybe a
Just CertificatesSupportedInEra AurumEra
CertificatesInAurumEra


-- | A representation of whether the era supports 'UpdateProposal's embedded in
-- transactions.
--
-- The Sophie and subsequent eras support such update proposals. They Cole
-- era has a notion of an update proposal, but it is a standalone chain object
-- and not embedded in a transaction.
--
data UpdateProposalSupportedInEra era where

     UpdateProposalInSophieEra :: UpdateProposalSupportedInEra SophieEra
     UpdateProposalInEvieEra :: UpdateProposalSupportedInEra EvieEra
     UpdateProposalInJenEra    :: UpdateProposalSupportedInEra JenEra
     UpdateProposalInAurumEra  :: UpdateProposalSupportedInEra AurumEra

deriving instance Eq   (UpdateProposalSupportedInEra era)
deriving instance Show (UpdateProposalSupportedInEra era)

updateProposalSupportedInEra :: BccEra era
                             -> Maybe (UpdateProposalSupportedInEra era)
updateProposalSupportedInEra :: BccEra era -> Maybe (UpdateProposalSupportedInEra era)
updateProposalSupportedInEra BccEra era
ColeEra   = Maybe (UpdateProposalSupportedInEra era)
forall a. Maybe a
Nothing
updateProposalSupportedInEra BccEra era
SophieEra = UpdateProposalSupportedInEra SophieEra
-> Maybe (UpdateProposalSupportedInEra SophieEra)
forall a. a -> Maybe a
Just UpdateProposalSupportedInEra SophieEra
UpdateProposalInSophieEra
updateProposalSupportedInEra BccEra era
EvieEra = UpdateProposalSupportedInEra EvieEra
-> Maybe (UpdateProposalSupportedInEra EvieEra)
forall a. a -> Maybe a
Just UpdateProposalSupportedInEra EvieEra
UpdateProposalInEvieEra
updateProposalSupportedInEra BccEra era
JenEra    = UpdateProposalSupportedInEra JenEra
-> Maybe (UpdateProposalSupportedInEra JenEra)
forall a. a -> Maybe a
Just UpdateProposalSupportedInEra JenEra
UpdateProposalInJenEra
updateProposalSupportedInEra BccEra era
AurumEra  = UpdateProposalSupportedInEra AurumEra
-> Maybe (UpdateProposalSupportedInEra AurumEra)
forall a. a -> Maybe a
Just UpdateProposalSupportedInEra AurumEra
UpdateProposalInAurumEra


-- ----------------------------------------------------------------------------
-- Building vs viewing transactions
--

data BuildTx
data ViewTx

data BuildTxWith build a where

     ViewTx      ::      BuildTxWith ViewTx  a
     BuildTxWith :: a -> BuildTxWith BuildTx a

deriving instance Eq   a => Eq   (BuildTxWith build a)
deriving instance Show a => Show (BuildTxWith build a)

-- ----------------------------------------------------------------------------
-- Transaction input values (era-dependent)
--

type TxIns build era = [(TxIn, BuildTxWith build (Witness WitCtxTxIn era))]

data TxInsCollateral era where

     TxInsCollateralNone :: TxInsCollateral era

     TxInsCollateral     :: CollateralSupportedInEra era
                         -> [TxIn] -- Only key witnesses, no scripts.
                         -> TxInsCollateral era

deriving instance Eq   (TxInsCollateral era)
deriving instance Show (TxInsCollateral era)


-- ----------------------------------------------------------------------------
-- Transaction output values (era-dependent)
--

data TxOutValue era where

     TxOutBccOnly :: OnlyBccSupportedInEra era -> Entropic -> TxOutValue era

     TxOutValue   :: MultiAssetSupportedInEra era -> Value -> TxOutValue era

deriving instance Eq   (TxOutValue era)
deriving instance Show (TxOutValue era)
deriving instance Generic (TxOutValue era)

instance ToJSON (TxOutValue era) where
  toJSON :: TxOutValue era -> Value
toJSON (TxOutBccOnly OnlyBccSupportedInEra era
_ Entropic
ll) = Entropic -> Value
forall a. ToJSON a => a -> Value
toJSON Entropic
ll
  toJSON (TxOutValue MultiAssetSupportedInEra era
_ Value
val) = Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
val


entropicToTxOutValue :: IsBccEra era => Entropic -> TxOutValue era
entropicToTxOutValue :: Entropic -> TxOutValue era
entropicToTxOutValue Entropic
l =
    case BccEra era
-> Either
     (OnlyBccSupportedInEra era) (MultiAssetSupportedInEra era)
forall era.
BccEra era
-> Either
     (OnlyBccSupportedInEra era) (MultiAssetSupportedInEra era)
multiAssetSupportedInEra BccEra era
forall era. IsBccEra era => BccEra era
bccEra of
      Left OnlyBccSupportedInEra era
bccOnly     -> OnlyBccSupportedInEra era -> Entropic -> TxOutValue era
forall era. OnlyBccSupportedInEra era -> Entropic -> TxOutValue era
TxOutBccOnly OnlyBccSupportedInEra era
bccOnly  Entropic
l
      Right MultiAssetSupportedInEra era
multiAsset -> MultiAssetSupportedInEra era -> Value -> TxOutValue era
forall era. MultiAssetSupportedInEra era -> Value -> TxOutValue era
TxOutValue MultiAssetSupportedInEra era
multiAsset (Entropic -> Value
entropicToValue Entropic
l)

txOutValueToEntropic :: TxOutValue era -> Entropic
txOutValueToEntropic :: TxOutValue era -> Entropic
txOutValueToEntropic TxOutValue era
tv =
  case TxOutValue era
tv of
    TxOutBccOnly OnlyBccSupportedInEra era
_ Entropic
l -> Entropic
l
    TxOutValue MultiAssetSupportedInEra era
_ Value
v -> Value -> Entropic
selectEntropic Value
v

txOutValueToValue :: TxOutValue era -> Value
txOutValueToValue :: TxOutValue era -> Value
txOutValueToValue TxOutValue era
tv =
  case TxOutValue era
tv of
    TxOutBccOnly OnlyBccSupportedInEra era
_ Entropic
l -> Entropic -> Value
entropicToValue Entropic
l
    TxOutValue MultiAssetSupportedInEra era
_ Value
v -> Value
v

prettyRenderTxOut :: TxOutInAnyEra -> Text
prettyRenderTxOut :: TxOutInAnyEra -> Text
prettyRenderTxOut (TxOutInAnyEra BccEra era
_ (TxOut (AddressInEra AddressTypeInEra addrtype era
_ Address addrtype
addr) TxOutValue era
txOutVal TxOutDatumHash era
_)) =
     AddressAny -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress (Address addrtype -> AddressAny
forall addr. Address addr -> AddressAny
toAddressAny Address addrtype
addr) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" + "
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
renderValue (TxOutValue era -> Value
forall era. TxOutValue era -> Value
txOutValueToValue TxOutValue era
txOutVal)

-- ----------------------------------------------------------------------------
-- Transaction output datum (era-dependent)
--

data TxOutDatumHash era where

     TxOutDatumHashNone :: TxOutDatumHash era

     TxOutDatumHash     :: ScriptDataSupportedInEra era
                        -> Hash ScriptData
                        -> TxOutDatumHash era

deriving instance Eq   (TxOutDatumHash era)
deriving instance Show (TxOutDatumHash era)
deriving instance Generic (TxOutDatumHash era)


-- ----------------------------------------------------------------------------
-- Transaction fees
--

data TxFee era where

     TxFeeImplicit :: TxFeesImplicitInEra era -> TxFee era

     TxFeeExplicit :: TxFeesExplicitInEra era -> Entropic -> TxFee era

deriving instance Eq   (TxFee era)
deriving instance Show (TxFee era)


-- ----------------------------------------------------------------------------
-- Transaction validity range
--

-- | This was formerly known as the TTL.
--
data TxValidityUpperBound era where

     TxValidityNoUpperBound :: ValidityNoUpperBoundSupportedInEra era
                            -> TxValidityUpperBound era

     TxValidityUpperBound   :: ValidityUpperBoundSupportedInEra era
                            -> SlotNo
                            -> TxValidityUpperBound era

deriving instance Eq   (TxValidityUpperBound era)
deriving instance Show (TxValidityUpperBound era)


data TxValidityLowerBound era where

     TxValidityNoLowerBound :: TxValidityLowerBound era

     TxValidityLowerBound   :: ValidityLowerBoundSupportedInEra era
                            -> SlotNo
                            -> TxValidityLowerBound era

deriving instance Eq   (TxValidityLowerBound era)
deriving instance Show (TxValidityLowerBound era)


-- ----------------------------------------------------------------------------
-- Transaction metadata (era-dependent)
--

data TxMetadataInEra era where

     TxMetadataNone  :: TxMetadataInEra era

     TxMetadataInEra :: TxMetadataSupportedInEra era
                     -> TxMetadata
                     -> TxMetadataInEra era

deriving instance Eq   (TxMetadataInEra era)
deriving instance Show (TxMetadataInEra era)


-- ----------------------------------------------------------------------------
-- Auxiliary scripts (era-dependent)
--

data TxAuxScripts era where

     TxAuxScriptsNone :: TxAuxScripts era

     TxAuxScripts     :: AuxScriptsSupportedInEra era
                      -> [ScriptInEra era]
                      -> TxAuxScripts era

deriving instance Eq   (TxAuxScripts era)
deriving instance Show (TxAuxScripts era)

-- ----------------------------------------------------------------------------
-- Optionally required signatures (era-dependent)
--

data TxExtraKeyWitnesses era where

  TxExtraKeyWitnessesNone :: TxExtraKeyWitnesses era

  TxExtraKeyWitnesses     :: TxExtraKeyWitnessesSupportedInEra era
                          -> [Hash PaymentKey]
                          -> TxExtraKeyWitnesses era

deriving instance Eq   (TxExtraKeyWitnesses era)
deriving instance Show (TxExtraKeyWitnesses era)

-- ----------------------------------------------------------------------------
-- Auxiliary script data (era-dependent)
--

data TxExtraScriptData era where

     TxExtraScriptDataNone :: TxExtraScriptData era

     TxExtraScriptData     :: ScriptDataSupportedInEra era
                           -> [ScriptData]
                           -> TxExtraScriptData era

deriving instance Eq   (TxExtraScriptData era)
deriving instance Show (TxExtraScriptData era)


-- ----------------------------------------------------------------------------
-- Withdrawals within transactions (era-dependent)
--

data TxWithdrawals build era where

     TxWithdrawalsNone :: TxWithdrawals build era

     TxWithdrawals     :: WithdrawalsSupportedInEra era
                       -> [(StakeAddress, Entropic,
                            BuildTxWith build (Witness WitCtxStake era))]
                       -> TxWithdrawals build era

deriving instance Eq   (TxWithdrawals build era)
deriving instance Show (TxWithdrawals build era)


-- ----------------------------------------------------------------------------
-- Certificates within transactions (era-dependent)
--

data TxCertificates build era where

     TxCertificatesNone :: TxCertificates build era

     TxCertificates     :: CertificatesSupportedInEra era
                        -> [Certificate]
                        -> BuildTxWith build
                             (Map StakeCredential (Witness WitCtxStake era))
                        -> TxCertificates build era

deriving instance Eq   (TxCertificates build era)
deriving instance Show (TxCertificates build era)


-- ----------------------------------------------------------------------------
-- Transaction metadata (era-dependent)
--

data TxUpdateProposal era where

     TxUpdateProposalNone :: TxUpdateProposal era

     TxUpdateProposal     :: UpdateProposalSupportedInEra era
                          -> UpdateProposal
                          -> TxUpdateProposal era

deriving instance Eq   (TxUpdateProposal era)
deriving instance Show (TxUpdateProposal era)


-- ----------------------------------------------------------------------------
-- Value minting within transactions (era-dependent)
--

data TxMintValue build era where

     TxMintNone  :: TxMintValue build era

     TxMintValue :: MultiAssetSupportedInEra era
                 -> Value
                 -> BuildTxWith build
                      (Map PolicyId (ScriptWitness WitCtxMint era))
                 -> TxMintValue build era

deriving instance Eq   (TxMintValue build era)
deriving instance Show (TxMintValue build era)


-- ----------------------------------------------------------------------------
-- Transaction body content
--

data TxBodyContent build era =
     TxBodyContent {
       TxBodyContent build era -> TxIns build era
txIns            :: TxIns build era,
       TxBodyContent build era -> TxInsCollateral era
txInsCollateral  :: TxInsCollateral era,
       TxBodyContent build era -> [TxOut era]
txOuts           :: [TxOut era],
       TxBodyContent build era -> TxFee era
txFee            :: TxFee era,
       TxBodyContent build era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
txValidityRange  :: (TxValidityLowerBound era,
                            TxValidityUpperBound era),
       TxBodyContent build era -> TxMetadataInEra era
txMetadata       :: TxMetadataInEra era,
       TxBodyContent build era -> TxAuxScripts era
txAuxScripts     :: TxAuxScripts era,
       TxBodyContent build era
-> BuildTxWith build (TxExtraScriptData era)
txExtraScriptData:: BuildTxWith build (TxExtraScriptData era),
       TxBodyContent build era -> TxExtraKeyWitnesses era
txExtraKeyWits   :: TxExtraKeyWitnesses era,
       TxBodyContent build era
-> BuildTxWith build (Maybe ProtocolParameters)
txProtocolParams :: BuildTxWith build (Maybe ProtocolParameters),
       TxBodyContent build era -> TxWithdrawals build era
txWithdrawals    :: TxWithdrawals  build era,
       TxBodyContent build era -> TxCertificates build era
txCertificates   :: TxCertificates build era,
       TxBodyContent build era -> TxUpdateProposal era
txUpdateProposal :: TxUpdateProposal era,
       TxBodyContent build era -> TxMintValue build era
txMintValue      :: TxMintValue    build era,
       TxBodyContent build era -> TxScriptValidity era
txScriptValidity :: TxScriptValidity era
     }


-- ----------------------------------------------------------------------------
-- Transaction bodies
--

data TxBody era where

     ColeTxBody
       :: Annotated Cole.Tx ByteString
       -> TxBody ColeEra

     SophieTxBody
       :: SophieBasedEra era
       -> Ledger.TxBody (SophieLedgerEra era)

          -- We include the scripts along with the tx body, rather than the
          -- witnesses set, since they need to be known when building the body.
       -> [Ledger.Script (SophieLedgerEra era)]

          -- The info for each use of each script: the script input data, both
          -- the UTxO input data (called the "datum") and the supplied input
          -- data (called the "redeemer") and the execution units.
       -> TxBodyScriptData era

          -- The 'Ledger.AuxiliaryData' consists of one or several things,
          -- depending on era:
          -- + transaction metadata  (in Sophie and later)
          -- + auxiliary scripts     (in Evie and later)
          -- Note that there is no auxiliary script data as such, because the
          -- extra script data has to be passed to scripts and hence is needed
          -- for validation. It is thus part of the witness data, not the
          -- auxiliary data.
       -> Maybe (Ledger.AuxiliaryData (SophieLedgerEra era))

       -> TxScriptValidity era -- ^ Mark script as expected to pass or fail validation

       -> TxBody era
     -- The 'SophieBasedEra' GADT tells us what era we are in.
     -- The 'SophieLedgerEra' type family maps that to the era type from the
     -- ledger lib. The 'Ledger.TxBody' type family maps that to a specific
     -- tx body type, which is different for each Sophie-based era.


data TxBodyScriptData era where
     TxBodyNoScriptData :: TxBodyScriptData era
     TxBodyScriptData   :: ScriptDataSupportedInEra era
                        -> Aurum.TxDats (SophieLedgerEra era)
                        -> Aurum.Redeemers (SophieLedgerEra era)
                        -> TxBodyScriptData era

deriving instance Eq   (TxBodyScriptData era)
deriving instance Show (TxBodyScriptData era)


-- The GADT in the SophieTxBody case requires a custom instance
instance Eq (TxBody era) where
    == :: TxBody era -> TxBody era -> Bool
(==) (ColeTxBody Annotated Tx ByteString
txbodyA)
         (ColeTxBody Annotated Tx ByteString
txbodyB) = Annotated Tx ByteString
txbodyA Annotated Tx ByteString -> Annotated Tx ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Annotated Tx ByteString
txbodyB

    (==) (SophieTxBody SophieBasedEra era
era TxBody (SophieLedgerEra era)
txbodyA [Script (SophieLedgerEra era)]
txscriptsA TxBodyScriptData era
redeemersA Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadataA TxScriptValidity era
scriptValidityA)
         (SophieTxBody SophieBasedEra era
_   TxBody (SophieLedgerEra era)
txbodyB [Script (SophieLedgerEra era)]
txscriptsB TxBodyScriptData era
redeemersB Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadataB TxScriptValidity era
scriptValidityB) =
         case SophieBasedEra era
era of
           SophieBasedEra era
SophieBasedEraSophie -> TxBody (SophieLedgerEra era)
TxBody (SophieEra StandardCrypto)
txbodyA     TxBody (SophieEra StandardCrypto)
-> TxBody (SophieEra StandardCrypto) -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody (SophieLedgerEra era)
TxBody (SophieEra StandardCrypto)
txbodyB
                                  Bool -> Bool -> Bool
&& [Script (SophieLedgerEra era)]
[MultiSig StandardCrypto]
txscriptsA  [MultiSig StandardCrypto] -> [MultiSig StandardCrypto] -> Bool
forall a. Eq a => a -> a -> Bool
== [Script (SophieLedgerEra era)]
[MultiSig StandardCrypto]
txscriptsB
                                  Bool -> Bool -> Bool
&& Maybe (AuxiliaryData (SophieLedgerEra era))
Maybe (Metadata (SophieEra StandardCrypto))
txmetadataA Maybe (Metadata (SophieEra StandardCrypto))
-> Maybe (Metadata (SophieEra StandardCrypto)) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (AuxiliaryData (SophieLedgerEra era))
Maybe (Metadata (SophieEra StandardCrypto))
txmetadataB

           SophieBasedEra era
SophieBasedEraEvie -> TxBody (SophieMAEra 'Evie StandardCrypto)
TxBody (SophieLedgerEra era)
txbodyA     TxBody (SophieMAEra 'Evie StandardCrypto)
-> TxBody (SophieMAEra 'Evie StandardCrypto) -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody (SophieMAEra 'Evie StandardCrypto)
TxBody (SophieLedgerEra era)
txbodyB
                                  Bool -> Bool -> Bool
&& [Timelock StandardCrypto]
[Script (SophieLedgerEra era)]
txscriptsA  [Timelock StandardCrypto] -> [Timelock StandardCrypto] -> Bool
forall a. Eq a => a -> a -> Bool
== [Timelock StandardCrypto]
[Script (SophieLedgerEra era)]
txscriptsB
                                  Bool -> Bool -> Bool
&& Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadataA Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto))
-> Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto)) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadataB

           SophieBasedEra era
SophieBasedEraJen    -> TxBody (SophieMAEra 'Jen StandardCrypto)
TxBody (SophieLedgerEra era)
txbodyA     TxBody (SophieMAEra 'Jen StandardCrypto)
-> TxBody (SophieMAEra 'Jen StandardCrypto) -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody (SophieMAEra 'Jen StandardCrypto)
TxBody (SophieLedgerEra era)
txbodyB
                                  Bool -> Bool -> Bool
&& [Timelock StandardCrypto]
[Script (SophieLedgerEra era)]
txscriptsA  [Timelock StandardCrypto] -> [Timelock StandardCrypto] -> Bool
forall a. Eq a => a -> a -> Bool
== [Timelock StandardCrypto]
[Script (SophieLedgerEra era)]
txscriptsB
                                  Bool -> Bool -> Bool
&& Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadataA Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto))
-> Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto)) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadataB

           SophieBasedEra era
SophieBasedEraAurum  -> TxBody (SophieLedgerEra era)
TxBody (AurumEra StandardCrypto)
txbodyA         TxBody (AurumEra StandardCrypto)
-> TxBody (AurumEra StandardCrypto) -> Bool
forall a. Eq a => a -> a -> Bool
== TxBody (SophieLedgerEra era)
TxBody (AurumEra StandardCrypto)
txbodyB
                                  Bool -> Bool -> Bool
&& [Script (SophieLedgerEra era)]
[Script (AurumEra StandardCrypto)]
txscriptsA      [Script (AurumEra StandardCrypto)]
-> [Script (AurumEra StandardCrypto)] -> Bool
forall a. Eq a => a -> a -> Bool
== [Script (SophieLedgerEra era)]
[Script (AurumEra StandardCrypto)]
txscriptsB
                                  Bool -> Bool -> Bool
&& TxBodyScriptData era
redeemersA      TxBodyScriptData era -> TxBodyScriptData era -> Bool
forall a. Eq a => a -> a -> Bool
== TxBodyScriptData era
redeemersB
                                  Bool -> Bool -> Bool
&& Maybe (AuxiliaryData (AurumEra StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadataA     Maybe (AuxiliaryData (AurumEra StandardCrypto))
-> Maybe (AuxiliaryData (AurumEra StandardCrypto)) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (AuxiliaryData (AurumEra StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadataB
                                  Bool -> Bool -> Bool
&& TxScriptValidity era
scriptValidityA TxScriptValidity era -> TxScriptValidity era -> Bool
forall a. Eq a => a -> a -> Bool
== TxScriptValidity era
scriptValidityB

    (==) ColeTxBody{} (SophieTxBody SophieBasedEra era
era TxBody (SophieLedgerEra era)
_ [Script (SophieLedgerEra era)]
_ TxBodyScriptData era
_ Maybe (AuxiliaryData (SophieLedgerEra era))
_ TxScriptValidity era
_) = case SophieBasedEra era
era of {}


-- The GADT in the SophieTxBody case requires a custom instance
instance Show (TxBody era) where
    showsPrec :: Int -> TxBody era -> ShowS
showsPrec Int
p (ColeTxBody Annotated Tx ByteString
txbody) =
      Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString String
"ColeTxBody "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Annotated Tx ByteString -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Annotated Tx ByteString
txbody
        )

    showsPrec Int
p (SophieTxBody SophieBasedEra era
SophieBasedEraSophie
                               TxBody (SophieLedgerEra era)
txbody [Script (SophieLedgerEra era)]
txscripts TxBodyScriptData era
redeemers Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadata TxScriptValidity era
scriptValidity) =
      Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString String
"SophieTxBody SophieBasedEraSophie "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBody (SophieEra StandardCrypto) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody (SophieLedgerEra era)
TxBody (SophieEra StandardCrypto)
txbody
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [MultiSig StandardCrypto] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Script (SophieLedgerEra era)]
[MultiSig StandardCrypto]
txscripts
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBodyScriptData era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBodyScriptData era
redeemers
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe (Metadata (SophieEra StandardCrypto)) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (AuxiliaryData (SophieLedgerEra era))
Maybe (Metadata (SophieEra StandardCrypto))
txmetadata
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxScriptValidity era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxScriptValidity era
scriptValidity
        )

    showsPrec Int
p (SophieTxBody SophieBasedEra era
SophieBasedEraEvie
                               TxBody (SophieLedgerEra era)
txbody [Script (SophieLedgerEra era)]
txscripts TxBodyScriptData era
redeemers Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadata TxScriptValidity era
scriptValidity) =
      Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString String
"SophieTxBody SophieBasedEraEvie "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBody (SophieMAEra 'Evie StandardCrypto) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody (SophieMAEra 'Evie StandardCrypto)
TxBody (SophieLedgerEra era)
txbody
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Timelock StandardCrypto] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Timelock StandardCrypto]
[Script (SophieLedgerEra era)]
txscripts
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBodyScriptData era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBodyScriptData era
redeemers
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto))
-> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadata
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxScriptValidity era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxScriptValidity era
scriptValidity
        )

    showsPrec Int
p (SophieTxBody SophieBasedEra era
SophieBasedEraJen
                               TxBody (SophieLedgerEra era)
txbody [Script (SophieLedgerEra era)]
txscripts TxBodyScriptData era
redeemers Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadata TxScriptValidity era
scriptValidity) =
      Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString String
"SophieTxBody SophieBasedEraJen "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBody (SophieMAEra 'Jen StandardCrypto) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody (SophieMAEra 'Jen StandardCrypto)
TxBody (SophieLedgerEra era)
txbody
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Timelock StandardCrypto] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Timelock StandardCrypto]
[Script (SophieLedgerEra era)]
txscripts
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBodyScriptData era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBodyScriptData era
redeemers
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto)) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadata
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxScriptValidity era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxScriptValidity era
scriptValidity
        )

    showsPrec Int
p (SophieTxBody SophieBasedEra era
SophieBasedEraAurum
                               TxBody (SophieLedgerEra era)
txbody [Script (SophieLedgerEra era)]
txscripts TxBodyScriptData era
redeemers Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadata TxScriptValidity era
scriptValidity) =
      Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString String
"SophieTxBody SophieBasedEraJen "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBody (AurumEra StandardCrypto) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBody (SophieLedgerEra era)
TxBody (AurumEra StandardCrypto)
txbody
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Script (AurumEra StandardCrypto)] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Script (SophieLedgerEra era)]
[Script (AurumEra StandardCrypto)]
txscripts
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxBodyScriptData era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxBodyScriptData era
redeemers
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe (AuxiliaryData (AurumEra StandardCrypto)) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (AuxiliaryData (AurumEra StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadata
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TxScriptValidity era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 TxScriptValidity era
scriptValidity
        )


instance HasTypeProxy era => HasTypeProxy (TxBody era) where
    data AsType (TxBody era) = AsTxBody (AsType era)
    proxyToAsType :: Proxy (TxBody era) -> AsType (TxBody era)
proxyToAsType Proxy (TxBody era)
_ = AsType era -> AsType (TxBody era)
forall era. AsType era -> AsType (TxBody era)
AsTxBody (Proxy era -> AsType era
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (Proxy era
forall k (t :: k). Proxy t
Proxy :: Proxy era))

pattern AsColeTxBody :: AsType (TxBody ColeEra)
pattern $bAsColeTxBody :: AsType (TxBody ColeEra)
$mAsColeTxBody :: forall r.
AsType (TxBody ColeEra) -> (Void# -> r) -> (Void# -> r) -> r
AsColeTxBody   = AsTxBody AsColeEra
{-# COMPLETE AsColeTxBody #-}

pattern AsSophieTxBody :: AsType (TxBody SophieEra)
pattern $bAsSophieTxBody :: AsType (TxBody SophieEra)
$mAsSophieTxBody :: forall r.
AsType (TxBody SophieEra) -> (Void# -> r) -> (Void# -> r) -> r
AsSophieTxBody = AsTxBody AsSophieEra
{-# COMPLETE AsSophieTxBody #-}

pattern AsJenTxBody :: AsType (TxBody JenEra)
pattern $bAsJenTxBody :: AsType (TxBody JenEra)
$mAsJenTxBody :: forall r.
AsType (TxBody JenEra) -> (Void# -> r) -> (Void# -> r) -> r
AsJenTxBody = AsTxBody AsJenEra
{-# COMPLETE AsJenTxBody #-}

instance IsBccEra era => SerialiseAsCBOR (TxBody era) where

    serialiseToCBOR :: TxBody era -> ByteString
serialiseToCBOR (ColeTxBody Annotated Tx ByteString
txbody) =
      Annotated Tx ByteString -> ByteString
forall t. Decoded t => t -> ByteString
recoverBytes Annotated Tx ByteString
txbody

    serialiseToCBOR (SophieTxBody SophieBasedEra era
era TxBody (SophieLedgerEra era)
txbody [Script (SophieLedgerEra era)]
txscripts TxBodyScriptData era
redeemers Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadata TxScriptValidity era
scriptValidity) =
      case SophieBasedEra era
era of
        -- Use the same serialisation impl, but at different types:
        SophieBasedEra era
SophieBasedEraSophie -> SophieBasedEra era
-> TxBody (SophieEra StandardCrypto)
-> [Script (SophieEra StandardCrypto)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieEra StandardCrypto))
-> TxScriptValidity era
-> ByteString
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera, ToCBOR (TxBody ledgerera),
 ToCBOR (Script ledgerera), ToCBOR (TxDats ledgerera),
 ToCBOR (Redeemers ledgerera), ToCBOR (AuxiliaryData ledgerera)) =>
SophieBasedEra era
-> TxBody ledgerera
-> [Script ledgerera]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData ledgerera)
-> TxScriptValidity era
-> ByteString
serialiseSophieBasedTxBody
                                    SophieBasedEra era
era TxBody (SophieEra StandardCrypto)
TxBody (SophieLedgerEra era)
txbody [Script (SophieEra StandardCrypto)]
[Script (SophieLedgerEra era)]
txscripts TxBodyScriptData era
redeemers Maybe (AuxiliaryData (SophieEra StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadata TxScriptValidity era
scriptValidity
        SophieBasedEra era
SophieBasedEraEvie -> SophieBasedEra era
-> TxBody (SophieMAEra 'Evie StandardCrypto)
-> [Script (SophieMAEra 'Evie StandardCrypto)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto))
-> TxScriptValidity era
-> ByteString
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera, ToCBOR (TxBody ledgerera),
 ToCBOR (Script ledgerera), ToCBOR (TxDats ledgerera),
 ToCBOR (Redeemers ledgerera), ToCBOR (AuxiliaryData ledgerera)) =>
SophieBasedEra era
-> TxBody ledgerera
-> [Script ledgerera]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData ledgerera)
-> TxScriptValidity era
-> ByteString
serialiseSophieBasedTxBody
                                    SophieBasedEra era
era TxBody (SophieMAEra 'Evie StandardCrypto)
TxBody (SophieLedgerEra era)
txbody [Script (SophieMAEra 'Evie StandardCrypto)]
[Script (SophieLedgerEra era)]
txscripts TxBodyScriptData era
redeemers Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadata TxScriptValidity era
scriptValidity
        SophieBasedEra era
SophieBasedEraJen    -> SophieBasedEra era
-> TxBody (SophieMAEra 'Jen StandardCrypto)
-> [Script (SophieMAEra 'Jen StandardCrypto)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto))
-> TxScriptValidity era
-> ByteString
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera, ToCBOR (TxBody ledgerera),
 ToCBOR (Script ledgerera), ToCBOR (TxDats ledgerera),
 ToCBOR (Redeemers ledgerera), ToCBOR (AuxiliaryData ledgerera)) =>
SophieBasedEra era
-> TxBody ledgerera
-> [Script ledgerera]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData ledgerera)
-> TxScriptValidity era
-> ByteString
serialiseSophieBasedTxBody
                                    SophieBasedEra era
era TxBody (SophieMAEra 'Jen StandardCrypto)
TxBody (SophieLedgerEra era)
txbody [Script (SophieMAEra 'Jen StandardCrypto)]
[Script (SophieLedgerEra era)]
txscripts TxBodyScriptData era
redeemers Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadata TxScriptValidity era
scriptValidity
        SophieBasedEra era
SophieBasedEraAurum  -> SophieBasedEra era
-> TxBody (AurumEra StandardCrypto)
-> [Script (AurumEra StandardCrypto)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (AurumEra StandardCrypto))
-> TxScriptValidity era
-> ByteString
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera, ToCBOR (TxBody ledgerera),
 ToCBOR (Script ledgerera), ToCBOR (TxDats ledgerera),
 ToCBOR (Redeemers ledgerera), ToCBOR (AuxiliaryData ledgerera)) =>
SophieBasedEra era
-> TxBody ledgerera
-> [Script ledgerera]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData ledgerera)
-> TxScriptValidity era
-> ByteString
serialiseSophieBasedTxBody
                                    SophieBasedEra era
era TxBody (AurumEra StandardCrypto)
TxBody (SophieLedgerEra era)
txbody [Script (AurumEra StandardCrypto)]
[Script (SophieLedgerEra era)]
txscripts TxBodyScriptData era
redeemers Maybe (AuxiliaryData (AurumEra StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txmetadata TxScriptValidity era
scriptValidity

    deserialiseFromCBOR :: AsType (TxBody era)
-> ByteString -> Either DecoderError (TxBody era)
deserialiseFromCBOR AsType (TxBody era)
_ ByteString
bs =
      case BccEra era
forall era. IsBccEra era => BccEra era
bccEra :: BccEra era of
        BccEra era
ColeEra ->
          Annotated Tx ByteString -> TxBody ColeEra
ColeTxBody (Annotated Tx ByteString -> TxBody ColeEra)
-> Either DecoderError (Annotated Tx ByteString)
-> Either DecoderError (TxBody ColeEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Text
-> (forall s. Decoder s (Annotated Tx ByteSpan))
-> LByteString
-> Either DecoderError (Annotated Tx ByteString)
forall (f :: * -> *).
Functor f =>
Text
-> (forall s. Decoder s (f ByteSpan))
-> LByteString
-> Either DecoderError (f ByteString)
CBOR.decodeFullAnnotatedBytes
              Text
"Cole TxBody"
              forall s. Decoder s (Annotated Tx ByteSpan)
forall a s. FromCBOR a => Decoder s (Annotated a ByteSpan)
CBOR.fromCBORAnnotated
              (ByteString -> LByteString
LBS.fromStrict ByteString
bs)

        -- Use the same derialisation impl, but at different types:
        BccEra era
SophieEra -> SophieBasedEra SophieEra
-> ByteString -> Either DecoderError (TxBody SophieEra)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 FromCBOR (Annotator (TxBody ledgerera)),
 FromCBOR (Annotator (Script ledgerera)),
 FromCBOR (Annotator (TxDats ledgerera)),
 FromCBOR (Annotator (Redeemers ledgerera)),
 FromCBOR (Annotator (AuxiliaryData ledgerera))) =>
SophieBasedEra era
-> ByteString -> Either DecoderError (TxBody era)
deserialiseSophieBasedTxBody SophieBasedEra SophieEra
SophieBasedEraSophie ByteString
bs
        BccEra era
EvieEra -> SophieBasedEra EvieEra
-> ByteString -> Either DecoderError (TxBody EvieEra)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 FromCBOR (Annotator (TxBody ledgerera)),
 FromCBOR (Annotator (Script ledgerera)),
 FromCBOR (Annotator (TxDats ledgerera)),
 FromCBOR (Annotator (Redeemers ledgerera)),
 FromCBOR (Annotator (AuxiliaryData ledgerera))) =>
SophieBasedEra era
-> ByteString -> Either DecoderError (TxBody era)
deserialiseSophieBasedTxBody SophieBasedEra EvieEra
SophieBasedEraEvie ByteString
bs
        BccEra era
JenEra    -> SophieBasedEra JenEra
-> ByteString -> Either DecoderError (TxBody JenEra)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 FromCBOR (Annotator (TxBody ledgerera)),
 FromCBOR (Annotator (Script ledgerera)),
 FromCBOR (Annotator (TxDats ledgerera)),
 FromCBOR (Annotator (Redeemers ledgerera)),
 FromCBOR (Annotator (AuxiliaryData ledgerera))) =>
SophieBasedEra era
-> ByteString -> Either DecoderError (TxBody era)
deserialiseSophieBasedTxBody SophieBasedEra JenEra
SophieBasedEraJen    ByteString
bs
        BccEra era
AurumEra  -> SophieBasedEra AurumEra
-> ByteString -> Either DecoderError (TxBody AurumEra)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 FromCBOR (Annotator (TxBody ledgerera)),
 FromCBOR (Annotator (Script ledgerera)),
 FromCBOR (Annotator (TxDats ledgerera)),
 FromCBOR (Annotator (Redeemers ledgerera)),
 FromCBOR (Annotator (AuxiliaryData ledgerera))) =>
SophieBasedEra era
-> ByteString -> Either DecoderError (TxBody era)
deserialiseSophieBasedTxBody SophieBasedEra AurumEra
SophieBasedEraAurum  ByteString
bs

-- | The serialisation format for the different Sophie-based eras are not the
-- same, but they can be handled generally with one overloaded implementation.
serialiseSophieBasedTxBody
  :: forall era ledgerera.
     SophieLedgerEra era ~ ledgerera
  => ToCBOR (Ledger.TxBody ledgerera)
  => ToCBOR (Ledger.Script ledgerera)
  => ToCBOR (Aurum.TxDats ledgerera)
  => ToCBOR (Aurum.Redeemers ledgerera)
  => ToCBOR (Ledger.AuxiliaryData ledgerera)
  => SophieBasedEra era
  -> Ledger.TxBody ledgerera
  -> [Ledger.Script ledgerera]
  -> TxBodyScriptData era
  -> Maybe (Ledger.AuxiliaryData ledgerera)
  -> TxScriptValidity era -- ^ Mark script as expected to pass or fail validation
  -> ByteString
serialiseSophieBasedTxBody :: SophieBasedEra era
-> TxBody ledgerera
-> [Script ledgerera]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData ledgerera)
-> TxScriptValidity era
-> ByteString
serialiseSophieBasedTxBody SophieBasedEra era
era TxBody ledgerera
txbody [Script ledgerera]
txscripts
                            TxBodyScriptData era
TxBodyNoScriptData Maybe (AuxiliaryData ledgerera)
txmetadata TxScriptValidity era
scriptValidity =
    -- Backwards compat for pre-Aurum era tx body files
    case SophieBasedEra era
era of
      SophieBasedEra era
SophieBasedEraSophie -> ByteString
preAurum
      SophieBasedEra era
SophieBasedEraEvie -> ByteString
preAurum
      SophieBasedEra era
SophieBasedEraJen -> ByteString
preAurum
      SophieBasedEra era
SophieBasedEraAurum ->
        Encoding -> ByteString
CBOR.serializeEncoding'
          (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Word -> Encoding
CBOR.encodeListLen Word
4
         Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxBody (AurumEra StandardCrypto) -> Encoding
forall a. ToCBOR a => a -> Encoding
CBOR.toCBOR TxBody ledgerera
TxBody (AurumEra StandardCrypto)
txbody
         Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Script (AurumEra StandardCrypto)] -> Encoding
forall a. ToCBOR a => a -> Encoding
CBOR.toCBOR [Script ledgerera]
[Script (AurumEra StandardCrypto)]
txscripts
         Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ScriptValidity -> Encoding
forall a. ToCBOR a => a -> Encoding
CBOR.toCBOR (TxScriptValidity era -> ScriptValidity
forall era. TxScriptValidity era -> ScriptValidity
txScriptValidityToScriptValidity TxScriptValidity era
scriptValidity)
         Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (AuxiliaryData (AurumEra StandardCrypto) -> Encoding)
-> Maybe (AuxiliaryData (AurumEra StandardCrypto)) -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
CBOR.encodeNullMaybe AuxiliaryData (AurumEra StandardCrypto) -> Encoding
forall a. ToCBOR a => a -> Encoding
CBOR.toCBOR Maybe (AuxiliaryData (AurumEra StandardCrypto))
Maybe (AuxiliaryData ledgerera)
txmetadata
 where
   preAurum :: ByteString
preAurum = Encoding -> ByteString
CBOR.serializeEncoding'
                 (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Word -> Encoding
CBOR.encodeListLen Word
3
                Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxBody ledgerera -> Encoding
forall a. ToCBOR a => a -> Encoding
CBOR.toCBOR TxBody ledgerera
txbody
                Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Script ledgerera] -> Encoding
forall a. ToCBOR a => a -> Encoding
CBOR.toCBOR [Script ledgerera]
txscripts
                Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (AuxiliaryData ledgerera -> Encoding)
-> Maybe (AuxiliaryData ledgerera) -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
CBOR.encodeNullMaybe AuxiliaryData ledgerera -> Encoding
forall a. ToCBOR a => a -> Encoding
CBOR.toCBOR Maybe (AuxiliaryData ledgerera)
txmetadata

serialiseSophieBasedTxBody SophieBasedEra era
_era TxBody ledgerera
txbody [Script ledgerera]
txscripts
                            (TxBodyScriptData ScriptDataSupportedInEra era
_ TxDats (SophieLedgerEra era)
datums Redeemers (SophieLedgerEra era)
redeemers)
                            Maybe (AuxiliaryData ledgerera)
txmetadata TxScriptValidity era
txBodycriptValidity =
    Encoding -> ByteString
CBOR.serializeEncoding' (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
        Word -> Encoding
CBOR.encodeListLen Word
6
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxBody ledgerera -> Encoding
forall a. ToCBOR a => a -> Encoding
CBOR.toCBOR TxBody ledgerera
txbody
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Script ledgerera] -> Encoding
forall a. ToCBOR a => a -> Encoding
CBOR.toCBOR [Script ledgerera]
txscripts
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxDats ledgerera -> Encoding
forall a. ToCBOR a => a -> Encoding
CBOR.toCBOR TxDats ledgerera
TxDats (SophieLedgerEra era)
datums
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Redeemers ledgerera -> Encoding
forall a. ToCBOR a => a -> Encoding
CBOR.toCBOR Redeemers ledgerera
Redeemers (SophieLedgerEra era)
redeemers
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ScriptValidity -> Encoding
forall a. ToCBOR a => a -> Encoding
CBOR.toCBOR (TxScriptValidity era -> ScriptValidity
forall era. TxScriptValidity era -> ScriptValidity
txScriptValidityToScriptValidity TxScriptValidity era
txBodycriptValidity)
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (AuxiliaryData ledgerera -> Encoding)
-> Maybe (AuxiliaryData ledgerera) -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
CBOR.encodeNullMaybe AuxiliaryData ledgerera -> Encoding
forall a. ToCBOR a => a -> Encoding
CBOR.toCBOR Maybe (AuxiliaryData ledgerera)
txmetadata

deserialiseSophieBasedTxBody
  :: forall era ledgerera.
     SophieLedgerEra era ~ ledgerera
  => FromCBOR (CBOR.Annotator (Ledger.TxBody ledgerera))
  => FromCBOR (CBOR.Annotator (Ledger.Script ledgerera))
  => FromCBOR (CBOR.Annotator (Aurum.TxDats ledgerera))
  => FromCBOR (CBOR.Annotator (Aurum.Redeemers ledgerera))
  => FromCBOR (CBOR.Annotator (Ledger.AuxiliaryData ledgerera))
  => SophieBasedEra era
  -> ByteString
  -> Either CBOR.DecoderError (TxBody era)
deserialiseSophieBasedTxBody :: SophieBasedEra era
-> ByteString -> Either DecoderError (TxBody era)
deserialiseSophieBasedTxBody SophieBasedEra era
era ByteString
bs =
    Text
-> (forall s. Decoder s (Annotator (TxBody era)))
-> LByteString
-> Either DecoderError (TxBody era)
forall a.
Text
-> (forall s. Decoder s (Annotator a))
-> LByteString
-> Either DecoderError a
CBOR.decodeAnnotator
      Text
"Sophie TxBody"
      forall s. Decoder s (Annotator (TxBody era))
decodeAnnotatedTuple
      (ByteString -> LByteString
LBS.fromStrict ByteString
bs)
  where
    decodeAnnotatedTuple :: CBOR.Decoder s (CBOR.Annotator (TxBody era))
    decodeAnnotatedTuple :: Decoder s (Annotator (TxBody era))
decodeAnnotatedTuple = do
      Int
len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen

      case Int
len of
        -- Backwards compat for pre-Aurum era tx body files
        Int
3 -> do
          Annotator (TxBody ledgerera)
txbody     <- Decoder s (Annotator (TxBody ledgerera))
forall a s. FromCBOR a => Decoder s a
fromCBOR
          [Annotator (Script ledgerera)]
txscripts  <- Decoder s [Annotator (Script ledgerera)]
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Maybe (Annotator (AuxiliaryData ledgerera))
txmetadata <- Decoder s (Annotator (AuxiliaryData ledgerera))
-> Decoder s (Maybe (Annotator (AuxiliaryData ledgerera)))
forall s a. Decoder s a -> Decoder s (Maybe a)
CBOR.decodeNullMaybe Decoder s (Annotator (AuxiliaryData ledgerera))
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Annotator (TxBody era) -> Decoder s (Annotator (TxBody era))
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotator (TxBody era) -> Decoder s (Annotator (TxBody era)))
-> Annotator (TxBody era) -> Decoder s (Annotator (TxBody era))
forall a b. (a -> b) -> a -> b
$ (FullByteString -> TxBody era) -> Annotator (TxBody era)
forall a. (FullByteString -> a) -> Annotator a
CBOR.Annotator ((FullByteString -> TxBody era) -> Annotator (TxBody era))
-> (FullByteString -> TxBody era) -> Annotator (TxBody era)
forall a b. (a -> b) -> a -> b
$ \FullByteString
fbs ->
            SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [Script (SophieLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxScriptValidity era
-> TxBody era
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [Script (SophieLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxScriptValidity era
-> TxBody era
SophieTxBody SophieBasedEra era
era
              ((Annotator (TxBody ledgerera)
 -> FullByteString -> TxBody ledgerera)
-> FullByteString
-> Annotator (TxBody ledgerera)
-> TxBody ledgerera
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (TxBody ledgerera) -> FullByteString -> TxBody ledgerera
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs Annotator (TxBody ledgerera)
txbody)
              ((Annotator (Script ledgerera) -> Script ledgerera)
-> [Annotator (Script ledgerera)] -> [Script ledgerera]
forall a b. (a -> b) -> [a] -> [b]
map ((Annotator (Script ledgerera)
 -> FullByteString -> Script ledgerera)
-> FullByteString
-> Annotator (Script ledgerera)
-> Script ledgerera
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (Script ledgerera) -> FullByteString -> Script ledgerera
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs) [Annotator (Script ledgerera)]
txscripts)
              ((Annotator (TxBodyScriptData era)
 -> FullByteString -> TxBodyScriptData era)
-> FullByteString
-> Annotator (TxBodyScriptData era)
-> TxBodyScriptData era
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (TxBodyScriptData era)
-> FullByteString -> TxBodyScriptData era
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs (TxBodyScriptData era -> Annotator (TxBodyScriptData era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxBodyScriptData era
forall era. TxBodyScriptData era
TxBodyNoScriptData))
              ((Annotator (AuxiliaryData ledgerera) -> AuxiliaryData ledgerera)
-> Maybe (Annotator (AuxiliaryData ledgerera))
-> Maybe (AuxiliaryData ledgerera)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Annotator (AuxiliaryData ledgerera)
 -> FullByteString -> AuxiliaryData ledgerera)
-> FullByteString
-> Annotator (AuxiliaryData ledgerera)
-> AuxiliaryData ledgerera
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (AuxiliaryData ledgerera)
-> FullByteString -> AuxiliaryData ledgerera
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs) Maybe (Annotator (AuxiliaryData ledgerera))
txmetadata)
              ((Annotator (TxScriptValidity era)
 -> FullByteString -> TxScriptValidity era)
-> FullByteString
-> Annotator (TxScriptValidity era)
-> TxScriptValidity era
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (TxScriptValidity era)
-> FullByteString -> TxScriptValidity era
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs (TxScriptValidity era -> Annotator (TxScriptValidity era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxScriptValidity era
forall era. TxScriptValidity era
TxScriptValidityNone))
        Int
4 -> do
          TxScriptValiditySupportedInEra era
sValiditySupported <-
            case SophieBasedEra era -> Maybe (TxScriptValiditySupportedInEra era)
forall era.
SophieBasedEra era -> Maybe (TxScriptValiditySupportedInEra era)
txScriptValiditySupportedInSophieBasedEra SophieBasedEra era
era of
              Maybe (TxScriptValiditySupportedInEra era)
Nothing -> String -> Decoder s (TxScriptValiditySupportedInEra era)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (TxScriptValiditySupportedInEra era))
-> String -> Decoder s (TxScriptValiditySupportedInEra era)
forall a b. (a -> b) -> a -> b
$ String
"deserialiseSophieBasedTxBody: Expected an era that supports the \
                                \script validity flag but got: "
                              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SophieBasedEra era -> String
forall a. Show a => a -> String
show SophieBasedEra era
era
              Just TxScriptValiditySupportedInEra era
supported -> TxScriptValiditySupportedInEra era
-> Decoder s (TxScriptValiditySupportedInEra era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxScriptValiditySupportedInEra era
supported

          Annotator (TxBody ledgerera)
txbody     <- Decoder s (Annotator (TxBody ledgerera))
forall a s. FromCBOR a => Decoder s a
fromCBOR
          [Annotator (Script ledgerera)]
txscripts  <- Decoder s [Annotator (Script ledgerera)]
forall a s. FromCBOR a => Decoder s a
fromCBOR
          ScriptValidity
scriptValidity <- Decoder s ScriptValidity
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Maybe (Annotator (AuxiliaryData ledgerera))
txmetadata <- Decoder s (Annotator (AuxiliaryData ledgerera))
-> Decoder s (Maybe (Annotator (AuxiliaryData ledgerera)))
forall s a. Decoder s a -> Decoder s (Maybe a)
CBOR.decodeNullMaybe Decoder s (Annotator (AuxiliaryData ledgerera))
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Annotator (TxBody era) -> Decoder s (Annotator (TxBody era))
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotator (TxBody era) -> Decoder s (Annotator (TxBody era)))
-> Annotator (TxBody era) -> Decoder s (Annotator (TxBody era))
forall a b. (a -> b) -> a -> b
$ (FullByteString -> TxBody era) -> Annotator (TxBody era)
forall a. (FullByteString -> a) -> Annotator a
CBOR.Annotator ((FullByteString -> TxBody era) -> Annotator (TxBody era))
-> (FullByteString -> TxBody era) -> Annotator (TxBody era)
forall a b. (a -> b) -> a -> b
$ \FullByteString
fbs ->
            SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [Script (SophieLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxScriptValidity era
-> TxBody era
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [Script (SophieLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxScriptValidity era
-> TxBody era
SophieTxBody SophieBasedEra era
era
              ((Annotator (TxBody ledgerera)
 -> FullByteString -> TxBody ledgerera)
-> FullByteString
-> Annotator (TxBody ledgerera)
-> TxBody ledgerera
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (TxBody ledgerera) -> FullByteString -> TxBody ledgerera
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs Annotator (TxBody ledgerera)
txbody)
              ((Annotator (Script ledgerera) -> Script ledgerera)
-> [Annotator (Script ledgerera)] -> [Script ledgerera]
forall a b. (a -> b) -> [a] -> [b]
map ((Annotator (Script ledgerera)
 -> FullByteString -> Script ledgerera)
-> FullByteString
-> Annotator (Script ledgerera)
-> Script ledgerera
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (Script ledgerera) -> FullByteString -> Script ledgerera
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs) [Annotator (Script ledgerera)]
txscripts)
              ((Annotator (TxBodyScriptData era)
 -> FullByteString -> TxBodyScriptData era)
-> FullByteString
-> Annotator (TxBodyScriptData era)
-> TxBodyScriptData era
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (TxBodyScriptData era)
-> FullByteString -> TxBodyScriptData era
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs (TxBodyScriptData era -> Annotator (TxBodyScriptData era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxBodyScriptData era
forall era. TxBodyScriptData era
TxBodyNoScriptData))
              ((Annotator (AuxiliaryData ledgerera) -> AuxiliaryData ledgerera)
-> Maybe (Annotator (AuxiliaryData ledgerera))
-> Maybe (AuxiliaryData ledgerera)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Annotator (AuxiliaryData ledgerera)
 -> FullByteString -> AuxiliaryData ledgerera)
-> FullByteString
-> Annotator (AuxiliaryData ledgerera)
-> AuxiliaryData ledgerera
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (AuxiliaryData ledgerera)
-> FullByteString -> AuxiliaryData ledgerera
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs) Maybe (Annotator (AuxiliaryData ledgerera))
txmetadata)
              ((Annotator (TxScriptValidity era)
 -> FullByteString -> TxScriptValidity era)
-> FullByteString
-> Annotator (TxScriptValidity era)
-> TxScriptValidity era
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (TxScriptValidity era)
-> FullByteString -> TxScriptValidity era
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs (TxScriptValidity era -> Annotator (TxScriptValidity era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxScriptValidity era -> Annotator (TxScriptValidity era))
-> TxScriptValidity era -> Annotator (TxScriptValidity era)
forall a b. (a -> b) -> a -> b
$ TxScriptValiditySupportedInEra era
-> ScriptValidity -> TxScriptValidity era
forall era.
TxScriptValiditySupportedInEra era
-> ScriptValidity -> TxScriptValidity era
TxScriptValidity TxScriptValiditySupportedInEra era
sValiditySupported ScriptValidity
scriptValidity))
        Int
6 -> do
          ScriptDataSupportedInEra era
sDataSupported <-
            case BccEra era -> Maybe (ScriptDataSupportedInEra era)
forall era. BccEra era -> Maybe (ScriptDataSupportedInEra era)
scriptDataSupportedInEra (SophieBasedEra era -> BccEra era
forall era. SophieBasedEra era -> BccEra era
sophieBasedToBccEra SophieBasedEra era
era) of
              Maybe (ScriptDataSupportedInEra era)
Nothing -> String -> Decoder s (ScriptDataSupportedInEra era)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (ScriptDataSupportedInEra era))
-> String -> Decoder s (ScriptDataSupportedInEra era)
forall a b. (a -> b) -> a -> b
$ String
"deserialiseSophieBasedTxBody: Expected an era that supports script\
                                \ data but got: "
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SophieBasedEra era -> String
forall a. Show a => a -> String
show SophieBasedEra era
era
              Just ScriptDataSupportedInEra era
supported -> ScriptDataSupportedInEra era
-> Decoder s (ScriptDataSupportedInEra era)
forall (m :: * -> *) a. Monad m => a -> m a
return ScriptDataSupportedInEra era
supported

          TxScriptValiditySupportedInEra era
sValiditySupported <-
            case SophieBasedEra era -> Maybe (TxScriptValiditySupportedInEra era)
forall era.
SophieBasedEra era -> Maybe (TxScriptValiditySupportedInEra era)
txScriptValiditySupportedInSophieBasedEra SophieBasedEra era
era of
              Maybe (TxScriptValiditySupportedInEra era)
Nothing -> String -> Decoder s (TxScriptValiditySupportedInEra era)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (TxScriptValiditySupportedInEra era))
-> String -> Decoder s (TxScriptValiditySupportedInEra era)
forall a b. (a -> b) -> a -> b
$ String
"deserialiseSophieBasedTxBody: Expected an era that supports the \
                                \script validity flag but got: "
                              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SophieBasedEra era -> String
forall a. Show a => a -> String
show SophieBasedEra era
era
              Just TxScriptValiditySupportedInEra era
supported -> TxScriptValiditySupportedInEra era
-> Decoder s (TxScriptValiditySupportedInEra era)
forall (m :: * -> *) a. Monad m => a -> m a
return TxScriptValiditySupportedInEra era
supported

          Annotator (TxBody ledgerera)
txbody    <- Decoder s (Annotator (TxBody ledgerera))
forall a s. FromCBOR a => Decoder s a
fromCBOR
          [Annotator (Script ledgerera)]
txscripts <- Decoder s [Annotator (Script ledgerera)]
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Annotator (TxDats ledgerera)
datums    <- Decoder s (Annotator (TxDats ledgerera))
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Annotator (Redeemers ledgerera)
redeemers <- Decoder s (Annotator (Redeemers ledgerera))
forall a s. FromCBOR a => Decoder s a
fromCBOR
          ScriptValidity
scriptValidity <- Decoder s ScriptValidity
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Maybe (Annotator (AuxiliaryData ledgerera))
txmetadata <- Decoder s (Annotator (AuxiliaryData ledgerera))
-> Decoder s (Maybe (Annotator (AuxiliaryData ledgerera)))
forall s a. Decoder s a -> Decoder s (Maybe a)
CBOR.decodeNullMaybe Decoder s (Annotator (AuxiliaryData ledgerera))
forall a s. FromCBOR a => Decoder s a
fromCBOR

          let txscriptdata :: Annotator (TxBodyScriptData era)
txscriptdata = (FullByteString -> TxBodyScriptData era)
-> Annotator (TxBodyScriptData era)
forall a. (FullByteString -> a) -> Annotator a
CBOR.Annotator ((FullByteString -> TxBodyScriptData era)
 -> Annotator (TxBodyScriptData era))
-> (FullByteString -> TxBodyScriptData era)
-> Annotator (TxBodyScriptData era)
forall a b. (a -> b) -> a -> b
$ \FullByteString
fbs ->
                               ScriptDataSupportedInEra era
-> TxDats (SophieLedgerEra era)
-> Redeemers (SophieLedgerEra era)
-> TxBodyScriptData era
forall era.
ScriptDataSupportedInEra era
-> TxDats (SophieLedgerEra era)
-> Redeemers (SophieLedgerEra era)
-> TxBodyScriptData era
TxBodyScriptData ScriptDataSupportedInEra era
sDataSupported
                                 ((Annotator (TxDats ledgerera)
 -> FullByteString -> TxDats ledgerera)
-> FullByteString
-> Annotator (TxDats ledgerera)
-> TxDats ledgerera
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (TxDats ledgerera) -> FullByteString -> TxDats ledgerera
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs Annotator (TxDats ledgerera)
datums)
                                 ((Annotator (Redeemers ledgerera)
 -> FullByteString -> Redeemers ledgerera)
-> FullByteString
-> Annotator (Redeemers ledgerera)
-> Redeemers ledgerera
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (Redeemers ledgerera)
-> FullByteString -> Redeemers ledgerera
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs Annotator (Redeemers ledgerera)
redeemers)

          Annotator (TxBody era) -> Decoder s (Annotator (TxBody era))
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotator (TxBody era) -> Decoder s (Annotator (TxBody era)))
-> Annotator (TxBody era) -> Decoder s (Annotator (TxBody era))
forall a b. (a -> b) -> a -> b
$ (FullByteString -> TxBody era) -> Annotator (TxBody era)
forall a. (FullByteString -> a) -> Annotator a
CBOR.Annotator ((FullByteString -> TxBody era) -> Annotator (TxBody era))
-> (FullByteString -> TxBody era) -> Annotator (TxBody era)
forall a b. (a -> b) -> a -> b
$ \FullByteString
fbs ->
            SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [Script (SophieLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxScriptValidity era
-> TxBody era
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [Script (SophieLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxScriptValidity era
-> TxBody era
SophieTxBody SophieBasedEra era
era
              ((Annotator (TxBody ledgerera)
 -> FullByteString -> TxBody ledgerera)
-> FullByteString
-> Annotator (TxBody ledgerera)
-> TxBody ledgerera
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (TxBody ledgerera) -> FullByteString -> TxBody ledgerera
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs Annotator (TxBody ledgerera)
txbody)
              ((Annotator (Script ledgerera) -> Script ledgerera)
-> [Annotator (Script ledgerera)] -> [Script ledgerera]
forall a b. (a -> b) -> [a] -> [b]
map ((Annotator (Script ledgerera)
 -> FullByteString -> Script ledgerera)
-> FullByteString
-> Annotator (Script ledgerera)
-> Script ledgerera
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (Script ledgerera) -> FullByteString -> Script ledgerera
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs) [Annotator (Script ledgerera)]
txscripts)
              ((Annotator (TxBodyScriptData era)
 -> FullByteString -> TxBodyScriptData era)
-> FullByteString
-> Annotator (TxBodyScriptData era)
-> TxBodyScriptData era
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (TxBodyScriptData era)
-> FullByteString -> TxBodyScriptData era
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs Annotator (TxBodyScriptData era)
txscriptdata)
              ((Annotator (AuxiliaryData ledgerera) -> AuxiliaryData ledgerera)
-> Maybe (Annotator (AuxiliaryData ledgerera))
-> Maybe (AuxiliaryData ledgerera)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Annotator (AuxiliaryData ledgerera)
 -> FullByteString -> AuxiliaryData ledgerera)
-> FullByteString
-> Annotator (AuxiliaryData ledgerera)
-> AuxiliaryData ledgerera
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (AuxiliaryData ledgerera)
-> FullByteString -> AuxiliaryData ledgerera
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs) Maybe (Annotator (AuxiliaryData ledgerera))
txmetadata)
              ((Annotator (TxScriptValidity era)
 -> FullByteString -> TxScriptValidity era)
-> FullByteString
-> Annotator (TxScriptValidity era)
-> TxScriptValidity era
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (TxScriptValidity era)
-> FullByteString -> TxScriptValidity era
forall a. Annotator a -> FullByteString -> a
CBOR.runAnnotator FullByteString
fbs (TxScriptValidity era -> Annotator (TxScriptValidity era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxScriptValidity era -> Annotator (TxScriptValidity era))
-> TxScriptValidity era -> Annotator (TxScriptValidity era)
forall a b. (a -> b) -> a -> b
$ TxScriptValiditySupportedInEra era
-> ScriptValidity -> TxScriptValidity era
forall era.
TxScriptValiditySupportedInEra era
-> ScriptValidity -> TxScriptValidity era
TxScriptValidity TxScriptValiditySupportedInEra era
sValiditySupported ScriptValidity
scriptValidity))
        Int
_ -> String -> Decoder s (Annotator (TxBody era))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected tx body tuple of size 3, 4 or 6"

instance IsBccEra era => HasTextEnvelope (TxBody era) where
    textEnvelopeType :: AsType (TxBody era) -> TextEnvelopeType
textEnvelopeType AsType (TxBody era)
_ =
      case BccEra era
forall era. IsBccEra era => BccEra era
bccEra :: BccEra era of
        BccEra era
ColeEra   -> TextEnvelopeType
"TxUnsignedCole"
        BccEra era
SophieEra -> TextEnvelopeType
"TxUnsignedSophie"
        BccEra era
EvieEra -> TextEnvelopeType
"TxBodyEvie"
        BccEra era
JenEra    -> TextEnvelopeType
"TxBodyJen"
        BccEra era
AurumEra  -> TextEnvelopeType
"TxBodyAurum"


-- ----------------------------------------------------------------------------
-- Constructing transaction bodies
--

data TxBodyError =
       TxBodyEmptyTxIns
     | TxBodyEmptyTxInsCollateral
     | TxBodyEmptyTxOuts
     | TxBodyOutputNegative Quantity TxOutInAnyEra
     | TxBodyOutputOverflow Quantity TxOutInAnyEra
     | TxBodyMetadataError [(Word64, TxMetadataRangeError)]
     | TxBodyMintBccError
     | TxBodyMissingProtocolParams
     deriving Int -> TxBodyError -> ShowS
[TxBodyError] -> ShowS
TxBodyError -> String
(Int -> TxBodyError -> ShowS)
-> (TxBodyError -> String)
-> ([TxBodyError] -> ShowS)
-> Show TxBodyError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxBodyError] -> ShowS
$cshowList :: [TxBodyError] -> ShowS
show :: TxBodyError -> String
$cshow :: TxBodyError -> String
showsPrec :: Int -> TxBodyError -> ShowS
$cshowsPrec :: Int -> TxBodyError -> ShowS
Show

instance Error TxBodyError where
    displayError :: TxBodyError -> String
displayError TxBodyError
TxBodyEmptyTxIns  = String
"Transaction body has no inputs"
    displayError TxBodyError
TxBodyEmptyTxInsCollateral =
      String
"Transaction body has no collateral inputs, but uses Zerepoch scripts"
    displayError TxBodyError
TxBodyEmptyTxOuts = String
"Transaction body has no outputs"
    displayError (TxBodyOutputNegative (Quantity Integer
q) TxOutInAnyEra
txout) =
      String
"Negative quantity (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
q String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") in transaction output: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      TxOutInAnyEra -> String
forall a. Show a => a -> String
show TxOutInAnyEra
txout
    displayError (TxBodyOutputOverflow (Quantity Integer
q) TxOutInAnyEra
txout) =
      String
"Quantity too large (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
q String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" >= 2^64) in transaction output: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      TxOutInAnyEra -> String
forall a. Show a => a -> String
show TxOutInAnyEra
txout
    displayError (TxBodyMetadataError [(Word64
k, TxMetadataRangeError
err)]) =
      String
"Error in metadata entry " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TxMetadataRangeError -> String
forall e. Error e => e -> String
displayError TxMetadataRangeError
err
    displayError (TxBodyMetadataError [(Word64, TxMetadataRangeError)]
errs) =
      String
"Error in metadata entries: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"; "
        [ Word64 -> String
forall a. Show a => a -> String
show Word64
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TxMetadataRangeError -> String
forall e. Error e => e -> String
displayError TxMetadataRangeError
err
        | (Word64
k, TxMetadataRangeError
err) <- [(Word64, TxMetadataRangeError)]
errs ]
    displayError TxBodyError
TxBodyMintBccError =
      String
"Transaction cannot mint bcc, only non-bcc assets"
    displayError TxBodyError
TxBodyMissingProtocolParams =
      String
"Transaction uses Zerepoch scripts but does not provide the protocol " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"parameters to hash"


makeTransactionBody :: forall era.
     IsBccEra era
  => TxBodyContent BuildTx era
  -> Either TxBodyError (TxBody era)
makeTransactionBody :: TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
makeTransactionBody =
    case BccEra era -> BccEraStyle era
forall era. BccEra era -> BccEraStyle era
bccEraStyle (BccEra era
forall era. IsBccEra era => BccEra era
bccEra :: BccEra era) of
      BccEraStyle era
LegacyColeEra      -> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
TxBodyContent BuildTx ColeEra
-> Either TxBodyError (TxBody ColeEra)
makeColeTransactionBody
      SophieBasedEra SophieBasedEra era
era -> SophieBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
forall era.
SophieBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
makeSophieTransactionBody SophieBasedEra era
era


pattern TxBody :: TxBodyContent ViewTx era -> TxBody era
pattern $mTxBody :: forall r era.
TxBody era -> (TxBodyContent ViewTx era -> r) -> (Void# -> r) -> r
TxBody txbodycontent <- (getTxBodyContent -> txbodycontent)
{-# COMPLETE TxBody #-}

getTxBodyContent :: TxBody era -> TxBodyContent ViewTx era
getTxBodyContent :: TxBody era -> TxBodyContent ViewTx era
getTxBodyContent (ColeTxBody Annotated Tx ByteString
body) = Annotated Tx ByteString -> TxBodyContent ViewTx ColeEra
getColeTxBodyContent Annotated Tx ByteString
body
getTxBodyContent (SophieTxBody SophieBasedEra era
era TxBody (SophieLedgerEra era)
body [Script (SophieLedgerEra era)]
_scripts TxBodyScriptData era
_redeemers Maybe (AuxiliaryData (SophieLedgerEra era))
mAux TxScriptValidity era
scriptValidity) =
    SophieBasedEra era
-> TxScriptValidity era
-> TxBody (SophieLedgerEra era)
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxBodyContent ViewTx era
forall era.
SophieBasedEra era
-> TxScriptValidity era
-> TxBody (SophieLedgerEra era)
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxBodyContent ViewTx era
fromLedgerTxBody SophieBasedEra era
era TxScriptValidity era
scriptValidity TxBody (SophieLedgerEra era)
body Maybe (AuxiliaryData (SophieLedgerEra era))
mAux


fromLedgerTxBody
  :: SophieBasedEra era
  -> TxScriptValidity era
  -> Ledger.TxBody (SophieLedgerEra era)
  -> Maybe (Ledger.AuxiliaryData (SophieLedgerEra era))
  -> TxBodyContent ViewTx era
fromLedgerTxBody :: SophieBasedEra era
-> TxScriptValidity era
-> TxBody (SophieLedgerEra era)
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxBodyContent ViewTx era
fromLedgerTxBody SophieBasedEra era
era TxScriptValidity era
scriptValidity TxBody (SophieLedgerEra era)
body Maybe (AuxiliaryData (SophieLedgerEra era))
mAux =
    TxBodyContent :: forall build era.
TxIns build era
-> TxInsCollateral era
-> [TxOut era]
-> TxFee era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
-> TxMetadataInEra era
-> TxAuxScripts era
-> BuildTxWith build (TxExtraScriptData era)
-> TxExtraKeyWitnesses era
-> BuildTxWith build (Maybe ProtocolParameters)
-> TxWithdrawals build era
-> TxCertificates build era
-> TxUpdateProposal era
-> TxMintValue build era
-> TxScriptValidity era
-> TxBodyContent build era
TxBodyContent
      { txIns :: TxIns ViewTx era
txIns            = SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxIns ViewTx era
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [(TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn era))]
fromLedgerTxIns            SophieBasedEra era
era TxBody (SophieLedgerEra era)
body
      , txInsCollateral :: TxInsCollateral era
txInsCollateral  = SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxInsCollateral era
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxInsCollateral era
fromLedgerTxInsCollateral  SophieBasedEra era
era TxBody (SophieLedgerEra era)
body
      , txOuts :: [TxOut era]
txOuts           = SophieBasedEra era -> TxBody (SophieLedgerEra era) -> [TxOut era]
forall era.
SophieBasedEra era -> TxBody (SophieLedgerEra era) -> [TxOut era]
fromLedgerTxOuts           SophieBasedEra era
era TxBody (SophieLedgerEra era)
body
      , txFee :: TxFee era
txFee            = SophieBasedEra era -> TxBody (SophieLedgerEra era) -> TxFee era
forall era.
SophieBasedEra era -> TxBody (SophieLedgerEra era) -> TxFee era
fromLedgerTxFee            SophieBasedEra era
era TxBody (SophieLedgerEra era)
body
      , txValidityRange :: (TxValidityLowerBound era, TxValidityUpperBound era)
txValidityRange  = SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> (TxValidityLowerBound era, TxValidityUpperBound era)
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> (TxValidityLowerBound era, TxValidityUpperBound era)
fromLedgerTxValidityRange  SophieBasedEra era
era TxBody (SophieLedgerEra era)
body
      , txWithdrawals :: TxWithdrawals ViewTx era
txWithdrawals    = SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxWithdrawals ViewTx era
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxWithdrawals ViewTx era
fromLedgerTxWithdrawals    SophieBasedEra era
era TxBody (SophieLedgerEra era)
body
      , txCertificates :: TxCertificates ViewTx era
txCertificates   = SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxCertificates ViewTx era
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxCertificates ViewTx era
fromLedgerTxCertificates   SophieBasedEra era
era TxBody (SophieLedgerEra era)
body
      , txUpdateProposal :: TxUpdateProposal era
txUpdateProposal = SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxUpdateProposal era
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxUpdateProposal era
fromLedgerTxUpdateProposal SophieBasedEra era
era TxBody (SophieLedgerEra era)
body
      , txMintValue :: TxMintValue ViewTx era
txMintValue      = SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxMintValue ViewTx era
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxMintValue ViewTx era
fromLedgerTxMintValue      SophieBasedEra era
era TxBody (SophieLedgerEra era)
body
      , txExtraKeyWits :: TxExtraKeyWitnesses era
txExtraKeyWits   = SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxExtraKeyWitnesses era
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxExtraKeyWitnesses era
fromLedgerTxExtraKeyWitnesses SophieBasedEra era
era TxBody (SophieLedgerEra era)
body
      , txProtocolParams :: BuildTxWith ViewTx (Maybe ProtocolParameters)
txProtocolParams = BuildTxWith ViewTx (Maybe ProtocolParameters)
forall a. BuildTxWith ViewTx a
ViewTx
      , TxMetadataInEra era
txMetadata :: TxMetadataInEra era
txMetadata :: TxMetadataInEra era
txMetadata
      , TxAuxScripts era
txAuxScripts :: TxAuxScripts era
txAuxScripts :: TxAuxScripts era
txAuxScripts
      , txExtraScriptData :: BuildTxWith ViewTx (TxExtraScriptData era)
txExtraScriptData = BuildTxWith ViewTx (TxExtraScriptData era)
forall a. BuildTxWith ViewTx a
ViewTx
      , txScriptValidity :: TxScriptValidity era
txScriptValidity = TxScriptValidity era
scriptValidity
      }
  where
    (TxMetadataInEra era
txMetadata, TxAuxScripts era
txAuxScripts) = SophieBasedEra era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> (TxMetadataInEra era, TxAuxScripts era)
forall era.
SophieBasedEra era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> (TxMetadataInEra era, TxAuxScripts era)
fromLedgerTxAuxiliaryData SophieBasedEra era
era Maybe (AuxiliaryData (SophieLedgerEra era))
mAux


fromLedgerTxIns
  :: forall era.
     SophieBasedEra era
  -> Ledger.TxBody (SophieLedgerEra era)
  -> [(TxIn,BuildTxWith ViewTx (Witness WitCtxTxIn era))]
fromLedgerTxIns :: SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [(TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn era))]
fromLedgerTxIns SophieBasedEra era
era TxBody (SophieLedgerEra era)
body =
    [ (TxIn StandardCrypto -> TxIn
fromSophieTxIn TxIn StandardCrypto
input, BuildTxWith ViewTx (Witness WitCtxTxIn era)
forall a. BuildTxWith ViewTx a
ViewTx)
    | TxIn StandardCrypto
input <- Set (TxIn StandardCrypto) -> [TxIn StandardCrypto]
forall a. Set a -> [a]
Set.toList (SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> Set (TxIn StandardCrypto)
inputs SophieBasedEra era
era TxBody (SophieLedgerEra era)
body) ]
  where
    inputs :: SophieBasedEra era
           -> Ledger.TxBody (SophieLedgerEra era)
           -> Set (Sophie.TxIn StandardCrypto)
    inputs :: SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> Set (TxIn StandardCrypto)
inputs SophieBasedEra era
SophieBasedEraSophie = TxBody (SophieLedgerEra era) -> Set (TxIn StandardCrypto)
forall era.
TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   Set (TxIn (Crypto era))
Sophie._inputs
    inputs SophieBasedEra era
SophieBasedEraEvie = TxBody (SophieLedgerEra era) -> Set (TxIn StandardCrypto)
forall era. TxBody era -> Set (TxIn (Crypto era))
Evie.inputs'
    inputs SophieBasedEra era
SophieBasedEraJen    = TxBody (SophieLedgerEra era) -> Set (TxIn StandardCrypto)
forall era. TxBody era -> Set (TxIn (Crypto era))
Jen.inputs'
    inputs SophieBasedEra era
SophieBasedEraAurum  = TxBody (SophieLedgerEra era) -> Set (TxIn StandardCrypto)
forall era. TxBody era -> Set (TxIn (Crypto era))
Aurum.inputs'


fromLedgerTxInsCollateral
  :: forall era.
     SophieBasedEra era
  -> Ledger.TxBody (SophieLedgerEra era)
  -> TxInsCollateral era
fromLedgerTxInsCollateral :: SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxInsCollateral era
fromLedgerTxInsCollateral SophieBasedEra era
era TxBody (SophieLedgerEra era)
body =
    case BccEra era -> Maybe (CollateralSupportedInEra era)
forall era. BccEra era -> Maybe (CollateralSupportedInEra era)
collateralSupportedInEra (SophieBasedEra era -> BccEra era
forall era. SophieBasedEra era -> BccEra era
sophieBasedToBccEra SophieBasedEra era
era) of
      Maybe (CollateralSupportedInEra era)
Nothing        -> TxInsCollateral era
forall era. TxInsCollateral era
TxInsCollateralNone
      Just CollateralSupportedInEra era
supported -> CollateralSupportedInEra era -> [TxIn] -> TxInsCollateral era
forall era.
CollateralSupportedInEra era -> [TxIn] -> TxInsCollateral era
TxInsCollateral CollateralSupportedInEra era
supported
                          [ TxIn StandardCrypto -> TxIn
fromSophieTxIn TxIn StandardCrypto
input
                          | TxIn StandardCrypto
input <- Set (TxIn StandardCrypto) -> [TxIn StandardCrypto]
forall a. Set a -> [a]
Set.toList (SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> Set (TxIn StandardCrypto)
collateral SophieBasedEra era
era TxBody (SophieLedgerEra era)
body) ]
  where
    collateral :: SophieBasedEra era
               -> Ledger.TxBody (SophieLedgerEra era)
               -> Set (Sophie.TxIn StandardCrypto)
    collateral :: SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> Set (TxIn StandardCrypto)
collateral SophieBasedEra era
SophieBasedEraSophie = Set (TxIn StandardCrypto)
-> TxBody (SophieEra StandardCrypto) -> Set (TxIn StandardCrypto)
forall a b. a -> b -> a
const Set (TxIn StandardCrypto)
forall a. Set a
Set.empty
    collateral SophieBasedEra era
SophieBasedEraEvie = Set (TxIn StandardCrypto)
-> TxBody (SophieMAEra 'Evie StandardCrypto)
-> Set (TxIn StandardCrypto)
forall a b. a -> b -> a
const Set (TxIn StandardCrypto)
forall a. Set a
Set.empty
    collateral SophieBasedEra era
SophieBasedEraJen    = Set (TxIn StandardCrypto)
-> TxBody (SophieMAEra 'Jen StandardCrypto)
-> Set (TxIn StandardCrypto)
forall a b. a -> b -> a
const Set (TxIn StandardCrypto)
forall a. Set a
Set.empty
    collateral SophieBasedEra era
SophieBasedEraAurum  = TxBody (SophieLedgerEra era) -> Set (TxIn StandardCrypto)
forall era. TxBody era -> Set (TxIn (Crypto era))
Aurum.collateral'


fromLedgerTxOuts
  :: SophieBasedEra era -> Ledger.TxBody (SophieLedgerEra era) -> [TxOut era]
fromLedgerTxOuts :: SophieBasedEra era -> TxBody (SophieLedgerEra era) -> [TxOut era]
fromLedgerTxOuts SophieBasedEra era
era TxBody (SophieLedgerEra era)
body =
  SophieBasedEra era -> TxOut (SophieLedgerEra era) -> TxOut era
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera) =>
SophieBasedEra era -> TxOut ledgerera -> TxOut era
fromSophieTxOut SophieBasedEra era
era (TxOut (SophieLedgerEra era) -> TxOut era)
-> [TxOut (SophieLedgerEra era)] -> [TxOut era]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  case SophieBasedEra era
era of
    SophieBasedEra era
SophieBasedEraSophie -> StrictSeq (TxOut (SophieLedgerEra era))
-> [TxOut (SophieLedgerEra era)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (TxOut (SophieLedgerEra era))
 -> [TxOut (SophieLedgerEra era)])
-> StrictSeq (TxOut (SophieLedgerEra era))
-> [TxOut (SophieLedgerEra era)]
forall a b. (a -> b) -> a -> b
$ TxBody (SophieEra StandardCrypto)
-> (Era (SophieEra StandardCrypto),
    FromCBOR (PParamsDelta (SophieEra StandardCrypto)),
    TransTxBody ToCBOR (SophieEra StandardCrypto)) =>
   StrictSeq (TxOut (SophieEra StandardCrypto))
forall era.
TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   StrictSeq (TxOut era)
Sophie._outputs TxBody (SophieLedgerEra era)
TxBody (SophieEra StandardCrypto)
body
    SophieBasedEra era
SophieBasedEraEvie -> StrictSeq (TxOut (SophieMAEra 'Evie StandardCrypto))
-> [TxOut (SophieMAEra 'Evie StandardCrypto)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (TxOut (SophieMAEra 'Evie StandardCrypto))
 -> [TxOut (SophieMAEra 'Evie StandardCrypto)])
-> StrictSeq (TxOut (SophieMAEra 'Evie StandardCrypto))
-> [TxOut (SophieMAEra 'Evie StandardCrypto)]
forall a b. (a -> b) -> a -> b
$ TxBody (SophieMAEra 'Evie StandardCrypto)
-> StrictSeq (TxOut (SophieMAEra 'Evie StandardCrypto))
forall era. TxBody era -> StrictSeq (TxOut era)
Evie.outputs' TxBody (SophieMAEra 'Evie StandardCrypto)
TxBody (SophieLedgerEra era)
body
    SophieBasedEra era
SophieBasedEraJen    -> StrictSeq (TxOut (SophieMAEra 'Jen StandardCrypto))
-> [TxOut (SophieMAEra 'Jen StandardCrypto)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (TxOut (SophieMAEra 'Jen StandardCrypto))
 -> [TxOut (SophieMAEra 'Jen StandardCrypto)])
-> StrictSeq (TxOut (SophieMAEra 'Jen StandardCrypto))
-> [TxOut (SophieMAEra 'Jen StandardCrypto)]
forall a b. (a -> b) -> a -> b
$ TxBody (SophieMAEra 'Jen StandardCrypto)
-> StrictSeq (TxOut (SophieMAEra 'Jen StandardCrypto))
forall era. TxBody era -> StrictSeq (TxOut era)
Jen.outputs'    TxBody (SophieMAEra 'Jen StandardCrypto)
TxBody (SophieLedgerEra era)
body
    SophieBasedEra era
SophieBasedEraAurum  -> StrictSeq (TxOut (AurumEra StandardCrypto))
-> [TxOut (AurumEra StandardCrypto)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (TxOut (AurumEra StandardCrypto))
 -> [TxOut (AurumEra StandardCrypto)])
-> StrictSeq (TxOut (AurumEra StandardCrypto))
-> [TxOut (AurumEra StandardCrypto)]
forall a b. (a -> b) -> a -> b
$ TxBody (AurumEra StandardCrypto)
-> StrictSeq (TxOut (AurumEra StandardCrypto))
forall era. TxBody era -> StrictSeq (TxOut era)
Aurum.outputs'  TxBody (SophieLedgerEra era)
TxBody (AurumEra StandardCrypto)
body

fromLedgerTxFee
  :: SophieBasedEra era -> Ledger.TxBody (SophieLedgerEra era) -> TxFee era
fromLedgerTxFee :: SophieBasedEra era -> TxBody (SophieLedgerEra era) -> TxFee era
fromLedgerTxFee SophieBasedEra era
era TxBody (SophieLedgerEra era)
body =
  case SophieBasedEra era
era of
    SophieBasedEra era
SophieBasedEraSophie ->
      TxFeesExplicitInEra SophieEra -> Entropic -> TxFee SophieEra
forall era. TxFeesExplicitInEra era -> Entropic -> TxFee era
TxFeeExplicit TxFeesExplicitInEra SophieEra
TxFeesExplicitInSophieEra (Entropic -> TxFee SophieEra) -> Entropic -> TxFee SophieEra
forall a b. (a -> b) -> a -> b
$
      Coin -> Entropic
fromSophieEntropic (Coin -> Entropic) -> Coin -> Entropic
forall a b. (a -> b) -> a -> b
$ TxBody (SophieEra StandardCrypto)
-> (Era (SophieEra StandardCrypto),
    FromCBOR (PParamsDelta (SophieEra StandardCrypto)),
    TransTxBody ToCBOR (SophieEra StandardCrypto)) =>
   Coin
forall era.
TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   Coin
Sophie._txfee TxBody (SophieLedgerEra era)
TxBody (SophieEra StandardCrypto)
body
    SophieBasedEra era
SophieBasedEraEvie ->
      TxFeesExplicitInEra EvieEra -> Entropic -> TxFee EvieEra
forall era. TxFeesExplicitInEra era -> Entropic -> TxFee era
TxFeeExplicit TxFeesExplicitInEra EvieEra
TxFeesExplicitInEvieEra (Entropic -> TxFee EvieEra) -> Entropic -> TxFee EvieEra
forall a b. (a -> b) -> a -> b
$
      Coin -> Entropic
fromSophieEntropic (Coin -> Entropic) -> Coin -> Entropic
forall a b. (a -> b) -> a -> b
$ TxBody (SophieMAEra 'Evie StandardCrypto) -> Coin
forall era. TxBody era -> Coin
Evie.txfee' TxBody (SophieMAEra 'Evie StandardCrypto)
TxBody (SophieLedgerEra era)
body
    SophieBasedEra era
SophieBasedEraJen ->
      TxFeesExplicitInEra JenEra -> Entropic -> TxFee JenEra
forall era. TxFeesExplicitInEra era -> Entropic -> TxFee era
TxFeeExplicit TxFeesExplicitInEra JenEra
TxFeesExplicitInJenEra (Entropic -> TxFee JenEra) -> Entropic -> TxFee JenEra
forall a b. (a -> b) -> a -> b
$
      Coin -> Entropic
fromSophieEntropic (Coin -> Entropic) -> Coin -> Entropic
forall a b. (a -> b) -> a -> b
$ TxBody (SophieMAEra 'Jen StandardCrypto) -> Coin
forall era. TxBody era -> Coin
Jen.txfee' TxBody (SophieMAEra 'Jen StandardCrypto)
TxBody (SophieLedgerEra era)
body
    SophieBasedEra era
SophieBasedEraAurum ->
      TxFeesExplicitInEra AurumEra -> Entropic -> TxFee AurumEra
forall era. TxFeesExplicitInEra era -> Entropic -> TxFee era
TxFeeExplicit TxFeesExplicitInEra AurumEra
TxFeesExplicitInAurumEra (Entropic -> TxFee AurumEra) -> Entropic -> TxFee AurumEra
forall a b. (a -> b) -> a -> b
$
      Coin -> Entropic
fromSophieEntropic (Coin -> Entropic) -> Coin -> Entropic
forall a b. (a -> b) -> a -> b
$ TxBody (AurumEra StandardCrypto) -> Coin
forall era. TxBody era -> Coin
Aurum.txfee' TxBody (SophieLedgerEra era)
TxBody (AurumEra StandardCrypto)
body

fromLedgerTxValidityRange
  :: SophieBasedEra era
  -> Ledger.TxBody (SophieLedgerEra era)
  -> (TxValidityLowerBound era, TxValidityUpperBound era)
fromLedgerTxValidityRange :: SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> (TxValidityLowerBound era, TxValidityUpperBound era)
fromLedgerTxValidityRange SophieBasedEra era
era TxBody (SophieLedgerEra era)
body =
  case SophieBasedEra era
era of
    SophieBasedEra era
SophieBasedEraSophie ->
      ( TxValidityLowerBound era
forall era. TxValidityLowerBound era
TxValidityNoLowerBound
      , ValidityUpperBoundSupportedInEra SophieEra
-> SlotNo -> TxValidityUpperBound SophieEra
forall era.
ValidityUpperBoundSupportedInEra era
-> SlotNo -> TxValidityUpperBound era
TxValidityUpperBound ValidityUpperBoundSupportedInEra SophieEra
ValidityUpperBoundInSophieEra (SlotNo -> TxValidityUpperBound SophieEra)
-> SlotNo -> TxValidityUpperBound SophieEra
forall a b. (a -> b) -> a -> b
$ TxBody (SophieEra StandardCrypto)
-> (Era (SophieEra StandardCrypto),
    FromCBOR (PParamsDelta (SophieEra StandardCrypto)),
    TransTxBody ToCBOR (SophieEra StandardCrypto)) =>
   SlotNo
forall era.
TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   SlotNo
Sophie._ttl TxBody (SophieLedgerEra era)
TxBody (SophieEra StandardCrypto)
body
      )

    SophieBasedEra era
SophieBasedEraEvie ->
      ( case StrictMaybe SlotNo
invalidBefore of
          StrictMaybe SlotNo
SNothing -> TxValidityLowerBound era
forall era. TxValidityLowerBound era
TxValidityNoLowerBound
          SJust SlotNo
s  -> ValidityLowerBoundSupportedInEra EvieEra
-> SlotNo -> TxValidityLowerBound EvieEra
forall era.
ValidityLowerBoundSupportedInEra era
-> SlotNo -> TxValidityLowerBound era
TxValidityLowerBound ValidityLowerBoundSupportedInEra EvieEra
ValidityLowerBoundInEvieEra SlotNo
s
      , case StrictMaybe SlotNo
invalidHereafter of
          StrictMaybe SlotNo
SNothing -> ValidityNoUpperBoundSupportedInEra EvieEra
-> TxValidityUpperBound EvieEra
forall era.
ValidityNoUpperBoundSupportedInEra era -> TxValidityUpperBound era
TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra EvieEra
ValidityNoUpperBoundInEvieEra
          SJust SlotNo
s  -> ValidityUpperBoundSupportedInEra EvieEra
-> SlotNo -> TxValidityUpperBound EvieEra
forall era.
ValidityUpperBoundSupportedInEra era
-> SlotNo -> TxValidityUpperBound era
TxValidityUpperBound   ValidityUpperBoundSupportedInEra EvieEra
ValidityUpperBoundInEvieEra SlotNo
s
      )
      where
        Evie.ValidityInterval{StrictMaybe SlotNo
invalidBefore :: ValidityInterval -> StrictMaybe SlotNo
invalidBefore :: StrictMaybe SlotNo
invalidBefore, StrictMaybe SlotNo
invalidHereafter :: ValidityInterval -> StrictMaybe SlotNo
invalidHereafter :: StrictMaybe SlotNo
invalidHereafter} =
          TxBody (SophieMAEra 'Evie StandardCrypto) -> ValidityInterval
forall era. TxBody era -> ValidityInterval
Evie.vldt' TxBody (SophieMAEra 'Evie StandardCrypto)
TxBody (SophieLedgerEra era)
body

    SophieBasedEra era
SophieBasedEraJen ->
      ( case StrictMaybe SlotNo
invalidBefore of
          StrictMaybe SlotNo
SNothing -> TxValidityLowerBound era
forall era. TxValidityLowerBound era
TxValidityNoLowerBound
          SJust SlotNo
s  -> ValidityLowerBoundSupportedInEra JenEra
-> SlotNo -> TxValidityLowerBound JenEra
forall era.
ValidityLowerBoundSupportedInEra era
-> SlotNo -> TxValidityLowerBound era
TxValidityLowerBound ValidityLowerBoundSupportedInEra JenEra
ValidityLowerBoundInJenEra SlotNo
s
      , case StrictMaybe SlotNo
invalidHereafter of
          StrictMaybe SlotNo
SNothing -> ValidityNoUpperBoundSupportedInEra JenEra
-> TxValidityUpperBound JenEra
forall era.
ValidityNoUpperBoundSupportedInEra era -> TxValidityUpperBound era
TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra JenEra
ValidityNoUpperBoundInJenEra
          SJust SlotNo
s  -> ValidityUpperBoundSupportedInEra JenEra
-> SlotNo -> TxValidityUpperBound JenEra
forall era.
ValidityUpperBoundSupportedInEra era
-> SlotNo -> TxValidityUpperBound era
TxValidityUpperBound   ValidityUpperBoundSupportedInEra JenEra
ValidityUpperBoundInJenEra SlotNo
s
      )
      where
        Jen.ValidityInterval{StrictMaybe SlotNo
invalidBefore :: StrictMaybe SlotNo
invalidBefore :: ValidityInterval -> StrictMaybe SlotNo
invalidBefore, StrictMaybe SlotNo
invalidHereafter :: StrictMaybe SlotNo
invalidHereafter :: ValidityInterval -> StrictMaybe SlotNo
invalidHereafter} = TxBody (SophieMAEra 'Jen StandardCrypto) -> ValidityInterval
forall era. TxBody era -> ValidityInterval
Jen.vldt' TxBody (SophieMAEra 'Jen StandardCrypto)
TxBody (SophieLedgerEra era)
body

    SophieBasedEra era
SophieBasedEraAurum ->
      ( case StrictMaybe SlotNo
invalidBefore of
          StrictMaybe SlotNo
SNothing -> TxValidityLowerBound era
forall era. TxValidityLowerBound era
TxValidityNoLowerBound
          SJust SlotNo
s  -> ValidityLowerBoundSupportedInEra AurumEra
-> SlotNo -> TxValidityLowerBound AurumEra
forall era.
ValidityLowerBoundSupportedInEra era
-> SlotNo -> TxValidityLowerBound era
TxValidityLowerBound ValidityLowerBoundSupportedInEra AurumEra
ValidityLowerBoundInAurumEra SlotNo
s
      , case StrictMaybe SlotNo
invalidHereafter of
          StrictMaybe SlotNo
SNothing -> ValidityNoUpperBoundSupportedInEra AurumEra
-> TxValidityUpperBound AurumEra
forall era.
ValidityNoUpperBoundSupportedInEra era -> TxValidityUpperBound era
TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra AurumEra
ValidityNoUpperBoundInAurumEra
          SJust SlotNo
s  -> ValidityUpperBoundSupportedInEra AurumEra
-> SlotNo -> TxValidityUpperBound AurumEra
forall era.
ValidityUpperBoundSupportedInEra era
-> SlotNo -> TxValidityUpperBound era
TxValidityUpperBound   ValidityUpperBoundSupportedInEra AurumEra
ValidityUpperBoundInAurumEra SlotNo
s
      )
      where
        Jen.ValidityInterval{StrictMaybe SlotNo
invalidBefore :: StrictMaybe SlotNo
invalidBefore :: ValidityInterval -> StrictMaybe SlotNo
invalidBefore, StrictMaybe SlotNo
invalidHereafter :: StrictMaybe SlotNo
invalidHereafter :: ValidityInterval -> StrictMaybe SlotNo
invalidHereafter} = TxBody (AurumEra StandardCrypto) -> ValidityInterval
forall era. TxBody era -> ValidityInterval
Aurum.vldt' TxBody (SophieLedgerEra era)
TxBody (AurumEra StandardCrypto)
body


fromLedgerAuxiliaryData
  :: SophieBasedEra era
  -> Ledger.AuxiliaryData (SophieLedgerEra era)
  -> (Map Word64 TxMetadataValue, [ScriptInEra era])
fromLedgerAuxiliaryData :: SophieBasedEra era
-> AuxiliaryData (SophieLedgerEra era)
-> (Map Word64 TxMetadataValue, [ScriptInEra era])
fromLedgerAuxiliaryData SophieBasedEra era
SophieBasedEraSophie (Sophie.Metadata metadata) =
  (Map Word64 Metadatum -> Map Word64 TxMetadataValue
fromSophieMetadata Map Word64 Metadatum
metadata, [])
fromLedgerAuxiliaryData SophieBasedEra era
SophieBasedEraEvie (Evie.AuxiliaryData ms ss) =
  ( Map Word64 Metadatum -> Map Word64 TxMetadataValue
fromSophieMetadata Map Word64 Metadatum
ms
  , SophieBasedEra EvieEra
-> Script (SophieLedgerEra EvieEra) -> ScriptInEra EvieEra
forall era.
SophieBasedEra era
-> Script (SophieLedgerEra era) -> ScriptInEra era
fromSophieBasedScript SophieBasedEra EvieEra
SophieBasedEraEvie (Timelock StandardCrypto -> ScriptInEra EvieEra)
-> [Timelock StandardCrypto] -> [ScriptInEra EvieEra]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Timelock StandardCrypto) -> [Timelock StandardCrypto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Timelock StandardCrypto)
StrictSeq (Script (SophieMAEra 'Evie StandardCrypto))
ss
  )
fromLedgerAuxiliaryData SophieBasedEra era
SophieBasedEraJen (Jen.AuxiliaryData ms ss) =
  ( Map Word64 Metadatum -> Map Word64 TxMetadataValue
fromSophieMetadata Map Word64 Metadatum
ms
  , SophieBasedEra JenEra
-> Script (SophieLedgerEra JenEra) -> ScriptInEra JenEra
forall era.
SophieBasedEra era
-> Script (SophieLedgerEra era) -> ScriptInEra era
fromSophieBasedScript SophieBasedEra JenEra
SophieBasedEraJen (Timelock StandardCrypto -> ScriptInEra JenEra)
-> [Timelock StandardCrypto] -> [ScriptInEra JenEra]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Timelock StandardCrypto) -> [Timelock StandardCrypto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Timelock StandardCrypto)
StrictSeq (Script (SophieMAEra 'Jen StandardCrypto))
ss
  )
fromLedgerAuxiliaryData SophieBasedEra era
SophieBasedEraAurum (Aurum.AuxiliaryData ms ss) =
  ( Map Word64 Metadatum -> Map Word64 TxMetadataValue
fromSophieMetadata Map Word64 Metadatum
ms
  , SophieBasedEra AurumEra
-> Script (SophieLedgerEra AurumEra) -> ScriptInEra AurumEra
forall era.
SophieBasedEra era
-> Script (SophieLedgerEra era) -> ScriptInEra era
fromSophieBasedScript SophieBasedEra AurumEra
SophieBasedEraAurum (Script (AurumEra StandardCrypto) -> ScriptInEra AurumEra)
-> [Script (AurumEra StandardCrypto)] -> [ScriptInEra AurumEra]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq (Script (AurumEra StandardCrypto))
-> [Script (AurumEra StandardCrypto)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Script (AurumEra StandardCrypto))
StrictSeq (Script (AurumEra StandardCrypto))
ss
  )

fromLedgerTxAuxiliaryData
  :: SophieBasedEra era
  -> Maybe (Ledger.AuxiliaryData (SophieLedgerEra era))
  -> (TxMetadataInEra era, TxAuxScripts era)
fromLedgerTxAuxiliaryData :: SophieBasedEra era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> (TxMetadataInEra era, TxAuxScripts era)
fromLedgerTxAuxiliaryData SophieBasedEra era
_ Maybe (AuxiliaryData (SophieLedgerEra era))
Nothing = (TxMetadataInEra era
forall era. TxMetadataInEra era
TxMetadataNone, TxAuxScripts era
forall era. TxAuxScripts era
TxAuxScriptsNone)
fromLedgerTxAuxiliaryData SophieBasedEra era
era (Just AuxiliaryData (SophieLedgerEra era)
auxData) =
  case SophieBasedEra era
era of
    SophieBasedEra era
SophieBasedEraSophie ->
      ( if Map Word64 TxMetadataValue -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Word64 TxMetadataValue
ms then
          TxMetadataInEra era
forall era. TxMetadataInEra era
TxMetadataNone
        else
          TxMetadataSupportedInEra SophieEra
-> TxMetadata -> TxMetadataInEra SophieEra
forall era.
TxMetadataSupportedInEra era -> TxMetadata -> TxMetadataInEra era
TxMetadataInEra TxMetadataSupportedInEra SophieEra
TxMetadataInSophieEra (TxMetadata -> TxMetadataInEra SophieEra)
-> TxMetadata -> TxMetadataInEra SophieEra
forall a b. (a -> b) -> a -> b
$ Map Word64 TxMetadataValue -> TxMetadata
TxMetadata Map Word64 TxMetadataValue
ms
      , TxAuxScripts era
forall era. TxAuxScripts era
TxAuxScriptsNone
      )
    SophieBasedEra era
SophieBasedEraEvie ->
      ( if Map Word64 TxMetadataValue -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Word64 TxMetadataValue
ms then
          TxMetadataInEra era
forall era. TxMetadataInEra era
TxMetadataNone
        else
          TxMetadataSupportedInEra EvieEra
-> TxMetadata -> TxMetadataInEra EvieEra
forall era.
TxMetadataSupportedInEra era -> TxMetadata -> TxMetadataInEra era
TxMetadataInEra TxMetadataSupportedInEra EvieEra
TxMetadataInEvieEra (TxMetadata -> TxMetadataInEra EvieEra)
-> TxMetadata -> TxMetadataInEra EvieEra
forall a b. (a -> b) -> a -> b
$ Map Word64 TxMetadataValue -> TxMetadata
TxMetadata Map Word64 TxMetadataValue
ms
      , case [ScriptInEra era]
ss of
          [] -> TxAuxScripts era
forall era. TxAuxScripts era
TxAuxScriptsNone
          [ScriptInEra era]
_  -> AuxScriptsSupportedInEra EvieEra
-> [ScriptInEra EvieEra] -> TxAuxScripts EvieEra
forall era.
AuxScriptsSupportedInEra era
-> [ScriptInEra era] -> TxAuxScripts era
TxAuxScripts AuxScriptsSupportedInEra EvieEra
AuxScriptsInEvieEra [ScriptInEra era]
[ScriptInEra EvieEra]
ss
      )
    SophieBasedEra era
SophieBasedEraJen ->
      ( if Map Word64 TxMetadataValue -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Word64 TxMetadataValue
ms then
          TxMetadataInEra era
forall era. TxMetadataInEra era
TxMetadataNone
        else
          TxMetadataSupportedInEra JenEra
-> TxMetadata -> TxMetadataInEra JenEra
forall era.
TxMetadataSupportedInEra era -> TxMetadata -> TxMetadataInEra era
TxMetadataInEra TxMetadataSupportedInEra JenEra
TxMetadataInJenEra (TxMetadata -> TxMetadataInEra JenEra)
-> TxMetadata -> TxMetadataInEra JenEra
forall a b. (a -> b) -> a -> b
$ Map Word64 TxMetadataValue -> TxMetadata
TxMetadata Map Word64 TxMetadataValue
ms
      , case [ScriptInEra era]
ss of
          [] -> TxAuxScripts era
forall era. TxAuxScripts era
TxAuxScriptsNone
          [ScriptInEra era]
_  -> AuxScriptsSupportedInEra JenEra
-> [ScriptInEra JenEra] -> TxAuxScripts JenEra
forall era.
AuxScriptsSupportedInEra era
-> [ScriptInEra era] -> TxAuxScripts era
TxAuxScripts AuxScriptsSupportedInEra JenEra
AuxScriptsInJenEra [ScriptInEra era]
[ScriptInEra JenEra]
ss
      )
    SophieBasedEra era
SophieBasedEraAurum ->
      ( if Map Word64 TxMetadataValue -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Word64 TxMetadataValue
ms then
          TxMetadataInEra era
forall era. TxMetadataInEra era
TxMetadataNone
        else
          TxMetadataSupportedInEra AurumEra
-> TxMetadata -> TxMetadataInEra AurumEra
forall era.
TxMetadataSupportedInEra era -> TxMetadata -> TxMetadataInEra era
TxMetadataInEra TxMetadataSupportedInEra AurumEra
TxMetadataInAurumEra (TxMetadata -> TxMetadataInEra AurumEra)
-> TxMetadata -> TxMetadataInEra AurumEra
forall a b. (a -> b) -> a -> b
$ Map Word64 TxMetadataValue -> TxMetadata
TxMetadata Map Word64 TxMetadataValue
ms
      , case [ScriptInEra era]
ss of
          [] -> TxAuxScripts era
forall era. TxAuxScripts era
TxAuxScriptsNone
          [ScriptInEra era]
_  -> AuxScriptsSupportedInEra AurumEra
-> [ScriptInEra AurumEra] -> TxAuxScripts AurumEra
forall era.
AuxScriptsSupportedInEra era
-> [ScriptInEra era] -> TxAuxScripts era
TxAuxScripts AuxScriptsSupportedInEra AurumEra
AuxScriptsInAurumEra [ScriptInEra era]
[ScriptInEra AurumEra]
ss
      )
  where
    (Map Word64 TxMetadataValue
ms, [ScriptInEra era]
ss) = SophieBasedEra era
-> AuxiliaryData (SophieLedgerEra era)
-> (Map Word64 TxMetadataValue, [ScriptInEra era])
forall era.
SophieBasedEra era
-> AuxiliaryData (SophieLedgerEra era)
-> (Map Word64 TxMetadataValue, [ScriptInEra era])
fromLedgerAuxiliaryData SophieBasedEra era
era AuxiliaryData (SophieLedgerEra era)
auxData


fromLedgerTxExtraKeyWitnesses :: SophieBasedEra era
                              -> Ledger.TxBody (SophieLedgerEra era)
                              -> TxExtraKeyWitnesses era
fromLedgerTxExtraKeyWitnesses :: SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxExtraKeyWitnesses era
fromLedgerTxExtraKeyWitnesses SophieBasedEra era
sbe TxBody (SophieLedgerEra era)
body =
  case SophieBasedEra era
sbe of
    SophieBasedEra era
SophieBasedEraSophie -> TxExtraKeyWitnesses era
forall era. TxExtraKeyWitnesses era
TxExtraKeyWitnessesNone
    SophieBasedEra era
SophieBasedEraEvie -> TxExtraKeyWitnesses era
forall era. TxExtraKeyWitnesses era
TxExtraKeyWitnessesNone
    SophieBasedEra era
SophieBasedEraJen    -> TxExtraKeyWitnesses era
forall era. TxExtraKeyWitnesses era
TxExtraKeyWitnessesNone
    SophieBasedEra era
SophieBasedEraAurum  -> TxExtraKeyWitnessesSupportedInEra AurumEra
-> [Hash PaymentKey] -> TxExtraKeyWitnesses AurumEra
forall era.
TxExtraKeyWitnessesSupportedInEra era
-> [Hash PaymentKey] -> TxExtraKeyWitnesses era
TxExtraKeyWitnesses
                                TxExtraKeyWitnessesSupportedInEra AurumEra
ExtraKeyWitnessesInAurumEra
                                [ KeyHash 'Payment StandardCrypto -> Hash PaymentKey
PaymentKeyHash (KeyHash 'Witness StandardCrypto -> KeyHash 'Payment StandardCrypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto
       (r' :: KeyRole).
HasKeyRole a =>
a r crypto -> a r' crypto
Sophie.coerceKeyRole KeyHash 'Witness StandardCrypto
keyhash)
                                | let keyhashes :: Set (KeyHash 'Witness (Crypto (AurumEra StandardCrypto)))
keyhashes = TxBody (AurumEra StandardCrypto)
-> AurumBody (AurumEra StandardCrypto) =>
   Set (KeyHash 'Witness (Crypto (AurumEra StandardCrypto)))
forall era.
TxBody era -> AurumBody era => Set (KeyHash 'Witness (Crypto era))
Aurum.reqSignerHashes TxBody (SophieLedgerEra era)
TxBody (AurumEra StandardCrypto)
body
                                , KeyHash 'Witness StandardCrypto
keyhash <- Set (KeyHash 'Witness StandardCrypto)
-> [KeyHash 'Witness StandardCrypto]
forall a. Set a -> [a]
Set.toList Set (KeyHash 'Witness StandardCrypto)
Set (KeyHash 'Witness (Crypto (AurumEra StandardCrypto)))
keyhashes ]

fromLedgerTxWithdrawals
  :: SophieBasedEra era
  -> Ledger.TxBody (SophieLedgerEra era)
  -> TxWithdrawals ViewTx era
fromLedgerTxWithdrawals :: SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxWithdrawals ViewTx era
fromLedgerTxWithdrawals SophieBasedEra era
era TxBody (SophieLedgerEra era)
body =
  case SophieBasedEra era
era of
    SophieBasedEra era
SophieBasedEraSophie
      | Map (RewardAcnt StandardCrypto) Coin -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Wdrl StandardCrypto -> Map (RewardAcnt StandardCrypto) Coin
forall crypto. Wdrl crypto -> Map (RewardAcnt crypto) Coin
Sophie.unWdrl Wdrl StandardCrypto
Wdrl (Crypto (SophieEra StandardCrypto))
withdrawals) -> TxWithdrawals ViewTx era
forall build era. TxWithdrawals build era
TxWithdrawalsNone
      | Bool
otherwise ->
          WithdrawalsSupportedInEra SophieEra
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake SophieEra))]
-> TxWithdrawals ViewTx SophieEra
forall era build.
WithdrawalsSupportedInEra era
-> [(StakeAddress, Entropic,
     BuildTxWith build (Witness WitCtxStake era))]
-> TxWithdrawals build era
TxWithdrawals WithdrawalsSupportedInEra SophieEra
WithdrawalsInSophieEra ([(StakeAddress, Entropic,
   BuildTxWith ViewTx (Witness WitCtxStake SophieEra))]
 -> TxWithdrawals ViewTx SophieEra)
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake SophieEra))]
-> TxWithdrawals ViewTx SophieEra
forall a b. (a -> b) -> a -> b
$
          Wdrl StandardCrypto
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake SophieEra))]
forall era.
Wdrl StandardCrypto
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake era))]
fromSophieWithdrawal Wdrl StandardCrypto
Wdrl (Crypto (SophieEra StandardCrypto))
withdrawals
      where
        withdrawals :: Wdrl (Crypto (SophieEra StandardCrypto))
withdrawals = TxBody (SophieEra StandardCrypto)
-> (Era (SophieEra StandardCrypto),
    FromCBOR (PParamsDelta (SophieEra StandardCrypto)),
    TransTxBody ToCBOR (SophieEra StandardCrypto)) =>
   Wdrl (Crypto (SophieEra StandardCrypto))
forall era.
TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   Wdrl (Crypto era)
Sophie._wdrls TxBody (SophieLedgerEra era)
TxBody (SophieEra StandardCrypto)
body

    SophieBasedEra era
SophieBasedEraEvie
      | Map (RewardAcnt StandardCrypto) Coin -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Wdrl StandardCrypto -> Map (RewardAcnt StandardCrypto) Coin
forall crypto. Wdrl crypto -> Map (RewardAcnt crypto) Coin
Sophie.unWdrl Wdrl StandardCrypto
Wdrl (Crypto (SophieMAEra 'Evie StandardCrypto))
withdrawals) -> TxWithdrawals ViewTx era
forall build era. TxWithdrawals build era
TxWithdrawalsNone
      | Bool
otherwise ->
          WithdrawalsSupportedInEra EvieEra
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake EvieEra))]
-> TxWithdrawals ViewTx EvieEra
forall era build.
WithdrawalsSupportedInEra era
-> [(StakeAddress, Entropic,
     BuildTxWith build (Witness WitCtxStake era))]
-> TxWithdrawals build era
TxWithdrawals WithdrawalsSupportedInEra EvieEra
WithdrawalsInEvieEra ([(StakeAddress, Entropic,
   BuildTxWith ViewTx (Witness WitCtxStake EvieEra))]
 -> TxWithdrawals ViewTx EvieEra)
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake EvieEra))]
-> TxWithdrawals ViewTx EvieEra
forall a b. (a -> b) -> a -> b
$
          Wdrl StandardCrypto
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake EvieEra))]
forall era.
Wdrl StandardCrypto
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake era))]
fromSophieWithdrawal Wdrl StandardCrypto
Wdrl (Crypto (SophieMAEra 'Evie StandardCrypto))
withdrawals
      where
        withdrawals :: Wdrl (Crypto (SophieMAEra 'Evie StandardCrypto))
withdrawals = TxBody (SophieMAEra 'Evie StandardCrypto)
-> Wdrl (Crypto (SophieMAEra 'Evie StandardCrypto))
forall era. TxBody era -> Wdrl (Crypto era)
Evie.wdrls' TxBody (SophieMAEra 'Evie StandardCrypto)
TxBody (SophieLedgerEra era)
body

    SophieBasedEra era
SophieBasedEraJen
      | Map (RewardAcnt StandardCrypto) Coin -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Wdrl StandardCrypto -> Map (RewardAcnt StandardCrypto) Coin
forall crypto. Wdrl crypto -> Map (RewardAcnt crypto) Coin
Sophie.unWdrl Wdrl StandardCrypto
Wdrl (Crypto (SophieMAEra 'Jen StandardCrypto))
withdrawals) -> TxWithdrawals ViewTx era
forall build era. TxWithdrawals build era
TxWithdrawalsNone
      | Bool
otherwise ->
          WithdrawalsSupportedInEra JenEra
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake JenEra))]
-> TxWithdrawals ViewTx JenEra
forall era build.
WithdrawalsSupportedInEra era
-> [(StakeAddress, Entropic,
     BuildTxWith build (Witness WitCtxStake era))]
-> TxWithdrawals build era
TxWithdrawals WithdrawalsSupportedInEra JenEra
WithdrawalsInJenEra ([(StakeAddress, Entropic,
   BuildTxWith ViewTx (Witness WitCtxStake JenEra))]
 -> TxWithdrawals ViewTx JenEra)
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake JenEra))]
-> TxWithdrawals ViewTx JenEra
forall a b. (a -> b) -> a -> b
$ Wdrl StandardCrypto
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake JenEra))]
forall era.
Wdrl StandardCrypto
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake era))]
fromSophieWithdrawal Wdrl StandardCrypto
Wdrl (Crypto (SophieMAEra 'Jen StandardCrypto))
withdrawals
      where
        withdrawals :: Wdrl (Crypto (SophieMAEra 'Jen StandardCrypto))
withdrawals = TxBody (SophieMAEra 'Jen StandardCrypto)
-> Wdrl (Crypto (SophieMAEra 'Jen StandardCrypto))
forall era. TxBody era -> Wdrl (Crypto era)
Jen.wdrls' TxBody (SophieMAEra 'Jen StandardCrypto)
TxBody (SophieLedgerEra era)
body

    SophieBasedEra era
SophieBasedEraAurum
      | Map (RewardAcnt StandardCrypto) Coin -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Wdrl StandardCrypto -> Map (RewardAcnt StandardCrypto) Coin
forall crypto. Wdrl crypto -> Map (RewardAcnt crypto) Coin
Sophie.unWdrl Wdrl StandardCrypto
Wdrl (Crypto (AurumEra StandardCrypto))
withdrawals) -> TxWithdrawals ViewTx era
forall build era. TxWithdrawals build era
TxWithdrawalsNone
      | Bool
otherwise ->
          WithdrawalsSupportedInEra AurumEra
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake AurumEra))]
-> TxWithdrawals ViewTx AurumEra
forall era build.
WithdrawalsSupportedInEra era
-> [(StakeAddress, Entropic,
     BuildTxWith build (Witness WitCtxStake era))]
-> TxWithdrawals build era
TxWithdrawals WithdrawalsSupportedInEra AurumEra
WithdrawalsInAurumEra ([(StakeAddress, Entropic,
   BuildTxWith ViewTx (Witness WitCtxStake AurumEra))]
 -> TxWithdrawals ViewTx AurumEra)
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake AurumEra))]
-> TxWithdrawals ViewTx AurumEra
forall a b. (a -> b) -> a -> b
$ Wdrl StandardCrypto
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake AurumEra))]
forall era.
Wdrl StandardCrypto
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake era))]
fromSophieWithdrawal Wdrl StandardCrypto
Wdrl (Crypto (AurumEra StandardCrypto))
withdrawals
      where
        withdrawals :: Wdrl (Crypto (AurumEra StandardCrypto))
withdrawals = TxBody (AurumEra StandardCrypto)
-> Wdrl (Crypto (AurumEra StandardCrypto))
forall era. TxBody era -> Wdrl (Crypto era)
Aurum.wdrls' TxBody (SophieLedgerEra era)
TxBody (AurumEra StandardCrypto)
body

fromLedgerTxCertificates
  :: SophieBasedEra era
  -> Ledger.TxBody (SophieLedgerEra era)
  -> TxCertificates ViewTx era
fromLedgerTxCertificates :: SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxCertificates ViewTx era
fromLedgerTxCertificates SophieBasedEra era
era TxBody (SophieLedgerEra era)
body =
  case SophieBasedEra era
era of
    SophieBasedEra era
SophieBasedEraSophie
      | StrictSeq (DCert StandardCrypto) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null StrictSeq (DCert StandardCrypto)
StrictSeq (DCert (Crypto (SophieEra StandardCrypto)))
certificates -> TxCertificates ViewTx era
forall build era. TxCertificates build era
TxCertificatesNone
      | Bool
otherwise ->
          CertificatesSupportedInEra SophieEra
-> [Certificate]
-> BuildTxWith
     ViewTx (Map StakeCredential (Witness WitCtxStake SophieEra))
-> TxCertificates ViewTx SophieEra
forall era build.
CertificatesSupportedInEra era
-> [Certificate]
-> BuildTxWith
     build (Map StakeCredential (Witness WitCtxStake era))
-> TxCertificates build era
TxCertificates
            CertificatesSupportedInEra SophieEra
CertificatesInSophieEra
            ((DCert StandardCrypto -> Certificate)
-> [DCert StandardCrypto] -> [Certificate]
forall a b. (a -> b) -> [a] -> [b]
map DCert StandardCrypto -> Certificate
fromSophieCertificate ([DCert StandardCrypto] -> [Certificate])
-> [DCert StandardCrypto] -> [Certificate]
forall a b. (a -> b) -> a -> b
$ StrictSeq (DCert StandardCrypto) -> [DCert StandardCrypto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (DCert StandardCrypto)
StrictSeq (DCert (Crypto (SophieEra StandardCrypto)))
certificates)
            BuildTxWith
  ViewTx (Map StakeCredential (Witness WitCtxStake SophieEra))
forall a. BuildTxWith ViewTx a
ViewTx
      where
        certificates :: StrictSeq (DCert (Crypto (SophieEra StandardCrypto)))
certificates = TxBody (SophieEra StandardCrypto)
-> (Era (SophieEra StandardCrypto),
    FromCBOR (PParamsDelta (SophieEra StandardCrypto)),
    TransTxBody ToCBOR (SophieEra StandardCrypto)) =>
   StrictSeq (DCert (Crypto (SophieEra StandardCrypto)))
forall era.
TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   StrictSeq (DCert (Crypto era))
Sophie._certs TxBody (SophieLedgerEra era)
TxBody (SophieEra StandardCrypto)
body

    SophieBasedEra era
SophieBasedEraEvie
      | StrictSeq (DCert StandardCrypto) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null StrictSeq (DCert StandardCrypto)
StrictSeq (DCert (Crypto (SophieMAEra 'Evie StandardCrypto)))
certificates -> TxCertificates ViewTx era
forall build era. TxCertificates build era
TxCertificatesNone
      | Bool
otherwise ->
          CertificatesSupportedInEra EvieEra
-> [Certificate]
-> BuildTxWith
     ViewTx (Map StakeCredential (Witness WitCtxStake EvieEra))
-> TxCertificates ViewTx EvieEra
forall era build.
CertificatesSupportedInEra era
-> [Certificate]
-> BuildTxWith
     build (Map StakeCredential (Witness WitCtxStake era))
-> TxCertificates build era
TxCertificates
            CertificatesSupportedInEra EvieEra
CertificatesInEvieEra
            ((DCert StandardCrypto -> Certificate)
-> [DCert StandardCrypto] -> [Certificate]
forall a b. (a -> b) -> [a] -> [b]
map DCert StandardCrypto -> Certificate
fromSophieCertificate ([DCert StandardCrypto] -> [Certificate])
-> [DCert StandardCrypto] -> [Certificate]
forall a b. (a -> b) -> a -> b
$ StrictSeq (DCert StandardCrypto) -> [DCert StandardCrypto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (DCert StandardCrypto)
StrictSeq (DCert (Crypto (SophieMAEra 'Evie StandardCrypto)))
certificates)
            BuildTxWith
  ViewTx (Map StakeCredential (Witness WitCtxStake EvieEra))
forall a. BuildTxWith ViewTx a
ViewTx
      where
        certificates :: StrictSeq (DCert (Crypto (SophieMAEra 'Evie StandardCrypto)))
certificates = TxBody (SophieMAEra 'Evie StandardCrypto)
-> StrictSeq (DCert (Crypto (SophieMAEra 'Evie StandardCrypto)))
forall era. TxBody era -> StrictSeq (DCert (Crypto era))
Evie.certs' TxBody (SophieMAEra 'Evie StandardCrypto)
TxBody (SophieLedgerEra era)
body

    SophieBasedEra era
SophieBasedEraJen
      | StrictSeq (DCert StandardCrypto) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null StrictSeq (DCert StandardCrypto)
StrictSeq (DCert (Crypto (SophieMAEra 'Jen StandardCrypto)))
certificates -> TxCertificates ViewTx era
forall build era. TxCertificates build era
TxCertificatesNone
      | Bool
otherwise ->
          CertificatesSupportedInEra JenEra
-> [Certificate]
-> BuildTxWith
     ViewTx (Map StakeCredential (Witness WitCtxStake JenEra))
-> TxCertificates ViewTx JenEra
forall era build.
CertificatesSupportedInEra era
-> [Certificate]
-> BuildTxWith
     build (Map StakeCredential (Witness WitCtxStake era))
-> TxCertificates build era
TxCertificates
            CertificatesSupportedInEra JenEra
CertificatesInJenEra
            ((DCert StandardCrypto -> Certificate)
-> [DCert StandardCrypto] -> [Certificate]
forall a b. (a -> b) -> [a] -> [b]
map DCert StandardCrypto -> Certificate
fromSophieCertificate ([DCert StandardCrypto] -> [Certificate])
-> [DCert StandardCrypto] -> [Certificate]
forall a b. (a -> b) -> a -> b
$ StrictSeq (DCert StandardCrypto) -> [DCert StandardCrypto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (DCert StandardCrypto)
StrictSeq (DCert (Crypto (SophieMAEra 'Jen StandardCrypto)))
certificates)
            BuildTxWith
  ViewTx (Map StakeCredential (Witness WitCtxStake JenEra))
forall a. BuildTxWith ViewTx a
ViewTx
      where
        certificates :: StrictSeq (DCert (Crypto (SophieMAEra 'Jen StandardCrypto)))
certificates = TxBody (SophieMAEra 'Jen StandardCrypto)
-> StrictSeq (DCert (Crypto (SophieMAEra 'Jen StandardCrypto)))
forall era. TxBody era -> StrictSeq (DCert (Crypto era))
Jen.certs' TxBody (SophieMAEra 'Jen StandardCrypto)
TxBody (SophieLedgerEra era)
body

    SophieBasedEra era
SophieBasedEraAurum
      | StrictSeq (DCert StandardCrypto) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null StrictSeq (DCert StandardCrypto)
StrictSeq (DCert (Crypto (AurumEra StandardCrypto)))
certificates -> TxCertificates ViewTx era
forall build era. TxCertificates build era
TxCertificatesNone
      | Bool
otherwise ->
          CertificatesSupportedInEra AurumEra
-> [Certificate]
-> BuildTxWith
     ViewTx (Map StakeCredential (Witness WitCtxStake AurumEra))
-> TxCertificates ViewTx AurumEra
forall era build.
CertificatesSupportedInEra era
-> [Certificate]
-> BuildTxWith
     build (Map StakeCredential (Witness WitCtxStake era))
-> TxCertificates build era
TxCertificates
            CertificatesSupportedInEra AurumEra
CertificatesInAurumEra
            ((DCert StandardCrypto -> Certificate)
-> [DCert StandardCrypto] -> [Certificate]
forall a b. (a -> b) -> [a] -> [b]
map DCert StandardCrypto -> Certificate
fromSophieCertificate ([DCert StandardCrypto] -> [Certificate])
-> [DCert StandardCrypto] -> [Certificate]
forall a b. (a -> b) -> a -> b
$ StrictSeq (DCert StandardCrypto) -> [DCert StandardCrypto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (DCert StandardCrypto)
StrictSeq (DCert (Crypto (AurumEra StandardCrypto)))
certificates)
            BuildTxWith
  ViewTx (Map StakeCredential (Witness WitCtxStake AurumEra))
forall a. BuildTxWith ViewTx a
ViewTx
      where
        certificates :: StrictSeq (DCert (Crypto (AurumEra StandardCrypto)))
certificates = TxBody (AurumEra StandardCrypto)
-> StrictSeq (DCert (Crypto (AurumEra StandardCrypto)))
forall era. TxBody era -> StrictSeq (DCert (Crypto era))
Aurum.certs' TxBody (SophieLedgerEra era)
TxBody (AurumEra StandardCrypto)
body

fromLedgerTxUpdateProposal
  :: SophieBasedEra era
  -> Ledger.TxBody (SophieLedgerEra era)
  -> TxUpdateProposal era
fromLedgerTxUpdateProposal :: SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxUpdateProposal era
fromLedgerTxUpdateProposal SophieBasedEra era
era TxBody (SophieLedgerEra era)
body =
  case SophieBasedEra era
era of
    SophieBasedEra era
SophieBasedEraSophie ->
      case TxBody (SophieEra StandardCrypto)
-> (Era (SophieEra StandardCrypto),
    FromCBOR (PParamsDelta (SophieEra StandardCrypto)),
    TransTxBody ToCBOR (SophieEra StandardCrypto)) =>
   StrictMaybe (Update (SophieEra StandardCrypto))
forall era.
TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   StrictMaybe (Update era)
Sophie._txUpdate TxBody (SophieLedgerEra era)
TxBody (SophieEra StandardCrypto)
body of
        StrictMaybe (Update (SophieEra StandardCrypto))
SNothing -> TxUpdateProposal era
forall era. TxUpdateProposal era
TxUpdateProposalNone
        SJust Update (SophieEra StandardCrypto)
p ->
          UpdateProposalSupportedInEra SophieEra
-> UpdateProposal -> TxUpdateProposal SophieEra
forall era.
UpdateProposalSupportedInEra era
-> UpdateProposal -> TxUpdateProposal era
TxUpdateProposal UpdateProposalSupportedInEra SophieEra
UpdateProposalInSophieEra
                           (SophieBasedEra era
-> Update (SophieEra StandardCrypto) -> UpdateProposal
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 Crypto ledgerera ~ StandardCrypto) =>
SophieBasedEra era -> Update ledgerera -> UpdateProposal
fromLedgerUpdate SophieBasedEra era
era Update (SophieEra StandardCrypto)
p)

    SophieBasedEra era
SophieBasedEraEvie ->
      case TxBody (SophieMAEra 'Evie StandardCrypto)
-> StrictMaybe (Update (SophieMAEra 'Evie StandardCrypto))
forall era. TxBody era -> StrictMaybe (Update era)
Evie.update' TxBody (SophieMAEra 'Evie StandardCrypto)
TxBody (SophieLedgerEra era)
body of
        StrictMaybe (Update (SophieMAEra 'Evie StandardCrypto))
SNothing -> TxUpdateProposal era
forall era. TxUpdateProposal era
TxUpdateProposalNone
        SJust Update (SophieMAEra 'Evie StandardCrypto)
p ->
          UpdateProposalSupportedInEra EvieEra
-> UpdateProposal -> TxUpdateProposal EvieEra
forall era.
UpdateProposalSupportedInEra era
-> UpdateProposal -> TxUpdateProposal era
TxUpdateProposal UpdateProposalSupportedInEra EvieEra
UpdateProposalInEvieEra
                           (SophieBasedEra era
-> Update (SophieMAEra 'Evie StandardCrypto) -> UpdateProposal
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 Crypto ledgerera ~ StandardCrypto) =>
SophieBasedEra era -> Update ledgerera -> UpdateProposal
fromLedgerUpdate SophieBasedEra era
era Update (SophieMAEra 'Evie StandardCrypto)
p)

    SophieBasedEra era
SophieBasedEraJen ->
      case TxBody (SophieMAEra 'Jen StandardCrypto)
-> StrictMaybe (Update (SophieMAEra 'Jen StandardCrypto))
forall era. TxBody era -> StrictMaybe (Update era)
Jen.update' TxBody (SophieMAEra 'Jen StandardCrypto)
TxBody (SophieLedgerEra era)
body of
        StrictMaybe (Update (SophieMAEra 'Jen StandardCrypto))
SNothing -> TxUpdateProposal era
forall era. TxUpdateProposal era
TxUpdateProposalNone
        SJust Update (SophieMAEra 'Jen StandardCrypto)
p ->
          UpdateProposalSupportedInEra JenEra
-> UpdateProposal -> TxUpdateProposal JenEra
forall era.
UpdateProposalSupportedInEra era
-> UpdateProposal -> TxUpdateProposal era
TxUpdateProposal UpdateProposalSupportedInEra JenEra
UpdateProposalInJenEra
                           (SophieBasedEra era
-> Update (SophieMAEra 'Jen StandardCrypto) -> UpdateProposal
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 Crypto ledgerera ~ StandardCrypto) =>
SophieBasedEra era -> Update ledgerera -> UpdateProposal
fromLedgerUpdate SophieBasedEra era
era Update (SophieMAEra 'Jen StandardCrypto)
p)

    SophieBasedEra era
SophieBasedEraAurum ->
      case TxBody (AurumEra StandardCrypto)
-> StrictMaybe (Update (AurumEra StandardCrypto))
forall era. TxBody era -> StrictMaybe (Update era)
Aurum.update' TxBody (SophieLedgerEra era)
TxBody (AurumEra StandardCrypto)
body of
        StrictMaybe (Update (AurumEra StandardCrypto))
SNothing -> TxUpdateProposal era
forall era. TxUpdateProposal era
TxUpdateProposalNone
        SJust Update (AurumEra StandardCrypto)
p ->
          UpdateProposalSupportedInEra AurumEra
-> UpdateProposal -> TxUpdateProposal AurumEra
forall era.
UpdateProposalSupportedInEra era
-> UpdateProposal -> TxUpdateProposal era
TxUpdateProposal UpdateProposalSupportedInEra AurumEra
UpdateProposalInAurumEra
                           (SophieBasedEra era
-> Update (AurumEra StandardCrypto) -> UpdateProposal
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 Crypto ledgerera ~ StandardCrypto) =>
SophieBasedEra era -> Update ledgerera -> UpdateProposal
fromLedgerUpdate SophieBasedEra era
era Update (AurumEra StandardCrypto)
p)


fromLedgerTxMintValue
  :: SophieBasedEra era
  -> Ledger.TxBody (SophieLedgerEra era)
  -> TxMintValue ViewTx era
fromLedgerTxMintValue :: SophieBasedEra era
-> TxBody (SophieLedgerEra era) -> TxMintValue ViewTx era
fromLedgerTxMintValue SophieBasedEra era
era TxBody (SophieLedgerEra era)
body =
  case SophieBasedEra era
era of
    SophieBasedEra era
SophieBasedEraSophie -> TxMintValue ViewTx era
forall build era. TxMintValue build era
TxMintNone
    SophieBasedEra era
SophieBasedEraEvie -> TxMintValue ViewTx era
forall build era. TxMintValue build era
TxMintNone
    SophieBasedEra era
SophieBasedEraJen
      | Value StandardCrypto -> Bool
forall t. Val t => t -> Bool
isZero Value (SophieMAEra 'Jen StandardCrypto)
Value StandardCrypto
mint        -> TxMintValue ViewTx era
forall build era. TxMintValue build era
TxMintNone
      | Bool
otherwise          -> MultiAssetSupportedInEra JenEra
-> Value
-> BuildTxWith
     ViewTx (Map PolicyId (ScriptWitness WitCtxMint JenEra))
-> TxMintValue ViewTx JenEra
forall era build.
MultiAssetSupportedInEra era
-> Value
-> BuildTxWith build (Map PolicyId (ScriptWitness WitCtxMint era))
-> TxMintValue build era
TxMintValue MultiAssetSupportedInEra JenEra
MultiAssetInJenEra
                                          (Value StandardCrypto -> Value
fromJenValue Value (SophieMAEra 'Jen StandardCrypto)
Value StandardCrypto
mint) BuildTxWith ViewTx (Map PolicyId (ScriptWitness WitCtxMint JenEra))
forall a. BuildTxWith ViewTx a
ViewTx
      where
        mint :: Value (SophieMAEra 'Jen StandardCrypto)
mint = TxBody (SophieMAEra 'Jen StandardCrypto)
-> Value (SophieMAEra 'Jen StandardCrypto)
forall era. TxBody era -> Value era
Jen.mint' TxBody (SophieMAEra 'Jen StandardCrypto)
TxBody (SophieLedgerEra era)
body

    SophieBasedEra era
SophieBasedEraAurum
      | Value StandardCrypto -> Bool
forall t. Val t => t -> Bool
isZero Value StandardCrypto
Value (Crypto (AurumEra StandardCrypto))
mint         -> TxMintValue ViewTx era
forall build era. TxMintValue build era
TxMintNone
      | Bool
otherwise           -> MultiAssetSupportedInEra AurumEra
-> Value
-> BuildTxWith
     ViewTx (Map PolicyId (ScriptWitness WitCtxMint AurumEra))
-> TxMintValue ViewTx AurumEra
forall era build.
MultiAssetSupportedInEra era
-> Value
-> BuildTxWith build (Map PolicyId (ScriptWitness WitCtxMint era))
-> TxMintValue build era
TxMintValue MultiAssetSupportedInEra AurumEra
MultiAssetInAurumEra
                                           (Value StandardCrypto -> Value
fromJenValue Value StandardCrypto
Value (Crypto (AurumEra StandardCrypto))
mint) BuildTxWith
  ViewTx (Map PolicyId (ScriptWitness WitCtxMint AurumEra))
forall a. BuildTxWith ViewTx a
ViewTx
      where
        mint :: Value (Crypto (AurumEra StandardCrypto))
mint = TxBody (AurumEra StandardCrypto)
-> Value (Crypto (AurumEra StandardCrypto))
forall era. TxBody era -> Value (Crypto era)
Aurum.mint' TxBody (SophieLedgerEra era)
TxBody (AurumEra StandardCrypto)
body


makeColeTransactionBody :: TxBodyContent BuildTx ColeEra
                         -> Either TxBodyError (TxBody ColeEra)
makeColeTransactionBody :: TxBodyContent BuildTx ColeEra
-> Either TxBodyError (TxBody ColeEra)
makeColeTransactionBody TxBodyContent { TxIns BuildTx ColeEra
txIns :: TxIns BuildTx ColeEra
txIns :: forall build era. TxBodyContent build era -> TxIns build era
txIns, [TxOut ColeEra]
txOuts :: [TxOut ColeEra]
txOuts :: forall build era. TxBodyContent build era -> [TxOut era]
txOuts } = do
    NonEmpty (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ColeEra))
ins'  <- TxIns BuildTx ColeEra
-> Maybe
     (NonEmpty (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ColeEra)))
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty TxIns BuildTx ColeEra
txIns      Maybe
  (NonEmpty (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ColeEra)))
-> TxBodyError
-> Either
     TxBodyError
     (NonEmpty (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ColeEra)))
forall a e. Maybe a -> e -> Either e a
?! TxBodyError
TxBodyEmptyTxIns
    let ins'' :: NonEmpty TxIn
ins'' = ((TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ColeEra)) -> TxIn)
-> NonEmpty
     (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ColeEra))
-> NonEmpty TxIn
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map (TxIn -> TxIn
toColeTxIn (TxIn -> TxIn)
-> ((TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ColeEra))
    -> TxIn)
-> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ColeEra))
-> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ColeEra)) -> TxIn
forall a b. (a, b) -> a
fst) NonEmpty (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ColeEra))
ins'

    NonEmpty (TxOut ColeEra)
outs'  <- [TxOut ColeEra] -> Maybe (NonEmpty (TxOut ColeEra))
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [TxOut ColeEra]
txOuts    Maybe (NonEmpty (TxOut ColeEra))
-> TxBodyError -> Either TxBodyError (NonEmpty (TxOut ColeEra))
forall a e. Maybe a -> e -> Either e a
?! TxBodyError
TxBodyEmptyTxOuts
    NonEmpty TxOut
outs'' <- (TxOut ColeEra -> Either TxBodyError TxOut)
-> NonEmpty (TxOut ColeEra) -> Either TxBodyError (NonEmpty TxOut)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
                (\TxOut ColeEra
out -> TxOut ColeEra -> Maybe TxOut
toColeTxOut TxOut ColeEra
out Maybe TxOut -> TxBodyError -> Either TxBodyError TxOut
forall a e. Maybe a -> e -> Either e a
?! TxOut ColeEra -> TxBodyError
classifyRangeError TxOut ColeEra
out)
                NonEmpty (TxOut ColeEra)
outs'
    TxBody ColeEra -> Either TxBodyError (TxBody ColeEra)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxBody ColeEra -> Either TxBodyError (TxBody ColeEra))
-> TxBody ColeEra -> Either TxBodyError (TxBody ColeEra)
forall a b. (a -> b) -> a -> b
$
      Annotated Tx ByteString -> TxBody ColeEra
ColeTxBody (Annotated Tx ByteString -> TxBody ColeEra)
-> Annotated Tx ByteString -> TxBody ColeEra
forall a b. (a -> b) -> a -> b
$
        Annotated Tx () -> Annotated Tx ByteString
forall a b. ToCBOR a => Annotated a b -> Annotated a ByteString
reAnnotate (Annotated Tx () -> Annotated Tx ByteString)
-> Annotated Tx () -> Annotated Tx ByteString
forall a b. (a -> b) -> a -> b
$
          Tx -> () -> Annotated Tx ()
forall b a. b -> a -> Annotated b a
Annotated
            (NonEmpty TxIn -> NonEmpty TxOut -> TxAttributes -> Tx
Cole.UnsafeTx NonEmpty TxIn
ins'' NonEmpty TxOut
outs'' (() -> TxAttributes
forall h. h -> Attributes h
Cole.mkAttributes ()))
            ()
  where
    classifyRangeError :: TxOut ColeEra -> TxBodyError
    classifyRangeError :: TxOut ColeEra -> TxBodyError
classifyRangeError
      txout :: TxOut ColeEra
txout@(TxOut (AddressInEra AddressTypeInEra addrtype ColeEra
ColeAddressInAnyEra ColeAddress{})
                   (TxOutBccOnly OnlyBccSupportedInEra ColeEra
BccOnlyInColeEra Entropic
value) TxOutDatumHash ColeEra
_)
      | Entropic
value Entropic -> Entropic -> Bool
forall a. Ord a => a -> a -> Bool
< Entropic
0        = Quantity -> TxOutInAnyEra -> TxBodyError
TxBodyOutputNegative (Entropic -> Quantity
entropicToQuantity Entropic
value)
                                                (TxOut ColeEra -> TxOutInAnyEra
forall era. IsBccEra era => TxOut era -> TxOutInAnyEra
txOutInAnyEra TxOut ColeEra
txout)
      | Bool
otherwise        = Quantity -> TxOutInAnyEra -> TxBodyError
TxBodyOutputOverflow (Entropic -> Quantity
entropicToQuantity Entropic
value)
                                                (TxOut ColeEra -> TxOutInAnyEra
forall era. IsBccEra era => TxOut era -> TxOutInAnyEra
txOutInAnyEra TxOut ColeEra
txout)

    classifyRangeError
      (TxOut (AddressInEra AddressTypeInEra addrtype ColeEra
ColeAddressInAnyEra (ColeAddress Address
_))
             (TxOutValue MultiAssetSupportedInEra ColeEra
era Value
_) TxOutDatumHash ColeEra
_) = case MultiAssetSupportedInEra ColeEra
era of {}

    classifyRangeError
      (TxOut (AddressInEra (SophieAddressInEra SophieBasedEra ColeEra
era) SophieAddress{})
             TxOutValue ColeEra
_ TxOutDatumHash ColeEra
_) = case SophieBasedEra ColeEra
era of {}

getColeTxBodyContent :: Annotated Cole.Tx ByteString
                      -> TxBodyContent ViewTx ColeEra
getColeTxBodyContent :: Annotated Tx ByteString -> TxBodyContent ViewTx ColeEra
getColeTxBodyContent (Annotated Cole.UnsafeTx{NonEmpty TxIn
txInputs :: Tx -> NonEmpty TxIn
txInputs :: NonEmpty TxIn
txInputs, NonEmpty TxOut
txOutputs :: Tx -> NonEmpty TxOut
txOutputs :: NonEmpty TxOut
txOutputs} ByteString
_) =
    TxBodyContent :: forall build era.
TxIns build era
-> TxInsCollateral era
-> [TxOut era]
-> TxFee era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
-> TxMetadataInEra era
-> TxAuxScripts era
-> BuildTxWith build (TxExtraScriptData era)
-> TxExtraKeyWitnesses era
-> BuildTxWith build (Maybe ProtocolParameters)
-> TxWithdrawals build era
-> TxCertificates build era
-> TxUpdateProposal era
-> TxMintValue build era
-> TxScriptValidity era
-> TxBodyContent build era
TxBodyContent {
      txIns :: TxIns ViewTx ColeEra
txIns            = [ (TxIn -> TxIn
fromColeTxIn TxIn
input, BuildTxWith ViewTx (Witness WitCtxTxIn ColeEra)
forall a. BuildTxWith ViewTx a
ViewTx)
                         | TxIn
input <- NonEmpty TxIn -> [TxIn]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty TxIn
txInputs],
      txInsCollateral :: TxInsCollateral ColeEra
txInsCollateral  = TxInsCollateral ColeEra
forall era. TxInsCollateral era
TxInsCollateralNone,
      txOuts :: [TxOut ColeEra]
txOuts           = TxOut -> TxOut ColeEra
fromColeTxOut (TxOut -> TxOut ColeEra) -> [TxOut] -> [TxOut ColeEra]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty TxOut -> [TxOut]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty TxOut
txOutputs,
      txFee :: TxFee ColeEra
txFee            = TxFeesImplicitInEra ColeEra -> TxFee ColeEra
forall era. TxFeesImplicitInEra era -> TxFee era
TxFeeImplicit TxFeesImplicitInEra ColeEra
TxFeesImplicitInColeEra,
      txValidityRange :: (TxValidityLowerBound ColeEra, TxValidityUpperBound ColeEra)
txValidityRange  = (TxValidityLowerBound ColeEra
forall era. TxValidityLowerBound era
TxValidityNoLowerBound,
                          ValidityNoUpperBoundSupportedInEra ColeEra
-> TxValidityUpperBound ColeEra
forall era.
ValidityNoUpperBoundSupportedInEra era -> TxValidityUpperBound era
TxValidityNoUpperBound
                            ValidityNoUpperBoundSupportedInEra ColeEra
ValidityNoUpperBoundInColeEra),
      txMetadata :: TxMetadataInEra ColeEra
txMetadata       = TxMetadataInEra ColeEra
forall era. TxMetadataInEra era
TxMetadataNone,
      txAuxScripts :: TxAuxScripts ColeEra
txAuxScripts     = TxAuxScripts ColeEra
forall era. TxAuxScripts era
TxAuxScriptsNone,
      txExtraScriptData :: BuildTxWith ViewTx (TxExtraScriptData ColeEra)
txExtraScriptData= BuildTxWith ViewTx (TxExtraScriptData ColeEra)
forall a. BuildTxWith ViewTx a
ViewTx,
      txExtraKeyWits :: TxExtraKeyWitnesses ColeEra
txExtraKeyWits   = TxExtraKeyWitnesses ColeEra
forall era. TxExtraKeyWitnesses era
TxExtraKeyWitnessesNone,
      txProtocolParams :: BuildTxWith ViewTx (Maybe ProtocolParameters)
txProtocolParams = BuildTxWith ViewTx (Maybe ProtocolParameters)
forall a. BuildTxWith ViewTx a
ViewTx,
      txWithdrawals :: TxWithdrawals ViewTx ColeEra
txWithdrawals    = TxWithdrawals ViewTx ColeEra
forall build era. TxWithdrawals build era
TxWithdrawalsNone,
      txCertificates :: TxCertificates ViewTx ColeEra
txCertificates   = TxCertificates ViewTx ColeEra
forall build era. TxCertificates build era
TxCertificatesNone,
      txUpdateProposal :: TxUpdateProposal ColeEra
txUpdateProposal = TxUpdateProposal ColeEra
forall era. TxUpdateProposal era
TxUpdateProposalNone,
      txMintValue :: TxMintValue ViewTx ColeEra
txMintValue      = TxMintValue ViewTx ColeEra
forall build era. TxMintValue build era
TxMintNone,
      txScriptValidity :: TxScriptValidity ColeEra
txScriptValidity = TxScriptValidity ColeEra
forall era. TxScriptValidity era
TxScriptValidityNone
    }

makeSophieTransactionBody :: ()
  => SophieBasedEra era
  -> TxBodyContent BuildTx era
  -> Either TxBodyError (TxBody era)
makeSophieTransactionBody :: SophieBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
makeSophieTransactionBody era :: SophieBasedEra era
era@SophieBasedEra era
SophieBasedEraSophie
                           txbodycontent :: TxBodyContent BuildTx era
txbodycontent@TxBodyContent {
                             TxIns BuildTx era
txIns :: TxIns BuildTx era
txIns :: forall build era. TxBodyContent build era -> TxIns build era
txIns,
                             [TxOut era]
txOuts :: [TxOut era]
txOuts :: forall build era. TxBodyContent build era -> [TxOut era]
txOuts,
                             TxFee era
txFee :: TxFee era
txFee :: forall build era. TxBodyContent build era -> TxFee era
txFee,
                             txValidityRange :: forall build era.
TxBodyContent build era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
txValidityRange = (TxValidityLowerBound era
_, TxValidityUpperBound era
upperBound),
                             TxMetadataInEra era
txMetadata :: TxMetadataInEra era
txMetadata :: forall build era. TxBodyContent build era -> TxMetadataInEra era
txMetadata,
                             TxWithdrawals BuildTx era
txWithdrawals :: TxWithdrawals BuildTx era
txWithdrawals :: forall build era.
TxBodyContent build era -> TxWithdrawals build era
txWithdrawals,
                             TxCertificates BuildTx era
txCertificates :: TxCertificates BuildTx era
txCertificates :: forall build era.
TxBodyContent build era -> TxCertificates build era
txCertificates,
                             TxUpdateProposal era
txUpdateProposal :: TxUpdateProposal era
txUpdateProposal :: forall build era. TxBodyContent build era -> TxUpdateProposal era
txUpdateProposal
                           } = do

    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (TxIns BuildTx era -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null TxIns BuildTx era
txIns)) Maybe () -> TxBodyError -> Either TxBodyError ()
forall a e. Maybe a -> e -> Either e a
?! TxBodyError
TxBodyEmptyTxIns
    [Either TxBodyError ()] -> Either TxBodyError ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ do Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Entropic
v Entropic -> Entropic -> Bool
forall a. Ord a => a -> a -> Bool
>= Entropic
0) Maybe () -> TxBodyError -> Either TxBodyError ()
forall a e. Maybe a -> e -> Either e a
?! Quantity -> TxOutInAnyEra -> TxBodyError
TxBodyOutputNegative (Entropic -> Quantity
entropicToQuantity Entropic
v)
                                                  (TxOut era -> TxOutInAnyEra
forall era. IsBccEra era => TxOut era -> TxOutInAnyEra
txOutInAnyEra TxOut era
txout)
           Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Entropic
v Entropic -> Entropic -> Bool
forall a. Ord a => a -> a -> Bool
<= Entropic
maxTxOut) Maybe () -> TxBodyError -> Either TxBodyError ()
forall a e. Maybe a -> e -> Either e a
?! Quantity -> TxOutInAnyEra -> TxBodyError
TxBodyOutputOverflow (Entropic -> Quantity
entropicToQuantity Entropic
v)
                                                         (TxOut era -> TxOutInAnyEra
forall era. IsBccEra era => TxOut era -> TxOutInAnyEra
txOutInAnyEra TxOut era
txout)
      | let maxTxOut :: Entropic
maxTxOut = Word64 -> Entropic
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64) :: Entropic
      , txout :: TxOut era
txout@(TxOut AddressInEra era
_ (TxOutBccOnly OnlyBccSupportedInEra era
BccOnlyInSophieEra Entropic
v) TxOutDatumHash era
_) <- [TxOut era]
txOuts ]
    case TxMetadataInEra era
txMetadata of
      TxMetadataInEra era
TxMetadataNone      -> () -> Either TxBodyError ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      TxMetadataInEra TxMetadataSupportedInEra era
_ TxMetadata
m -> ([(Word64, TxMetadataRangeError)] -> TxBodyError)
-> Either [(Word64, TxMetadataRangeError)] ()
-> Either TxBodyError ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [(Word64, TxMetadataRangeError)] -> TxBodyError
TxBodyMetadataError (TxMetadata -> Either [(Word64, TxMetadataRangeError)] ()
validateTxMetadata TxMetadata
m)

    TxBody era -> Either TxBodyError (TxBody era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxBody era -> Either TxBodyError (TxBody era))
-> TxBody era -> Either TxBodyError (TxBody era)
forall a b. (a -> b) -> a -> b
$
      SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [Script (SophieLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxScriptValidity era
-> TxBody era
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [Script (SophieLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxScriptValidity era
-> TxBody era
SophieTxBody SophieBasedEra era
era
        (Set (TxIn (Crypto (SophieEra StandardCrypto)))
-> StrictSeq (TxOut (SophieEra StandardCrypto))
-> StrictSeq (DCert (Crypto (SophieEra StandardCrypto)))
-> Wdrl (Crypto (SophieEra StandardCrypto))
-> Coin
-> SlotNo
-> StrictMaybe (Update (SophieEra StandardCrypto))
-> StrictMaybe
     (AuxiliaryDataHash (Crypto (SophieEra StandardCrypto)))
-> TxBody (SophieEra StandardCrypto)
forall era.
(Era era, FromCBOR (PParamsDelta era), TransTxBody ToCBOR era) =>
Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> TxBody era
Sophie.TxBody
          ([TxIn StandardCrypto] -> Set (TxIn StandardCrypto)
forall a. Ord a => [a] -> Set a
Set.fromList (((TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
 -> TxIn StandardCrypto)
-> TxIns BuildTx era -> [TxIn StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn -> TxIn StandardCrypto
toSophieTxIn (TxIn -> TxIn StandardCrypto)
-> ((TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)) -> TxIn)
-> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
-> TxIn StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)) -> TxIn
forall a b. (a, b) -> a
fst) TxIns BuildTx era
txIns))
          ([TxOut (SophieEra StandardCrypto)]
-> StrictSeq (TxOut (SophieEra StandardCrypto))
forall a. [a] -> StrictSeq a
Seq.fromList ((TxOut era -> TxOut (SophieEra StandardCrypto))
-> [TxOut era] -> [TxOut (SophieEra StandardCrypto)]
forall a b. (a -> b) -> [a] -> [b]
map (SophieBasedEra era -> TxOut era -> TxOut (SophieEra StandardCrypto)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera) =>
SophieBasedEra era -> TxOut era -> TxOut ledgerera
toSophieTxOut SophieBasedEra era
era) [TxOut era]
txOuts))
          (case TxCertificates BuildTx era
txCertificates of
             TxCertificates BuildTx era
TxCertificatesNone    -> StrictSeq (DCert (Crypto (SophieEra StandardCrypto)))
forall a. StrictSeq a
Seq.empty
             TxCertificates CertificatesSupportedInEra era
_ [Certificate]
cs BuildTxWith BuildTx (Map StakeCredential (Witness WitCtxStake era))
_ -> [DCert StandardCrypto] -> StrictSeq (DCert StandardCrypto)
forall a. [a] -> StrictSeq a
Seq.fromList ((Certificate -> DCert StandardCrypto)
-> [Certificate] -> [DCert StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map Certificate -> DCert StandardCrypto
toSophieCertificate [Certificate]
cs))
          (case TxWithdrawals BuildTx era
txWithdrawals of
             TxWithdrawals BuildTx era
TxWithdrawalsNone  -> Map (RewardAcnt StandardCrypto) Coin -> Wdrl StandardCrypto
forall crypto. Map (RewardAcnt crypto) Coin -> Wdrl crypto
Sophie.Wdrl Map (RewardAcnt StandardCrypto) Coin
forall k a. Map k a
Map.empty
             TxWithdrawals WithdrawalsSupportedInEra era
_ [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
ws -> [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
-> Wdrl StandardCrypto
forall a. [(StakeAddress, Entropic, a)] -> Wdrl StandardCrypto
toSophieWithdrawal [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
ws)
          (case TxFee era
txFee of
             TxFeeImplicit TxFeesImplicitInEra era
era'  -> case TxFeesImplicitInEra era
era' of {}
             TxFeeExplicit TxFeesExplicitInEra era
_ Entropic
fee -> Entropic -> Coin
toSophieEntropic Entropic
fee)
          (case TxValidityUpperBound era
upperBound of
             TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra era
era' -> case ValidityNoUpperBoundSupportedInEra era
era' of {}
             TxValidityUpperBound ValidityUpperBoundSupportedInEra era
_ SlotNo
ttl  -> SlotNo
ttl)
          (case TxUpdateProposal era
txUpdateProposal of
             TxUpdateProposal era
TxUpdateProposalNone -> StrictMaybe (Update (SophieEra StandardCrypto))
forall a. StrictMaybe a
SNothing
             TxUpdateProposal UpdateProposalSupportedInEra era
_ UpdateProposal
p -> Update (SophieEra StandardCrypto)
-> StrictMaybe (Update (SophieEra StandardCrypto))
forall a. a -> StrictMaybe a
SJust (SophieBasedEra era
-> UpdateProposal -> Update (SophieEra StandardCrypto)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 Crypto ledgerera ~ StandardCrypto) =>
SophieBasedEra era -> UpdateProposal -> Update ledgerera
toLedgerUpdate SophieBasedEra era
era UpdateProposal
p))
          (Maybe (AuxiliaryDataHash StandardCrypto)
-> StrictMaybe (AuxiliaryDataHash StandardCrypto)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe
            (Metadata (SophieEra StandardCrypto)
-> AuxiliaryDataHash StandardCrypto
forall era c.
ValidateAuxiliaryData era c =>
AuxiliaryData era -> AuxiliaryDataHash c
Ledger.hashAuxiliaryData (Metadata (SophieEra StandardCrypto)
 -> AuxiliaryDataHash StandardCrypto)
-> Maybe (Metadata (SophieEra StandardCrypto))
-> Maybe (AuxiliaryDataHash StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AuxiliaryData (SophieEra StandardCrypto))
Maybe (Metadata (SophieEra StandardCrypto))
txAuxData)))
        [Script (SophieEra StandardCrypto)]
[Script (SophieLedgerEra era)]
scripts
        TxBodyScriptData era
forall era. TxBodyScriptData era
TxBodyNoScriptData
        Maybe (AuxiliaryData (SophieEra StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txAuxData
        TxScriptValidity era
forall era. TxScriptValidity era
TxScriptValidityNone
  where
    scripts :: [Ledger.Script StandardSophie]
    scripts :: [Script (SophieEra StandardCrypto)]
scripts =
      [ ScriptInEra era -> Script (SophieLedgerEra era)
forall era. ScriptInEra era -> Script (SophieLedgerEra era)
toSophieScript (ScriptWitness witctx era -> ScriptInEra era
forall witctx era. ScriptWitness witctx era -> ScriptInEra era
scriptWitnessScript ScriptWitness witctx era
scriptwitness)
      | (ScriptWitnessIndex
_, AnyScriptWitness ScriptWitness witctx era
scriptwitness)
          <- TxBodyContent BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
forall era.
TxBodyContent BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
collectTxBodyScriptWitnesses TxBodyContent BuildTx era
txbodycontent
      ]

    txAuxData :: Maybe (Ledger.AuxiliaryData StandardSophie)
    txAuxData :: Maybe (AuxiliaryData (SophieEra StandardCrypto))
txAuxData
      | Map Word64 TxMetadataValue -> Bool
forall k a. Map k a -> Bool
Map.null Map Word64 TxMetadataValue
ms = Maybe (AuxiliaryData (SophieEra StandardCrypto))
forall a. Maybe a
Nothing
      | Bool
otherwise   = Metadata (SophieEra StandardCrypto)
-> Maybe (Metadata (SophieEra StandardCrypto))
forall a. a -> Maybe a
Just (Map Word64 TxMetadataValue
-> AuxiliaryData (SophieEra StandardCrypto)
toSophieAuxiliaryData Map Word64 TxMetadataValue
ms)
      where
        ms :: Map Word64 TxMetadataValue
ms = case TxMetadataInEra era
txMetadata of
               TxMetadataInEra era
TxMetadataNone                     -> Map Word64 TxMetadataValue
forall k a. Map k a
Map.empty
               TxMetadataInEra TxMetadataSupportedInEra era
_ (TxMetadata Map Word64 TxMetadataValue
ms') -> Map Word64 TxMetadataValue
ms'

makeSophieTransactionBody era :: SophieBasedEra era
era@SophieBasedEra era
SophieBasedEraEvie
                           txbodycontent :: TxBodyContent BuildTx era
txbodycontent@TxBodyContent {
                             TxIns BuildTx era
txIns :: TxIns BuildTx era
txIns :: forall build era. TxBodyContent build era -> TxIns build era
txIns,
                             [TxOut era]
txOuts :: [TxOut era]
txOuts :: forall build era. TxBodyContent build era -> [TxOut era]
txOuts,
                             TxFee era
txFee :: TxFee era
txFee :: forall build era. TxBodyContent build era -> TxFee era
txFee,
                             txValidityRange :: forall build era.
TxBodyContent build era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
txValidityRange = (TxValidityLowerBound era
lowerBound, TxValidityUpperBound era
upperBound),
                             TxMetadataInEra era
txMetadata :: TxMetadataInEra era
txMetadata :: forall build era. TxBodyContent build era -> TxMetadataInEra era
txMetadata,
                             TxAuxScripts era
txAuxScripts :: TxAuxScripts era
txAuxScripts :: forall build era. TxBodyContent build era -> TxAuxScripts era
txAuxScripts,
                             TxWithdrawals BuildTx era
txWithdrawals :: TxWithdrawals BuildTx era
txWithdrawals :: forall build era.
TxBodyContent build era -> TxWithdrawals build era
txWithdrawals,
                             TxCertificates BuildTx era
txCertificates :: TxCertificates BuildTx era
txCertificates :: forall build era.
TxBodyContent build era -> TxCertificates build era
txCertificates,
                             TxUpdateProposal era
txUpdateProposal :: TxUpdateProposal era
txUpdateProposal :: forall build era. TxBodyContent build era -> TxUpdateProposal era
txUpdateProposal
                           } = do

    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (TxIns BuildTx era -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null TxIns BuildTx era
txIns)) Maybe () -> TxBodyError -> Either TxBodyError ()
forall a e. Maybe a -> e -> Either e a
?! TxBodyError
TxBodyEmptyTxIns
    [Either TxBodyError ()] -> Either TxBodyError ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ do Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Entropic
v Entropic -> Entropic -> Bool
forall a. Ord a => a -> a -> Bool
>= Entropic
0) Maybe () -> TxBodyError -> Either TxBodyError ()
forall a e. Maybe a -> e -> Either e a
?! Quantity -> TxOutInAnyEra -> TxBodyError
TxBodyOutputNegative (Entropic -> Quantity
entropicToQuantity Entropic
v)
                                                  (TxOut era -> TxOutInAnyEra
forall era. IsBccEra era => TxOut era -> TxOutInAnyEra
txOutInAnyEra TxOut era
txout)
           Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Entropic
v Entropic -> Entropic -> Bool
forall a. Ord a => a -> a -> Bool
<= Entropic
maxTxOut) Maybe () -> TxBodyError -> Either TxBodyError ()
forall a e. Maybe a -> e -> Either e a
?! Quantity -> TxOutInAnyEra -> TxBodyError
TxBodyOutputOverflow (Entropic -> Quantity
entropicToQuantity Entropic
v)
                                                         (TxOut era -> TxOutInAnyEra
forall era. IsBccEra era => TxOut era -> TxOutInAnyEra
txOutInAnyEra TxOut era
txout)
      | let maxTxOut :: Entropic
maxTxOut = Word64 -> Entropic
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64) :: Entropic
      , txout :: TxOut era
txout@(TxOut AddressInEra era
_ (TxOutBccOnly OnlyBccSupportedInEra era
BccOnlyInEvieEra Entropic
v) TxOutDatumHash era
_) <- [TxOut era]
txOuts
      ]
    case TxMetadataInEra era
txMetadata of
      TxMetadataInEra era
TxMetadataNone      -> () -> Either TxBodyError ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      TxMetadataInEra TxMetadataSupportedInEra era
_ TxMetadata
m -> TxMetadata -> Either [(Word64, TxMetadataRangeError)] ()
validateTxMetadata TxMetadata
m Either [(Word64, TxMetadataRangeError)] ()
-> ([(Word64, TxMetadataRangeError)] -> TxBodyError)
-> Either TxBodyError ()
forall e a e'. Either e a -> (e -> e') -> Either e' a
?!. [(Word64, TxMetadataRangeError)] -> TxBodyError
TxBodyMetadataError

    TxBody era -> Either TxBodyError (TxBody era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxBody era -> Either TxBodyError (TxBody era))
-> TxBody era -> Either TxBodyError (TxBody era)
forall a b. (a -> b) -> a -> b
$
      SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [Script (SophieLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxScriptValidity era
-> TxBody era
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [Script (SophieLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxScriptValidity era
-> TxBody era
SophieTxBody SophieBasedEra era
era
        (Set (TxIn (Crypto (SophieMAEra 'Evie StandardCrypto)))
-> StrictSeq (TxOut (SophieMAEra 'Evie StandardCrypto))
-> StrictSeq (DCert (Crypto (SophieMAEra 'Evie StandardCrypto)))
-> Wdrl (Crypto (SophieMAEra 'Evie StandardCrypto))
-> Coin
-> ValidityInterval
-> StrictMaybe (Update (SophieMAEra 'Evie StandardCrypto))
-> StrictMaybe
     (AuxiliaryDataHash (Crypto (SophieMAEra 'Evie StandardCrypto)))
-> Value (SophieMAEra 'Evie StandardCrypto)
-> TxBody (SophieMAEra 'Evie StandardCrypto)
forall era.
FamsTo era =>
Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> Value era
-> TxBody era
Evie.TxBody
          ([TxIn StandardCrypto] -> Set (TxIn StandardCrypto)
forall a. Ord a => [a] -> Set a
Set.fromList (((TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
 -> TxIn StandardCrypto)
-> TxIns BuildTx era -> [TxIn StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn -> TxIn StandardCrypto
toSophieTxIn (TxIn -> TxIn StandardCrypto)
-> ((TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)) -> TxIn)
-> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
-> TxIn StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)) -> TxIn
forall a b. (a, b) -> a
fst) TxIns BuildTx era
txIns))
          ([TxOut (SophieMAEra 'Evie StandardCrypto)]
-> StrictSeq (TxOut (SophieMAEra 'Evie StandardCrypto))
forall a. [a] -> StrictSeq a
Seq.fromList ((TxOut era -> TxOut (SophieMAEra 'Evie StandardCrypto))
-> [TxOut era] -> [TxOut (SophieMAEra 'Evie StandardCrypto)]
forall a b. (a -> b) -> [a] -> [b]
map (SophieBasedEra era
-> TxOut era -> TxOut (SophieMAEra 'Evie StandardCrypto)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera) =>
SophieBasedEra era -> TxOut era -> TxOut ledgerera
toSophieTxOut SophieBasedEra era
era) [TxOut era]
txOuts))
          (case TxCertificates BuildTx era
txCertificates of
             TxCertificates BuildTx era
TxCertificatesNone    -> StrictSeq (DCert (Crypto (SophieMAEra 'Evie StandardCrypto)))
forall a. StrictSeq a
Seq.empty
             TxCertificates CertificatesSupportedInEra era
_ [Certificate]
cs BuildTxWith BuildTx (Map StakeCredential (Witness WitCtxStake era))
_ -> [DCert StandardCrypto] -> StrictSeq (DCert StandardCrypto)
forall a. [a] -> StrictSeq a
Seq.fromList ((Certificate -> DCert StandardCrypto)
-> [Certificate] -> [DCert StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map Certificate -> DCert StandardCrypto
toSophieCertificate [Certificate]
cs))
          (case TxWithdrawals BuildTx era
txWithdrawals of
             TxWithdrawals BuildTx era
TxWithdrawalsNone  -> Map (RewardAcnt StandardCrypto) Coin -> Wdrl StandardCrypto
forall crypto. Map (RewardAcnt crypto) Coin -> Wdrl crypto
Sophie.Wdrl Map (RewardAcnt StandardCrypto) Coin
forall k a. Map k a
Map.empty
             TxWithdrawals WithdrawalsSupportedInEra era
_ [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
ws -> [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
-> Wdrl StandardCrypto
forall a. [(StakeAddress, Entropic, a)] -> Wdrl StandardCrypto
toSophieWithdrawal [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
ws)
          (case TxFee era
txFee of
             TxFeeImplicit TxFeesImplicitInEra era
era'  -> case TxFeesImplicitInEra era
era' of {}
             TxFeeExplicit TxFeesExplicitInEra era
_ Entropic
fee -> Entropic -> Coin
toSophieEntropic Entropic
fee)
          (ValidityInterval :: StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
Evie.ValidityInterval {
             invalidBefore :: StrictMaybe SlotNo
invalidBefore    = case TxValidityLowerBound era
lowerBound of
                                          TxValidityLowerBound era
TxValidityNoLowerBound   -> StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing
                                          TxValidityLowerBound ValidityLowerBoundSupportedInEra era
_ SlotNo
s -> SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
s,
             invalidHereafter :: StrictMaybe SlotNo
invalidHereafter = case TxValidityUpperBound era
upperBound of
                                          TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra era
_ -> StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing
                                          TxValidityUpperBound ValidityUpperBoundSupportedInEra era
_ SlotNo
s -> SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
s
           })
          (case TxUpdateProposal era
txUpdateProposal of
             TxUpdateProposal era
TxUpdateProposalNone -> StrictMaybe (Update (SophieMAEra 'Evie StandardCrypto))
forall a. StrictMaybe a
SNothing
             TxUpdateProposal UpdateProposalSupportedInEra era
_ UpdateProposal
p -> Update (SophieMAEra 'Evie StandardCrypto)
-> StrictMaybe (Update (SophieMAEra 'Evie StandardCrypto))
forall a. a -> StrictMaybe a
SJust (SophieBasedEra era
-> UpdateProposal -> Update (SophieMAEra 'Evie StandardCrypto)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 Crypto ledgerera ~ StandardCrypto) =>
SophieBasedEra era -> UpdateProposal -> Update ledgerera
toLedgerUpdate SophieBasedEra era
era UpdateProposal
p))
          (Maybe (AuxiliaryDataHash StandardCrypto)
-> StrictMaybe (AuxiliaryDataHash StandardCrypto)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe
            (AuxiliaryData (SophieMAEra 'Evie StandardCrypto)
-> AuxiliaryDataHash StandardCrypto
forall era c.
ValidateAuxiliaryData era c =>
AuxiliaryData era -> AuxiliaryDataHash c
Ledger.hashAuxiliaryData (AuxiliaryData (SophieMAEra 'Evie StandardCrypto)
 -> AuxiliaryDataHash StandardCrypto)
-> Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto))
-> Maybe (AuxiliaryDataHash StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto))
Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto))
txAuxData))
          Value (SophieMAEra 'Evie StandardCrypto)
forall a. Monoid a => a
mempty) -- No minting in Evie, only Jen
        [Script (SophieMAEra 'Evie StandardCrypto)]
[Script (SophieLedgerEra era)]
scripts
        TxBodyScriptData era
forall era. TxBodyScriptData era
TxBodyNoScriptData
        Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txAuxData
        TxScriptValidity era
forall era. TxScriptValidity era
TxScriptValidityNone
  where
    scripts :: [Ledger.Script StandardEvie]
    scripts :: [Script (SophieMAEra 'Evie StandardCrypto)]
scripts =
      [ ScriptInEra era -> Script (SophieLedgerEra era)
forall era. ScriptInEra era -> Script (SophieLedgerEra era)
toSophieScript (ScriptWitness witctx era -> ScriptInEra era
forall witctx era. ScriptWitness witctx era -> ScriptInEra era
scriptWitnessScript ScriptWitness witctx era
scriptwitness)
      | (ScriptWitnessIndex
_, AnyScriptWitness ScriptWitness witctx era
scriptwitness)
          <- TxBodyContent BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
forall era.
TxBodyContent BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
collectTxBodyScriptWitnesses TxBodyContent BuildTx era
txbodycontent
      ]

    txAuxData :: Maybe (Ledger.AuxiliaryData StandardEvie)
    txAuxData :: Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto))
txAuxData
      | Map Word64 TxMetadataValue -> Bool
forall k a. Map k a -> Bool
Map.null Map Word64 TxMetadataValue
ms
      , [ScriptInEra era] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ScriptInEra era]
ss   = Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto))
forall a. Maybe a
Nothing
      | Bool
otherwise = AuxiliaryData (SophieMAEra 'Evie StandardCrypto)
-> Maybe (AuxiliaryData (SophieMAEra 'Evie StandardCrypto))
forall a. a -> Maybe a
Just (Map Word64 TxMetadataValue
-> [ScriptInEra era]
-> AuxiliaryData (SophieMAEra 'Evie StandardCrypto)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 AuxiliaryData ledgerera ~ AuxiliaryData ledgerera,
 AnnotatedData (Script ledgerera), Ord (Script ledgerera)) =>
Map Word64 TxMetadataValue
-> [ScriptInEra era] -> AuxiliaryData ledgerera
toEvieAuxiliaryData Map Word64 TxMetadataValue
ms [ScriptInEra era]
ss)
      where
        ms :: Map Word64 TxMetadataValue
ms = case TxMetadataInEra era
txMetadata of
               TxMetadataInEra era
TxMetadataNone                     -> Map Word64 TxMetadataValue
forall k a. Map k a
Map.empty
               TxMetadataInEra TxMetadataSupportedInEra era
_ (TxMetadata Map Word64 TxMetadataValue
ms') -> Map Word64 TxMetadataValue
ms'
        ss :: [ScriptInEra era]
ss = case TxAuxScripts era
txAuxScripts of
               TxAuxScripts era
TxAuxScriptsNone   -> []
               TxAuxScripts AuxScriptsSupportedInEra era
_ [ScriptInEra era]
ss' -> [ScriptInEra era]
ss'

makeSophieTransactionBody era :: SophieBasedEra era
era@SophieBasedEra era
SophieBasedEraJen
                           txbodycontent :: TxBodyContent BuildTx era
txbodycontent@TxBodyContent {
                             TxIns BuildTx era
txIns :: TxIns BuildTx era
txIns :: forall build era. TxBodyContent build era -> TxIns build era
txIns,
                             [TxOut era]
txOuts :: [TxOut era]
txOuts :: forall build era. TxBodyContent build era -> [TxOut era]
txOuts,
                             TxFee era
txFee :: TxFee era
txFee :: forall build era. TxBodyContent build era -> TxFee era
txFee,
                             txValidityRange :: forall build era.
TxBodyContent build era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
txValidityRange = (TxValidityLowerBound era
lowerBound, TxValidityUpperBound era
upperBound),
                             TxMetadataInEra era
txMetadata :: TxMetadataInEra era
txMetadata :: forall build era. TxBodyContent build era -> TxMetadataInEra era
txMetadata,
                             TxAuxScripts era
txAuxScripts :: TxAuxScripts era
txAuxScripts :: forall build era. TxBodyContent build era -> TxAuxScripts era
txAuxScripts,
                             TxWithdrawals BuildTx era
txWithdrawals :: TxWithdrawals BuildTx era
txWithdrawals :: forall build era.
TxBodyContent build era -> TxWithdrawals build era
txWithdrawals,
                             TxCertificates BuildTx era
txCertificates :: TxCertificates BuildTx era
txCertificates :: forall build era.
TxBodyContent build era -> TxCertificates build era
txCertificates,
                             TxUpdateProposal era
txUpdateProposal :: TxUpdateProposal era
txUpdateProposal :: forall build era. TxBodyContent build era -> TxUpdateProposal era
txUpdateProposal,
                             TxMintValue BuildTx era
txMintValue :: TxMintValue BuildTx era
txMintValue :: forall build era. TxBodyContent build era -> TxMintValue build era
txMintValue
                           } = do

    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (TxIns BuildTx era -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null TxIns BuildTx era
txIns)) Maybe () -> TxBodyError -> Either TxBodyError ()
forall a e. Maybe a -> e -> Either e a
?! TxBodyError
TxBodyEmptyTxIns
    [Either TxBodyError ()] -> Either TxBodyError ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ do Either TxBodyError ()
allPositive
           Either TxBodyError ()
allWithinMaxBound
      | let maxTxOut :: Quantity
maxTxOut = Word64 -> Quantity
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64) :: Quantity
      , txout :: TxOut era
txout@(TxOut AddressInEra era
_ (TxOutValue MultiAssetSupportedInEra era
MultiAssetInJenEra Value
v) TxOutDatumHash era
_) <- [TxOut era]
txOuts
      , let allPositive :: Either TxBodyError ()
allPositive =
              case [ Quantity
q | (AssetId
_,Quantity
q) <- Value -> [(AssetId, Quantity)]
valueToList Value
v, Quantity
q Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
< Quantity
0 ] of
                []  -> () -> Either TxBodyError ()
forall a b. b -> Either a b
Right ()
                Quantity
q:[Quantity]
_ -> TxBodyError -> Either TxBodyError ()
forall a b. a -> Either a b
Left (Quantity -> TxOutInAnyEra -> TxBodyError
TxBodyOutputNegative Quantity
q (TxOut era -> TxOutInAnyEra
forall era. IsBccEra era => TxOut era -> TxOutInAnyEra
txOutInAnyEra TxOut era
txout))
            allWithinMaxBound :: Either TxBodyError ()
allWithinMaxBound =
              case [ Quantity
q | (AssetId
_,Quantity
q) <- Value -> [(AssetId, Quantity)]
valueToList Value
v, Quantity
q Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
> Quantity
maxTxOut ] of
                []  -> () -> Either TxBodyError ()
forall a b. b -> Either a b
Right ()
                Quantity
q:[Quantity]
_ -> TxBodyError -> Either TxBodyError ()
forall a b. a -> Either a b
Left (Quantity -> TxOutInAnyEra -> TxBodyError
TxBodyOutputOverflow Quantity
q (TxOut era -> TxOutInAnyEra
forall era. IsBccEra era => TxOut era -> TxOutInAnyEra
txOutInAnyEra TxOut era
txout))
      ]
    case TxMetadataInEra era
txMetadata of
      TxMetadataInEra era
TxMetadataNone      -> () -> Either TxBodyError ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      TxMetadataInEra TxMetadataSupportedInEra era
_ TxMetadata
m -> TxMetadata -> Either [(Word64, TxMetadataRangeError)] ()
validateTxMetadata TxMetadata
m Either [(Word64, TxMetadataRangeError)] ()
-> ([(Word64, TxMetadataRangeError)] -> TxBodyError)
-> Either TxBodyError ()
forall e a e'. Either e a -> (e -> e') -> Either e' a
?!. [(Word64, TxMetadataRangeError)] -> TxBodyError
TxBodyMetadataError
    case TxMintValue BuildTx era
txMintValue of
      TxMintValue BuildTx era
TxMintNone        -> () -> Either TxBodyError ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      TxMintValue MultiAssetSupportedInEra era
_ Value
v BuildTxWith BuildTx (Map PolicyId (ScriptWitness WitCtxMint era))
_ -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Value -> Entropic
selectEntropic Value
v Entropic -> Entropic -> Bool
forall a. Eq a => a -> a -> Bool
== Entropic
0) Maybe () -> TxBodyError -> Either TxBodyError ()
forall a e. Maybe a -> e -> Either e a
?! TxBodyError
TxBodyMintBccError

    TxBody era -> Either TxBodyError (TxBody era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxBody era -> Either TxBodyError (TxBody era))
-> TxBody era -> Either TxBodyError (TxBody era)
forall a b. (a -> b) -> a -> b
$
      SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [Script (SophieLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxScriptValidity era
-> TxBody era
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [Script (SophieLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxScriptValidity era
-> TxBody era
SophieTxBody SophieBasedEra era
era
        (Set (TxIn (Crypto (SophieMAEra 'Jen StandardCrypto)))
-> StrictSeq (TxOut (SophieMAEra 'Jen StandardCrypto))
-> StrictSeq (DCert (Crypto (SophieMAEra 'Jen StandardCrypto)))
-> Wdrl (Crypto (SophieMAEra 'Jen StandardCrypto))
-> Coin
-> ValidityInterval
-> StrictMaybe (Update (SophieMAEra 'Jen StandardCrypto))
-> StrictMaybe
     (AuxiliaryDataHash (Crypto (SophieMAEra 'Jen StandardCrypto)))
-> Value (SophieMAEra 'Jen StandardCrypto)
-> TxBody (SophieMAEra 'Jen StandardCrypto)
forall era.
FamsTo era =>
Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> Value era
-> TxBody era
Evie.TxBody
          ([TxIn StandardCrypto] -> Set (TxIn StandardCrypto)
forall a. Ord a => [a] -> Set a
Set.fromList (((TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
 -> TxIn StandardCrypto)
-> TxIns BuildTx era -> [TxIn StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn -> TxIn StandardCrypto
toSophieTxIn (TxIn -> TxIn StandardCrypto)
-> ((TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)) -> TxIn)
-> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
-> TxIn StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)) -> TxIn
forall a b. (a, b) -> a
fst) TxIns BuildTx era
txIns))
          ([TxOut (SophieMAEra 'Jen StandardCrypto)]
-> StrictSeq (TxOut (SophieMAEra 'Jen StandardCrypto))
forall a. [a] -> StrictSeq a
Seq.fromList ((TxOut era -> TxOut (SophieMAEra 'Jen StandardCrypto))
-> [TxOut era] -> [TxOut (SophieMAEra 'Jen StandardCrypto)]
forall a b. (a -> b) -> [a] -> [b]
map (SophieBasedEra era
-> TxOut era -> TxOut (SophieMAEra 'Jen StandardCrypto)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera) =>
SophieBasedEra era -> TxOut era -> TxOut ledgerera
toSophieTxOut SophieBasedEra era
era) [TxOut era]
txOuts))
          (case TxCertificates BuildTx era
txCertificates of
             TxCertificates BuildTx era
TxCertificatesNone    -> StrictSeq (DCert (Crypto (SophieMAEra 'Jen StandardCrypto)))
forall a. StrictSeq a
Seq.empty
             TxCertificates CertificatesSupportedInEra era
_ [Certificate]
cs BuildTxWith BuildTx (Map StakeCredential (Witness WitCtxStake era))
_ -> [DCert StandardCrypto] -> StrictSeq (DCert StandardCrypto)
forall a. [a] -> StrictSeq a
Seq.fromList ((Certificate -> DCert StandardCrypto)
-> [Certificate] -> [DCert StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map Certificate -> DCert StandardCrypto
toSophieCertificate [Certificate]
cs))
          (case TxWithdrawals BuildTx era
txWithdrawals of
             TxWithdrawals BuildTx era
TxWithdrawalsNone  -> Map (RewardAcnt StandardCrypto) Coin -> Wdrl StandardCrypto
forall crypto. Map (RewardAcnt crypto) Coin -> Wdrl crypto
Sophie.Wdrl Map (RewardAcnt StandardCrypto) Coin
forall k a. Map k a
Map.empty
             TxWithdrawals WithdrawalsSupportedInEra era
_ [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
ws -> [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
-> Wdrl StandardCrypto
forall a. [(StakeAddress, Entropic, a)] -> Wdrl StandardCrypto
toSophieWithdrawal [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
ws)
          (case TxFee era
txFee of
             TxFeeImplicit TxFeesImplicitInEra era
era'  -> case TxFeesImplicitInEra era
era' of {}
             TxFeeExplicit TxFeesExplicitInEra era
_ Entropic
fee -> Entropic -> Coin
toSophieEntropic Entropic
fee)
          (ValidityInterval :: StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
Evie.ValidityInterval {
             invalidBefore :: StrictMaybe SlotNo
invalidBefore    = case TxValidityLowerBound era
lowerBound of
                                          TxValidityLowerBound era
TxValidityNoLowerBound   -> StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing
                                          TxValidityLowerBound ValidityLowerBoundSupportedInEra era
_ SlotNo
s -> SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
s,
             invalidHereafter :: StrictMaybe SlotNo
invalidHereafter = case TxValidityUpperBound era
upperBound of
                                          TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra era
_ -> StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing
                                          TxValidityUpperBound ValidityUpperBoundSupportedInEra era
_ SlotNo
s -> SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
s
           })
          (case TxUpdateProposal era
txUpdateProposal of
             TxUpdateProposal era
TxUpdateProposalNone -> StrictMaybe (Update (SophieMAEra 'Jen StandardCrypto))
forall a. StrictMaybe a
SNothing
             TxUpdateProposal UpdateProposalSupportedInEra era
_ UpdateProposal
p -> Update (SophieMAEra 'Jen StandardCrypto)
-> StrictMaybe (Update (SophieMAEra 'Jen StandardCrypto))
forall a. a -> StrictMaybe a
SJust (SophieBasedEra era
-> UpdateProposal -> Update (SophieMAEra 'Jen StandardCrypto)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 Crypto ledgerera ~ StandardCrypto) =>
SophieBasedEra era -> UpdateProposal -> Update ledgerera
toLedgerUpdate SophieBasedEra era
era UpdateProposal
p))
          (Maybe (AuxiliaryDataHash StandardCrypto)
-> StrictMaybe (AuxiliaryDataHash StandardCrypto)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe
            (AuxiliaryData (SophieMAEra 'Jen StandardCrypto)
-> AuxiliaryDataHash StandardCrypto
forall era c.
ValidateAuxiliaryData era c =>
AuxiliaryData era -> AuxiliaryDataHash c
Ledger.hashAuxiliaryData (AuxiliaryData (SophieMAEra 'Jen StandardCrypto)
 -> AuxiliaryDataHash StandardCrypto)
-> Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto))
-> Maybe (AuxiliaryDataHash StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto))
Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto))
txAuxData))
          (case TxMintValue BuildTx era
txMintValue of
             TxMintValue BuildTx era
TxMintNone        -> Value (SophieMAEra 'Jen StandardCrypto)
forall a. Monoid a => a
mempty
             TxMintValue MultiAssetSupportedInEra era
_ Value
v BuildTxWith BuildTx (Map PolicyId (ScriptWitness WitCtxMint era))
_ -> Value -> Value StandardCrypto
toJenValue Value
v))
        [Script (SophieMAEra 'Jen StandardCrypto)]
[Script (SophieLedgerEra era)]
scripts
        TxBodyScriptData era
forall era. TxBodyScriptData era
TxBodyNoScriptData
        Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txAuxData
        TxScriptValidity era
forall era. TxScriptValidity era
TxScriptValidityNone
  where
    scripts :: [Ledger.Script StandardJen]
    scripts :: [Script (SophieMAEra 'Jen StandardCrypto)]
scripts =
      [ ScriptInEra era -> Script (SophieLedgerEra era)
forall era. ScriptInEra era -> Script (SophieLedgerEra era)
toSophieScript (ScriptWitness witctx era -> ScriptInEra era
forall witctx era. ScriptWitness witctx era -> ScriptInEra era
scriptWitnessScript ScriptWitness witctx era
scriptwitness)
      | (ScriptWitnessIndex
_, AnyScriptWitness ScriptWitness witctx era
scriptwitness)
          <- TxBodyContent BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
forall era.
TxBodyContent BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
collectTxBodyScriptWitnesses TxBodyContent BuildTx era
txbodycontent
      ]

    txAuxData :: Maybe (Ledger.AuxiliaryData StandardJen)
    txAuxData :: Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto))
txAuxData
      | Map Word64 TxMetadataValue -> Bool
forall k a. Map k a -> Bool
Map.null Map Word64 TxMetadataValue
ms
      , [ScriptInEra era] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ScriptInEra era]
ss   = Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto))
forall a. Maybe a
Nothing
      | Bool
otherwise = AuxiliaryData (SophieMAEra 'Jen StandardCrypto)
-> Maybe (AuxiliaryData (SophieMAEra 'Jen StandardCrypto))
forall a. a -> Maybe a
Just (Map Word64 TxMetadataValue
-> [ScriptInEra era]
-> AuxiliaryData (SophieMAEra 'Jen StandardCrypto)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 AuxiliaryData ledgerera ~ AuxiliaryData ledgerera,
 AnnotatedData (Script ledgerera), Ord (Script ledgerera)) =>
Map Word64 TxMetadataValue
-> [ScriptInEra era] -> AuxiliaryData ledgerera
toEvieAuxiliaryData Map Word64 TxMetadataValue
ms [ScriptInEra era]
ss)
      where
        ms :: Map Word64 TxMetadataValue
ms = case TxMetadataInEra era
txMetadata of
               TxMetadataInEra era
TxMetadataNone                     -> Map Word64 TxMetadataValue
forall k a. Map k a
Map.empty
               TxMetadataInEra TxMetadataSupportedInEra era
_ (TxMetadata Map Word64 TxMetadataValue
ms') -> Map Word64 TxMetadataValue
ms'
        ss :: [ScriptInEra era]
ss = case TxAuxScripts era
txAuxScripts of
               TxAuxScripts era
TxAuxScriptsNone   -> []
               TxAuxScripts AuxScriptsSupportedInEra era
_ [ScriptInEra era]
ss' -> [ScriptInEra era]
ss'

makeSophieTransactionBody era :: SophieBasedEra era
era@SophieBasedEra era
SophieBasedEraAurum
                           txbodycontent :: TxBodyContent BuildTx era
txbodycontent@TxBodyContent {
                             TxIns BuildTx era
txIns :: TxIns BuildTx era
txIns :: forall build era. TxBodyContent build era -> TxIns build era
txIns,
                             TxInsCollateral era
txInsCollateral :: TxInsCollateral era
txInsCollateral :: forall build era. TxBodyContent build era -> TxInsCollateral era
txInsCollateral,
                             [TxOut era]
txOuts :: [TxOut era]
txOuts :: forall build era. TxBodyContent build era -> [TxOut era]
txOuts,
                             TxFee era
txFee :: TxFee era
txFee :: forall build era. TxBodyContent build era -> TxFee era
txFee,
                             txValidityRange :: forall build era.
TxBodyContent build era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
txValidityRange = (TxValidityLowerBound era
lowerBound, TxValidityUpperBound era
upperBound),
                             TxMetadataInEra era
txMetadata :: TxMetadataInEra era
txMetadata :: forall build era. TxBodyContent build era -> TxMetadataInEra era
txMetadata,
                             TxAuxScripts era
txAuxScripts :: TxAuxScripts era
txAuxScripts :: forall build era. TxBodyContent build era -> TxAuxScripts era
txAuxScripts,
                             BuildTxWith BuildTx (TxExtraScriptData era)
txExtraScriptData :: BuildTxWith BuildTx (TxExtraScriptData era)
txExtraScriptData :: forall build era.
TxBodyContent build era
-> BuildTxWith build (TxExtraScriptData era)
txExtraScriptData,
                             TxExtraKeyWitnesses era
txExtraKeyWits :: TxExtraKeyWitnesses era
txExtraKeyWits :: forall build era.
TxBodyContent build era -> TxExtraKeyWitnesses era
txExtraKeyWits,
                             BuildTxWith BuildTx (Maybe ProtocolParameters)
txProtocolParams :: BuildTxWith BuildTx (Maybe ProtocolParameters)
txProtocolParams :: forall build era.
TxBodyContent build era
-> BuildTxWith build (Maybe ProtocolParameters)
txProtocolParams,
                             TxWithdrawals BuildTx era
txWithdrawals :: TxWithdrawals BuildTx era
txWithdrawals :: forall build era.
TxBodyContent build era -> TxWithdrawals build era
txWithdrawals,
                             TxCertificates BuildTx era
txCertificates :: TxCertificates BuildTx era
txCertificates :: forall build era.
TxBodyContent build era -> TxCertificates build era
txCertificates,
                             TxUpdateProposal era
txUpdateProposal :: TxUpdateProposal era
txUpdateProposal :: forall build era. TxBodyContent build era -> TxUpdateProposal era
txUpdateProposal,
                             TxMintValue BuildTx era
txMintValue :: TxMintValue BuildTx era
txMintValue :: forall build era. TxBodyContent build era -> TxMintValue build era
txMintValue,
                             TxScriptValidity era
txScriptValidity :: TxScriptValidity era
txScriptValidity :: forall build era. TxBodyContent build era -> TxScriptValidity era
txScriptValidity
                           } = do

    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (TxIns BuildTx era -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null TxIns BuildTx era
txIns)) Maybe () -> TxBodyError -> Either TxBodyError ()
forall a e. Maybe a -> e -> Either e a
?! TxBodyError
TxBodyEmptyTxIns
    [Either TxBodyError ()] -> Either TxBodyError ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [ do Either TxBodyError ()
allPositive
           Either TxBodyError ()
allWithinMaxBound
      | let maxTxOut :: Quantity
maxTxOut = Word64 -> Quantity
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64) :: Quantity
      , txout :: TxOut era
txout@(TxOut AddressInEra era
_ (TxOutValue MultiAssetSupportedInEra era
MultiAssetInAurumEra Value
v) TxOutDatumHash era
_) <- [TxOut era]
txOuts
      , let allPositive :: Either TxBodyError ()
allPositive =
              case [ Quantity
q | (AssetId
_,Quantity
q) <- Value -> [(AssetId, Quantity)]
valueToList Value
v, Quantity
q Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
< Quantity
0 ] of
                []  -> () -> Either TxBodyError ()
forall a b. b -> Either a b
Right ()
                Quantity
q:[Quantity]
_ -> TxBodyError -> Either TxBodyError ()
forall a b. a -> Either a b
Left (Quantity -> TxOutInAnyEra -> TxBodyError
TxBodyOutputNegative Quantity
q (TxOut era -> TxOutInAnyEra
forall era. IsBccEra era => TxOut era -> TxOutInAnyEra
txOutInAnyEra TxOut era
txout))
            allWithinMaxBound :: Either TxBodyError ()
allWithinMaxBound =
              case [ Quantity
q | (AssetId
_,Quantity
q) <- Value -> [(AssetId, Quantity)]
valueToList Value
v, Quantity
q Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
> Quantity
maxTxOut ] of
                []  -> () -> Either TxBodyError ()
forall a b. b -> Either a b
Right ()
                Quantity
q:[Quantity]
_ -> TxBodyError -> Either TxBodyError ()
forall a b. a -> Either a b
Left (Quantity -> TxOutInAnyEra -> TxBodyError
TxBodyOutputOverflow Quantity
q (TxOut era -> TxOutInAnyEra
forall era. IsBccEra era => TxOut era -> TxOutInAnyEra
txOutInAnyEra TxOut era
txout))
      ]
    case TxMetadataInEra era
txMetadata of
      TxMetadataInEra era
TxMetadataNone      -> () -> Either TxBodyError ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      TxMetadataInEra TxMetadataSupportedInEra era
_ TxMetadata
m -> TxMetadata -> Either [(Word64, TxMetadataRangeError)] ()
validateTxMetadata TxMetadata
m Either [(Word64, TxMetadataRangeError)] ()
-> ([(Word64, TxMetadataRangeError)] -> TxBodyError)
-> Either TxBodyError ()
forall e a e'. Either e a -> (e -> e') -> Either e' a
?!. [(Word64, TxMetadataRangeError)] -> TxBodyError
TxBodyMetadataError
    case TxMintValue BuildTx era
txMintValue of
      TxMintValue BuildTx era
TxMintNone        -> () -> Either TxBodyError ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      TxMintValue MultiAssetSupportedInEra era
_ Value
v BuildTxWith BuildTx (Map PolicyId (ScriptWitness WitCtxMint era))
_ -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Value -> Entropic
selectEntropic Value
v Entropic -> Entropic -> Bool
forall a. Eq a => a -> a -> Bool
== Entropic
0) Maybe () -> TxBodyError -> Either TxBodyError ()
forall a e. Maybe a -> e -> Either e a
?! TxBodyError
TxBodyMintBccError
    case TxInsCollateral era
txInsCollateral of
      TxInsCollateral era
TxInsCollateralNone | Bool -> Bool
not (Set Language -> Bool
forall a. Set a -> Bool
Set.null Set Language
languages)
        -> TxBodyError -> Either TxBodyError ()
forall a b. a -> Either a b
Left TxBodyError
TxBodyEmptyTxInsCollateral
      TxInsCollateral era
_ -> () -> Either TxBodyError ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case BuildTxWith BuildTx (Maybe ProtocolParameters)
txProtocolParams of
      BuildTxWith Maybe ProtocolParameters
Nothing | Bool -> Bool
not (Set Language -> Bool
forall a. Set a -> Bool
Set.null Set Language
languages)
        -> TxBodyError -> Either TxBodyError ()
forall a b. a -> Either a b
Left TxBodyError
TxBodyMissingProtocolParams
      BuildTxWith BuildTx (Maybe ProtocolParameters)
_ -> () -> Either TxBodyError ()
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO aurum: validate protocol params for the Aurum era.
                     --             All the necessary params must be provided.

    TxBody era -> Either TxBodyError (TxBody era)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxBody era -> Either TxBodyError (TxBody era))
-> TxBody era -> Either TxBodyError (TxBody era)
forall a b. (a -> b) -> a -> b
$
      SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [Script (SophieLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxScriptValidity era
-> TxBody era
forall era.
SophieBasedEra era
-> TxBody (SophieLedgerEra era)
-> [Script (SophieLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (SophieLedgerEra era))
-> TxScriptValidity era
-> TxBody era
SophieTxBody SophieBasedEra era
era
        (Set (TxIn (Crypto (AurumEra StandardCrypto)))
-> Set (TxIn (Crypto (AurumEra StandardCrypto)))
-> StrictSeq (TxOut (AurumEra StandardCrypto))
-> StrictSeq (DCert (Crypto (AurumEra StandardCrypto)))
-> Wdrl (Crypto (AurumEra StandardCrypto))
-> Coin
-> ValidityInterval
-> StrictMaybe (Update (AurumEra StandardCrypto))
-> Set (KeyHash 'Witness (Crypto (AurumEra StandardCrypto)))
-> Value (Crypto (AurumEra StandardCrypto))
-> StrictMaybe
     (ScriptIntegrityHash (Crypto (AurumEra StandardCrypto)))
-> StrictMaybe
     (AuxiliaryDataHash (Crypto (AurumEra StandardCrypto)))
-> StrictMaybe Network
-> TxBody (AurumEra StandardCrypto)
forall era.
AurumBody era =>
Set (TxIn (Crypto era))
-> Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> ValidityInterval
-> StrictMaybe (Update era)
-> Set (KeyHash 'Witness (Crypto era))
-> Value (Crypto era)
-> StrictMaybe (ScriptIntegrityHash (Crypto era))
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> StrictMaybe Network
-> TxBody era
Aurum.TxBody
          ([TxIn StandardCrypto] -> Set (TxIn StandardCrypto)
forall a. Ord a => [a] -> Set a
Set.fromList (((TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
 -> TxIn StandardCrypto)
-> TxIns BuildTx era -> [TxIn StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn -> TxIn StandardCrypto
toSophieTxIn (TxIn -> TxIn StandardCrypto)
-> ((TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)) -> TxIn)
-> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
-> TxIn StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)) -> TxIn
forall a b. (a, b) -> a
fst) TxIns BuildTx era
txIns))
          (case TxInsCollateral era
txInsCollateral of
             TxInsCollateral era
TxInsCollateralNone     -> Set (TxIn (Crypto (AurumEra StandardCrypto)))
forall a. Set a
Set.empty
             TxInsCollateral CollateralSupportedInEra era
_ [TxIn]
txins -> [TxIn StandardCrypto] -> Set (TxIn StandardCrypto)
forall a. Ord a => [a] -> Set a
Set.fromList ((TxIn -> TxIn StandardCrypto) -> [TxIn] -> [TxIn StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> TxIn StandardCrypto
toSophieTxIn [TxIn]
txins))
          ([TxOut (AurumEra StandardCrypto)]
-> StrictSeq (TxOut (AurumEra StandardCrypto))
forall a. [a] -> StrictSeq a
Seq.fromList ((TxOut era -> TxOut (AurumEra StandardCrypto))
-> [TxOut era] -> [TxOut (AurumEra StandardCrypto)]
forall a b. (a -> b) -> [a] -> [b]
map (SophieBasedEra era -> TxOut era -> TxOut (AurumEra StandardCrypto)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera) =>
SophieBasedEra era -> TxOut era -> TxOut ledgerera
toSophieTxOut SophieBasedEra era
era) [TxOut era]
txOuts))
          (case TxCertificates BuildTx era
txCertificates of
             TxCertificates BuildTx era
TxCertificatesNone    -> StrictSeq (DCert (Crypto (AurumEra StandardCrypto)))
forall a. StrictSeq a
Seq.empty
             TxCertificates CertificatesSupportedInEra era
_ [Certificate]
cs BuildTxWith BuildTx (Map StakeCredential (Witness WitCtxStake era))
_ -> [DCert StandardCrypto] -> StrictSeq (DCert StandardCrypto)
forall a. [a] -> StrictSeq a
Seq.fromList ((Certificate -> DCert StandardCrypto)
-> [Certificate] -> [DCert StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map Certificate -> DCert StandardCrypto
toSophieCertificate [Certificate]
cs))
          (case TxWithdrawals BuildTx era
txWithdrawals of
             TxWithdrawals BuildTx era
TxWithdrawalsNone  -> Map (RewardAcnt StandardCrypto) Coin -> Wdrl StandardCrypto
forall crypto. Map (RewardAcnt crypto) Coin -> Wdrl crypto
Sophie.Wdrl Map (RewardAcnt StandardCrypto) Coin
forall k a. Map k a
Map.empty
             TxWithdrawals WithdrawalsSupportedInEra era
_ [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
ws -> [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
-> Wdrl StandardCrypto
forall a. [(StakeAddress, Entropic, a)] -> Wdrl StandardCrypto
toSophieWithdrawal [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
ws)
          (case TxFee era
txFee of
             TxFeeImplicit TxFeesImplicitInEra era
era'  -> case TxFeesImplicitInEra era
era' of {}
             TxFeeExplicit TxFeesExplicitInEra era
_ Entropic
fee -> Entropic -> Coin
toSophieEntropic Entropic
fee)
          (ValidityInterval :: StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
Evie.ValidityInterval {
             invalidBefore :: StrictMaybe SlotNo
invalidBefore    = case TxValidityLowerBound era
lowerBound of
                                          TxValidityLowerBound era
TxValidityNoLowerBound   -> StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing
                                          TxValidityLowerBound ValidityLowerBoundSupportedInEra era
_ SlotNo
s -> SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
s,
             invalidHereafter :: StrictMaybe SlotNo
invalidHereafter = case TxValidityUpperBound era
upperBound of
                                          TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra era
_ -> StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing
                                          TxValidityUpperBound ValidityUpperBoundSupportedInEra era
_ SlotNo
s -> SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
s
           })
          (case TxUpdateProposal era
txUpdateProposal of
             TxUpdateProposal era
TxUpdateProposalNone -> StrictMaybe (Update (AurumEra StandardCrypto))
forall a. StrictMaybe a
SNothing
             TxUpdateProposal UpdateProposalSupportedInEra era
_ UpdateProposal
p -> Update (AurumEra StandardCrypto)
-> StrictMaybe (Update (AurumEra StandardCrypto))
forall a. a -> StrictMaybe a
SJust (SophieBasedEra era
-> UpdateProposal -> Update (AurumEra StandardCrypto)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 Crypto ledgerera ~ StandardCrypto) =>
SophieBasedEra era -> UpdateProposal -> Update ledgerera
toLedgerUpdate SophieBasedEra era
era UpdateProposal
p))
          (case TxExtraKeyWitnesses era
txExtraKeyWits of
             TxExtraKeyWitnesses era
TxExtraKeyWitnessesNone   -> Set (KeyHash 'Witness (Crypto (AurumEra StandardCrypto)))
forall a. Set a
Set.empty
             TxExtraKeyWitnesses TxExtraKeyWitnessesSupportedInEra era
_ [Hash PaymentKey]
khs -> [KeyHash 'Witness StandardCrypto]
-> Set (KeyHash 'Witness StandardCrypto)
forall a. Ord a => [a] -> Set a
Set.fromList
                                            [ KeyHash 'Payment StandardCrypto -> KeyHash 'Witness StandardCrypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto
       (r' :: KeyRole).
HasKeyRole a =>
a r crypto -> a r' crypto
Sophie.coerceKeyRole KeyHash 'Payment StandardCrypto
kh
                                            | PaymentKeyHash kh <- [Hash PaymentKey]
khs ])
          (case TxMintValue BuildTx era
txMintValue of
             TxMintValue BuildTx era
TxMintNone        -> Value (Crypto (AurumEra StandardCrypto))
forall a. Monoid a => a
mempty
             TxMintValue MultiAssetSupportedInEra era
_ Value
v BuildTxWith BuildTx (Map PolicyId (ScriptWitness WitCtxMint era))
_ -> Value -> Value StandardCrypto
toJenValue Value
v)
          (case BuildTxWith BuildTx (Maybe ProtocolParameters)
txProtocolParams of
             BuildTxWith Maybe ProtocolParameters
Nothing        -> StrictMaybe
  (ScriptIntegrityHash (Crypto (AurumEra StandardCrypto)))
forall a. StrictMaybe a
SNothing
             BuildTxWith (Just ProtocolParameters
pparams) ->
               PParams (AurumEra StandardCrypto)
-> Set Language
-> Redeemers (AurumEra StandardCrypto)
-> TxDats (AurumEra StandardCrypto)
-> StrictMaybe
     (ScriptIntegrityHash (Crypto (AurumEra StandardCrypto)))
forall era.
Era era =>
PParams era
-> Set Language
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (Crypto era))
Aurum.hashScriptIntegrity
                 (SophieBasedEra AurumEra
-> ProtocolParameters -> PParams (SophieLedgerEra AurumEra)
forall era.
SophieBasedEra era
-> ProtocolParameters -> PParams (SophieLedgerEra era)
toLedgerPParams SophieBasedEra AurumEra
SophieBasedEraAurum ProtocolParameters
pparams)
                 Set Language
languages
                 Redeemers (AurumEra StandardCrypto)
redeemers
                 TxDats (AurumEra StandardCrypto)
datums)
          (Maybe (AuxiliaryDataHash StandardCrypto)
-> StrictMaybe (AuxiliaryDataHash StandardCrypto)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe
            (AuxiliaryData (AurumEra StandardCrypto)
-> AuxiliaryDataHash StandardCrypto
forall era c.
ValidateAuxiliaryData era c =>
AuxiliaryData era -> AuxiliaryDataHash c
Ledger.hashAuxiliaryData (AuxiliaryData (AurumEra StandardCrypto)
 -> AuxiliaryDataHash StandardCrypto)
-> Maybe (AuxiliaryData (AurumEra StandardCrypto))
-> Maybe (AuxiliaryDataHash StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AuxiliaryData (AurumEra StandardCrypto))
Maybe (AuxiliaryData (AurumEra StandardCrypto))
txAuxData))
          StrictMaybe Network
forall a. StrictMaybe a
SNothing) -- TODO aurum: support optional network id in TxBodyContent
        [Script (AurumEra StandardCrypto)]
[Script (SophieLedgerEra era)]
scripts
        (ScriptDataSupportedInEra AurumEra
-> TxDats (SophieLedgerEra AurumEra)
-> Redeemers (SophieLedgerEra AurumEra)
-> TxBodyScriptData AurumEra
forall era.
ScriptDataSupportedInEra era
-> TxDats (SophieLedgerEra era)
-> Redeemers (SophieLedgerEra era)
-> TxBodyScriptData era
TxBodyScriptData ScriptDataSupportedInEra AurumEra
ScriptDataInAurumEra TxDats (AurumEra StandardCrypto)
TxDats (SophieLedgerEra AurumEra)
datums Redeemers (AurumEra StandardCrypto)
Redeemers (SophieLedgerEra AurumEra)
redeemers)
        Maybe (AuxiliaryData (AurumEra StandardCrypto))
Maybe (AuxiliaryData (SophieLedgerEra era))
txAuxData
        TxScriptValidity era
txScriptValidity
  where
    witnesses :: [(ScriptWitnessIndex, AnyScriptWitness AurumEra)]
    witnesses :: [(ScriptWitnessIndex, AnyScriptWitness AurumEra)]
witnesses = TxBodyContent BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
forall era.
TxBodyContent BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
collectTxBodyScriptWitnesses TxBodyContent BuildTx era
txbodycontent

    scripts :: [Ledger.Script StandardAurum]
    scripts :: [Script (AurumEra StandardCrypto)]
scripts =
      [ ScriptInEra AurumEra -> Script (SophieLedgerEra AurumEra)
forall era. ScriptInEra era -> Script (SophieLedgerEra era)
toSophieScript (ScriptWitness witctx AurumEra -> ScriptInEra AurumEra
forall witctx era. ScriptWitness witctx era -> ScriptInEra era
scriptWitnessScript ScriptWitness witctx AurumEra
scriptwitness)
      | (ScriptWitnessIndex
_, AnyScriptWitness ScriptWitness witctx AurumEra
scriptwitness) <- [(ScriptWitnessIndex, AnyScriptWitness AurumEra)]
witnesses
      ]

    datums :: Aurum.TxDats StandardAurum
    datums :: TxDats (AurumEra StandardCrypto)
datums =
      Map
  (DataHash (Crypto (AurumEra StandardCrypto)))
  (Data (AurumEra StandardCrypto))
-> TxDats (AurumEra StandardCrypto)
forall era.
Typeable era =>
Map (DataHash (Crypto era)) (Data era) -> TxDats era
Aurum.TxDats (Map
   (DataHash (Crypto (AurumEra StandardCrypto)))
   (Data (AurumEra StandardCrypto))
 -> TxDats (AurumEra StandardCrypto))
-> Map
     (DataHash (Crypto (AurumEra StandardCrypto)))
     (Data (AurumEra StandardCrypto))
-> TxDats (AurumEra StandardCrypto)
forall a b. (a -> b) -> a -> b
$
        [(DataHash StandardCrypto, Data (AurumEra StandardCrypto))]
-> Map (DataHash StandardCrypto) (Data (AurumEra StandardCrypto))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (Data (AurumEra StandardCrypto)
-> DataHash (Crypto (AurumEra StandardCrypto))
forall era. Era era => Data era -> DataHash (Crypto era)
Aurum.hashData Data (AurumEra StandardCrypto)
d', Data (AurumEra StandardCrypto)
d')
          | ScriptData
d <- [ScriptData]
scriptdata
          , let d' :: Data (AurumEra StandardCrypto)
d' = ScriptData -> Data (AurumEra StandardCrypto)
forall ledgerera. ScriptData -> Data ledgerera
toAurumData ScriptData
d
          ]

    scriptdata :: [ScriptData]
    scriptdata :: [ScriptData]
scriptdata =
        [ ScriptData
d | BuildTxWith (TxExtraScriptData ScriptDataSupportedInEra era
_ [ScriptData]
ds) <- [BuildTxWith BuildTx (TxExtraScriptData era)
txExtraScriptData], ScriptData
d <- [ScriptData]
ds ]
     [ScriptData] -> [ScriptData] -> [ScriptData]
forall a. [a] -> [a] -> [a]
++ [ ScriptData
d | (ScriptWitnessIndex
_, AnyScriptWitness
                    (ZerepochScriptWitness
                       ScriptLanguageInEra lang AurumEra
_ ZerepochScriptVersion lang
_ ZerepochScript lang
_ (ScriptDatumForTxIn ScriptData
d) ScriptData
_ ExecutionUnits
_)) <- [(ScriptWitnessIndex, AnyScriptWitness AurumEra)]
witnesses
            ]

    redeemers :: Aurum.Redeemers StandardAurum
    redeemers :: Redeemers (AurumEra StandardCrypto)
redeemers =
      Map RdmrPtr (Data (AurumEra StandardCrypto), ExUnits)
-> Redeemers (AurumEra StandardCrypto)
forall era.
Era era =>
Map RdmrPtr (Data era, ExUnits) -> Redeemers era
Aurum.Redeemers (Map RdmrPtr (Data (AurumEra StandardCrypto), ExUnits)
 -> Redeemers (AurumEra StandardCrypto))
-> Map RdmrPtr (Data (AurumEra StandardCrypto), ExUnits)
-> Redeemers (AurumEra StandardCrypto)
forall a b. (a -> b) -> a -> b
$
        [(RdmrPtr, (Data (AurumEra StandardCrypto), ExUnits))]
-> Map RdmrPtr (Data (AurumEra StandardCrypto), ExUnits)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (ScriptWitnessIndex -> RdmrPtr
toAurumRdmrPtr ScriptWitnessIndex
idx, (ScriptData -> Data (AurumEra StandardCrypto)
forall ledgerera. ScriptData -> Data ledgerera
toAurumData ScriptData
d, ExecutionUnits -> ExUnits
toAurumExUnits ExecutionUnits
e))
          | (ScriptWitnessIndex
idx, AnyScriptWitness
                    (ZerepochScriptWitness ScriptLanguageInEra lang AurumEra
_ ZerepochScriptVersion lang
_ ZerepochScript lang
_ ScriptDatum witctx
_ ScriptData
d ExecutionUnits
e)) <- [(ScriptWitnessIndex, AnyScriptWitness AurumEra)]
witnesses
          ]

    languages :: Set Aurum.Language
    languages :: Set Language
languages =
      [Language] -> Set Language
forall a. Ord a => [a] -> Set a
Set.fromList
        [ AnyZerepochScriptVersion -> Language
toAurumLanguage (ZerepochScriptVersion lang -> AnyZerepochScriptVersion
forall lang. ZerepochScriptVersion lang -> AnyZerepochScriptVersion
AnyZerepochScriptVersion ZerepochScriptVersion lang
v)
        | (ScriptWitnessIndex
_, AnyScriptWitness (ZerepochScriptWitness ScriptLanguageInEra lang AurumEra
_ ZerepochScriptVersion lang
v ZerepochScript lang
_ ScriptDatum witctx
_ ScriptData
_ ExecutionUnits
_)) <- [(ScriptWitnessIndex, AnyScriptWitness AurumEra)]
witnesses
        ]

    txAuxData :: Maybe (Ledger.AuxiliaryData StandardAurum)
    txAuxData :: Maybe (AuxiliaryData (AurumEra StandardCrypto))
txAuxData
      | Map Word64 TxMetadataValue -> Bool
forall k a. Map k a -> Bool
Map.null Map Word64 TxMetadataValue
ms
      , [ScriptInEra era] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ScriptInEra era]
ss   = Maybe (AuxiliaryData (AurumEra StandardCrypto))
forall a. Maybe a
Nothing
      | Bool
otherwise = AuxiliaryData (AurumEra StandardCrypto)
-> Maybe (AuxiliaryData (AurumEra StandardCrypto))
forall a. a -> Maybe a
Just (Map Word64 TxMetadataValue
-> [ScriptInEra era] -> AuxiliaryData (AurumEra StandardCrypto)
forall era ledgerera.
(SophieLedgerEra era ~ ledgerera,
 AuxiliaryData ledgerera ~ AuxiliaryData ledgerera,
 Script ledgerera ~ Script ledgerera, Era ledgerera) =>
Map Word64 TxMetadataValue
-> [ScriptInEra era] -> AuxiliaryData ledgerera
toAurumAuxiliaryData Map Word64 TxMetadataValue
ms [ScriptInEra era]
ss)
      where
        ms :: Map Word64 TxMetadataValue
ms = case TxMetadataInEra era
txMetadata of
               TxMetadataInEra era
TxMetadataNone                     -> Map Word64 TxMetadataValue
forall k a. Map k a
Map.empty
               TxMetadataInEra TxMetadataSupportedInEra era
_ (TxMetadata Map Word64 TxMetadataValue
ms') -> Map Word64 TxMetadataValue
ms'
        ss :: [ScriptInEra era]
ss = case TxAuxScripts era
txAuxScripts of
               TxAuxScripts era
TxAuxScriptsNone   -> []
               TxAuxScripts AuxScriptsSupportedInEra era
_ [ScriptInEra era]
ss' -> [ScriptInEra era]
ss'


-- ----------------------------------------------------------------------------
-- Script witnesses within the tx body
--

-- | A 'ScriptWitness' in any 'WitCtx'. This lets us handle heterogeneous
-- collections of script witnesses from multiple contexts.
--
data AnyScriptWitness era where
     AnyScriptWitness :: ScriptWitness witctx era -> AnyScriptWitness era

-- | Identify the location of a 'ScriptWitness' within the context of a
-- 'TxBody'. These are indexes of the objects within the transaction that
-- need or can use script witnesses: inputs, minted assets, withdrawals and
-- certificates. These are simple numeric indices, enumerated from zero.
-- Thus the indices are not stable if the transaction body is modified.
--
data ScriptWitnessIndex =

     -- | The n'th transaction input, in the order of the 'TxId's.
     ScriptWitnessIndexTxIn !Word

     -- | The n'th minting 'PolicyId', in the order of the 'PolicyId's.
   | ScriptWitnessIndexMint !Word

     -- | The n'th certificate, in the list order of the certificates.
   | ScriptWitnessIndexCertificate !Word

     -- | The n'th withdrawal, in the order of the 'StakeAddress's.
   | ScriptWitnessIndexWithdrawal !Word
  deriving (ScriptWitnessIndex -> ScriptWitnessIndex -> Bool
(ScriptWitnessIndex -> ScriptWitnessIndex -> Bool)
-> (ScriptWitnessIndex -> ScriptWitnessIndex -> Bool)
-> Eq ScriptWitnessIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptWitnessIndex -> ScriptWitnessIndex -> Bool
$c/= :: ScriptWitnessIndex -> ScriptWitnessIndex -> Bool
== :: ScriptWitnessIndex -> ScriptWitnessIndex -> Bool
$c== :: ScriptWitnessIndex -> ScriptWitnessIndex -> Bool
Eq, Eq ScriptWitnessIndex
Eq ScriptWitnessIndex
-> (ScriptWitnessIndex -> ScriptWitnessIndex -> Ordering)
-> (ScriptWitnessIndex -> ScriptWitnessIndex -> Bool)
-> (ScriptWitnessIndex -> ScriptWitnessIndex -> Bool)
-> (ScriptWitnessIndex -> ScriptWitnessIndex -> Bool)
-> (ScriptWitnessIndex -> ScriptWitnessIndex -> Bool)
-> (ScriptWitnessIndex -> ScriptWitnessIndex -> ScriptWitnessIndex)
-> (ScriptWitnessIndex -> ScriptWitnessIndex -> ScriptWitnessIndex)
-> Ord ScriptWitnessIndex
ScriptWitnessIndex -> ScriptWitnessIndex -> Bool
ScriptWitnessIndex -> ScriptWitnessIndex -> Ordering
ScriptWitnessIndex -> ScriptWitnessIndex -> ScriptWitnessIndex
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScriptWitnessIndex -> ScriptWitnessIndex -> ScriptWitnessIndex
$cmin :: ScriptWitnessIndex -> ScriptWitnessIndex -> ScriptWitnessIndex
max :: ScriptWitnessIndex -> ScriptWitnessIndex -> ScriptWitnessIndex
$cmax :: ScriptWitnessIndex -> ScriptWitnessIndex -> ScriptWitnessIndex
>= :: ScriptWitnessIndex -> ScriptWitnessIndex -> Bool
$c>= :: ScriptWitnessIndex -> ScriptWitnessIndex -> Bool
> :: ScriptWitnessIndex -> ScriptWitnessIndex -> Bool
$c> :: ScriptWitnessIndex -> ScriptWitnessIndex -> Bool
<= :: ScriptWitnessIndex -> ScriptWitnessIndex -> Bool
$c<= :: ScriptWitnessIndex -> ScriptWitnessIndex -> Bool
< :: ScriptWitnessIndex -> ScriptWitnessIndex -> Bool
$c< :: ScriptWitnessIndex -> ScriptWitnessIndex -> Bool
compare :: ScriptWitnessIndex -> ScriptWitnessIndex -> Ordering
$ccompare :: ScriptWitnessIndex -> ScriptWitnessIndex -> Ordering
$cp1Ord :: Eq ScriptWitnessIndex
Ord, Int -> ScriptWitnessIndex -> ShowS
[ScriptWitnessIndex] -> ShowS
ScriptWitnessIndex -> String
(Int -> ScriptWitnessIndex -> ShowS)
-> (ScriptWitnessIndex -> String)
-> ([ScriptWitnessIndex] -> ShowS)
-> Show ScriptWitnessIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptWitnessIndex] -> ShowS
$cshowList :: [ScriptWitnessIndex] -> ShowS
show :: ScriptWitnessIndex -> String
$cshow :: ScriptWitnessIndex -> String
showsPrec :: Int -> ScriptWitnessIndex -> ShowS
$cshowsPrec :: Int -> ScriptWitnessIndex -> ShowS
Show)

renderScriptWitnessIndex :: ScriptWitnessIndex -> String
renderScriptWitnessIndex :: ScriptWitnessIndex -> String
renderScriptWitnessIndex (ScriptWitnessIndexTxIn Word
index) =
  String
"transaction input " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
index String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (in the order of the TxIds)"
renderScriptWitnessIndex (ScriptWitnessIndexMint Word
index) =
  String
"policyId " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
index String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (in the order of the PolicyIds)"
renderScriptWitnessIndex (ScriptWitnessIndexCertificate Word
index) =
  String
"certificate " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
index String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (in the list order of the certificates)"
renderScriptWitnessIndex (ScriptWitnessIndexWithdrawal Word
index) =
  String
"withdrawal " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
index String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (in the order of the StakeAddresses)"

toAurumRdmrPtr :: ScriptWitnessIndex -> Aurum.RdmrPtr
toAurumRdmrPtr :: ScriptWitnessIndex -> RdmrPtr
toAurumRdmrPtr ScriptWitnessIndex
widx =
    case ScriptWitnessIndex
widx of
      ScriptWitnessIndexTxIn        Word
n -> Tag -> Word64 -> RdmrPtr
Aurum.RdmrPtr Tag
Aurum.Spend (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)
      ScriptWitnessIndexMint        Word
n -> Tag -> Word64 -> RdmrPtr
Aurum.RdmrPtr Tag
Aurum.Mint  (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)
      ScriptWitnessIndexCertificate Word
n -> Tag -> Word64 -> RdmrPtr
Aurum.RdmrPtr Tag
Aurum.Cert  (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)
      ScriptWitnessIndexWithdrawal  Word
n -> Tag -> Word64 -> RdmrPtr
Aurum.RdmrPtr Tag
Aurum.Rewrd (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)

fromAurumRdmrPtr :: Aurum.RdmrPtr -> ScriptWitnessIndex
fromAurumRdmrPtr :: RdmrPtr -> ScriptWitnessIndex
fromAurumRdmrPtr (Aurum.RdmrPtr Tag
tag Word64
n) =
    case Tag
tag of
      Tag
Aurum.Spend -> Word -> ScriptWitnessIndex
ScriptWitnessIndexTxIn        (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
      Tag
Aurum.Mint  -> Word -> ScriptWitnessIndex
ScriptWitnessIndexMint        (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
      Tag
Aurum.Cert  -> Word -> ScriptWitnessIndex
ScriptWitnessIndexCertificate (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
      Tag
Aurum.Rewrd -> Word -> ScriptWitnessIndex
ScriptWitnessIndexWithdrawal  (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)


mapTxScriptWitnesses :: forall era.
                        (forall witctx. ScriptWitnessIndex
                                     -> ScriptWitness witctx era
                                     -> ScriptWitness witctx era)
                     -> TxBodyContent BuildTx era
                     -> TxBodyContent BuildTx era
mapTxScriptWitnesses :: (forall witctx.
 ScriptWitnessIndex
 -> ScriptWitness witctx era -> ScriptWitness witctx era)
-> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
mapTxScriptWitnesses forall witctx.
ScriptWitnessIndex
-> ScriptWitness witctx era -> ScriptWitness witctx era
f txbodycontent :: TxBodyContent BuildTx era
txbodycontent@TxBodyContent {
                         TxIns BuildTx era
txIns :: TxIns BuildTx era
txIns :: forall build era. TxBodyContent build era -> TxIns build era
txIns,
                         TxWithdrawals BuildTx era
txWithdrawals :: TxWithdrawals BuildTx era
txWithdrawals :: forall build era.
TxBodyContent build era -> TxWithdrawals build era
txWithdrawals,
                         TxCertificates BuildTx era
txCertificates :: TxCertificates BuildTx era
txCertificates :: forall build era.
TxBodyContent build era -> TxCertificates build era
txCertificates,
                         TxMintValue BuildTx era
txMintValue :: TxMintValue BuildTx era
txMintValue :: forall build era. TxBodyContent build era -> TxMintValue build era
txMintValue
                       } =
    TxBodyContent BuildTx era
txbodycontent {
      txIns :: TxIns BuildTx era
txIns          = TxIns BuildTx era -> TxIns BuildTx era
mapScriptWitnessesTxIns        TxIns BuildTx era
txIns
    , txMintValue :: TxMintValue BuildTx era
txMintValue    = TxMintValue BuildTx era -> TxMintValue BuildTx era
mapScriptWitnessesMinting      TxMintValue BuildTx era
txMintValue
    , txCertificates :: TxCertificates BuildTx era
txCertificates = TxCertificates BuildTx era -> TxCertificates BuildTx era
mapScriptWitnessesCertificates TxCertificates BuildTx era
txCertificates
    , txWithdrawals :: TxWithdrawals BuildTx era
txWithdrawals  = TxWithdrawals BuildTx era -> TxWithdrawals BuildTx era
mapScriptWitnessesWithdrawals  TxWithdrawals BuildTx era
txWithdrawals
    }
  where
    mapScriptWitnessesTxIns
      :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
      -> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
    mapScriptWitnessesTxIns :: TxIns BuildTx era -> TxIns BuildTx era
mapScriptWitnessesTxIns TxIns BuildTx era
txins =
        [ (TxIn
txin, Witness WitCtxTxIn era
-> BuildTxWith BuildTx (Witness WitCtxTxIn era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith Witness WitCtxTxIn era
wit')
          -- The tx ins are indexed in the map order by txid
        | (Word
ix, (TxIn
txin, BuildTxWith Witness WitCtxTxIn era
wit)) <- [Word]
-> TxIns BuildTx era
-> [(Word, (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0..] (TxIns BuildTx era -> TxIns BuildTx era
forall v. [(TxIn, v)] -> [(TxIn, v)]
orderTxIns TxIns BuildTx era
txins)
        , let wit' :: Witness WitCtxTxIn era
wit' = case Witness WitCtxTxIn era
wit of
                       KeyWitness{}              -> Witness WitCtxTxIn era
wit
                       ScriptWitness ScriptWitnessInCtx WitCtxTxIn
ctx ScriptWitness WitCtxTxIn era
witness -> ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn era -> Witness WitCtxTxIn era
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
ScriptWitness ScriptWitnessInCtx WitCtxTxIn
ctx ScriptWitness WitCtxTxIn era
witness'
                         where
                           witness' :: ScriptWitness WitCtxTxIn era
witness' = ScriptWitnessIndex
-> ScriptWitness WitCtxTxIn era -> ScriptWitness WitCtxTxIn era
forall witctx.
ScriptWitnessIndex
-> ScriptWitness witctx era -> ScriptWitness witctx era
f (Word -> ScriptWitnessIndex
ScriptWitnessIndexTxIn Word
ix) ScriptWitness WitCtxTxIn era
witness
        ]

    mapScriptWitnessesWithdrawals
      :: TxWithdrawals BuildTx era
      -> TxWithdrawals BuildTx era
    mapScriptWitnessesWithdrawals :: TxWithdrawals BuildTx era -> TxWithdrawals BuildTx era
mapScriptWitnessesWithdrawals  TxWithdrawals BuildTx era
TxWithdrawalsNone = TxWithdrawals BuildTx era
forall build era. TxWithdrawals build era
TxWithdrawalsNone
    mapScriptWitnessesWithdrawals (TxWithdrawals WithdrawalsSupportedInEra era
supported [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
withdrawals) =
      WithdrawalsSupportedInEra era
-> [(StakeAddress, Entropic,
     BuildTxWith BuildTx (Witness WitCtxStake era))]
-> TxWithdrawals BuildTx era
forall era build.
WithdrawalsSupportedInEra era
-> [(StakeAddress, Entropic,
     BuildTxWith build (Witness WitCtxStake era))]
-> TxWithdrawals build era
TxWithdrawals WithdrawalsSupportedInEra era
supported
        [ (StakeAddress
addr, Entropic
withdrawal, Witness WitCtxStake era
-> BuildTxWith BuildTx (Witness WitCtxStake era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (ScriptWitnessInCtx WitCtxStake
-> ScriptWitness WitCtxStake era -> Witness WitCtxStake era
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
ScriptWitness ScriptWitnessInCtx WitCtxStake
ctx ScriptWitness WitCtxStake era
witness'))
          -- The withdrawals are indexed in the map order by stake credential
        | (Word
ix, (StakeAddress
addr, Entropic
withdrawal, BuildTxWith (ScriptWitness ScriptWitnessInCtx WitCtxStake
ctx ScriptWitness WitCtxStake era
witness)))
             <- [Word]
-> [(StakeAddress, Entropic,
     BuildTxWith BuildTx (Witness WitCtxStake era))]
-> [(Word,
     (StakeAddress, Entropic,
      BuildTxWith BuildTx (Witness WitCtxStake era)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0..] ([(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
-> [(StakeAddress, Entropic,
     BuildTxWith BuildTx (Witness WitCtxStake era))]
forall x v. [(StakeAddress, x, v)] -> [(StakeAddress, x, v)]
orderStakeAddrs [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
withdrawals)
        , let witness' :: ScriptWitness WitCtxStake era
witness' = ScriptWitnessIndex
-> ScriptWitness WitCtxStake era -> ScriptWitness WitCtxStake era
forall witctx.
ScriptWitnessIndex
-> ScriptWitness witctx era -> ScriptWitness witctx era
f (Word -> ScriptWitnessIndex
ScriptWitnessIndexWithdrawal Word
ix) ScriptWitness WitCtxStake era
witness
        ]

    mapScriptWitnessesCertificates
      :: TxCertificates BuildTx era
      -> TxCertificates BuildTx era
    mapScriptWitnessesCertificates :: TxCertificates BuildTx era -> TxCertificates BuildTx era
mapScriptWitnessesCertificates  TxCertificates BuildTx era
TxCertificatesNone = TxCertificates BuildTx era
forall build era. TxCertificates build era
TxCertificatesNone
    mapScriptWitnessesCertificates (TxCertificates CertificatesSupportedInEra era
supported [Certificate]
certs
                                                   (BuildTxWith Map StakeCredential (Witness WitCtxStake era)
witnesses)) =
      CertificatesSupportedInEra era
-> [Certificate]
-> BuildTxWith
     BuildTx (Map StakeCredential (Witness WitCtxStake era))
-> TxCertificates BuildTx era
forall era build.
CertificatesSupportedInEra era
-> [Certificate]
-> BuildTxWith
     build (Map StakeCredential (Witness WitCtxStake era))
-> TxCertificates build era
TxCertificates CertificatesSupportedInEra era
supported [Certificate]
certs (BuildTxWith
   BuildTx (Map StakeCredential (Witness WitCtxStake era))
 -> TxCertificates BuildTx era)
-> BuildTxWith
     BuildTx (Map StakeCredential (Witness WitCtxStake era))
-> TxCertificates BuildTx era
forall a b. (a -> b) -> a -> b
$ Map StakeCredential (Witness WitCtxStake era)
-> BuildTxWith
     BuildTx (Map StakeCredential (Witness WitCtxStake era))
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Map StakeCredential (Witness WitCtxStake era)
 -> BuildTxWith
      BuildTx (Map StakeCredential (Witness WitCtxStake era)))
-> Map StakeCredential (Witness WitCtxStake era)
-> BuildTxWith
     BuildTx (Map StakeCredential (Witness WitCtxStake era))
forall a b. (a -> b) -> a -> b
$ [(StakeCredential, Witness WitCtxStake era)]
-> Map StakeCredential (Witness WitCtxStake era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (StakeCredential
stakecred, ScriptWitnessInCtx WitCtxStake
-> ScriptWitness WitCtxStake era -> Witness WitCtxStake era
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
ScriptWitness ScriptWitnessInCtx WitCtxStake
ctx ScriptWitness WitCtxStake era
witness')
          -- The certs are indexed in list order
        | (Word
ix, Certificate
cert) <- [Word] -> [Certificate] -> [(Word, Certificate)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0..] [Certificate]
certs
        , StakeCredential
stakecred  <- Maybe StakeCredential -> [StakeCredential]
forall a. Maybe a -> [a]
maybeToList (Certificate -> Maybe StakeCredential
selectStakeCredential Certificate
cert)
        , ScriptWitness ScriptWitnessInCtx WitCtxStake
ctx ScriptWitness WitCtxStake era
witness
                     <- Maybe (Witness WitCtxStake era) -> [Witness WitCtxStake era]
forall a. Maybe a -> [a]
maybeToList (StakeCredential
-> Map StakeCredential (Witness WitCtxStake era)
-> Maybe (Witness WitCtxStake era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeCredential
stakecred Map StakeCredential (Witness WitCtxStake era)
witnesses)
        , let witness' :: ScriptWitness WitCtxStake era
witness' = ScriptWitnessIndex
-> ScriptWitness WitCtxStake era -> ScriptWitness WitCtxStake era
forall witctx.
ScriptWitnessIndex
-> ScriptWitness witctx era -> ScriptWitness witctx era
f (Word -> ScriptWitnessIndex
ScriptWitnessIndexCertificate Word
ix) ScriptWitness WitCtxStake era
witness
        ]

    selectStakeCredential :: Certificate -> Maybe StakeCredential
selectStakeCredential Certificate
cert =
      case Certificate
cert of
        StakeAddressDeregistrationCertificate StakeCredential
stakecred   -> StakeCredential -> Maybe StakeCredential
forall a. a -> Maybe a
Just StakeCredential
stakecred
        StakeAddressDelegationCertificate     StakeCredential
stakecred PoolId
_ -> StakeCredential -> Maybe StakeCredential
forall a. a -> Maybe a
Just StakeCredential
stakecred
        Certificate
_                                                 -> Maybe StakeCredential
forall a. Maybe a
Nothing

    mapScriptWitnessesMinting
      :: TxMintValue BuildTx era
      -> TxMintValue BuildTx era
    mapScriptWitnessesMinting :: TxMintValue BuildTx era -> TxMintValue BuildTx era
mapScriptWitnessesMinting  TxMintValue BuildTx era
TxMintNone = TxMintValue BuildTx era
forall build era. TxMintValue build era
TxMintNone
    mapScriptWitnessesMinting (TxMintValue MultiAssetSupportedInEra era
supported Value
value
                                           (BuildTxWith Map PolicyId (ScriptWitness WitCtxMint era)
witnesses)) =
      MultiAssetSupportedInEra era
-> Value
-> BuildTxWith
     BuildTx (Map PolicyId (ScriptWitness WitCtxMint era))
-> TxMintValue BuildTx era
forall era build.
MultiAssetSupportedInEra era
-> Value
-> BuildTxWith build (Map PolicyId (ScriptWitness WitCtxMint era))
-> TxMintValue build era
TxMintValue MultiAssetSupportedInEra era
supported Value
value (BuildTxWith BuildTx (Map PolicyId (ScriptWitness WitCtxMint era))
 -> TxMintValue BuildTx era)
-> BuildTxWith
     BuildTx (Map PolicyId (ScriptWitness WitCtxMint era))
-> TxMintValue BuildTx era
forall a b. (a -> b) -> a -> b
$ Map PolicyId (ScriptWitness WitCtxMint era)
-> BuildTxWith
     BuildTx (Map PolicyId (ScriptWitness WitCtxMint era))
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Map PolicyId (ScriptWitness WitCtxMint era)
 -> BuildTxWith
      BuildTx (Map PolicyId (ScriptWitness WitCtxMint era)))
-> Map PolicyId (ScriptWitness WitCtxMint era)
-> BuildTxWith
     BuildTx (Map PolicyId (ScriptWitness WitCtxMint era))
forall a b. (a -> b) -> a -> b
$ [(PolicyId, ScriptWitness WitCtxMint era)]
-> Map PolicyId (ScriptWitness WitCtxMint era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (PolicyId
policyid, ScriptWitness WitCtxMint era
witness')
          -- The minting policies are indexed in policy id order in the value
        | let ValueNestedRep [ValueNestedBundle]
bundle = Value -> ValueNestedRep
valueToNestedRep Value
value
        , (Word
ix, ValueNestedBundle PolicyId
policyid Map AssetName Quantity
_) <- [Word] -> [ValueNestedBundle] -> [(Word, ValueNestedBundle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0..] [ValueNestedBundle]
bundle
        , ScriptWitness WitCtxMint era
witness <- Maybe (ScriptWitness WitCtxMint era)
-> [ScriptWitness WitCtxMint era]
forall a. Maybe a -> [a]
maybeToList (PolicyId
-> Map PolicyId (ScriptWitness WitCtxMint era)
-> Maybe (ScriptWitness WitCtxMint era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PolicyId
policyid Map PolicyId (ScriptWitness WitCtxMint era)
witnesses)
        , let witness' :: ScriptWitness WitCtxMint era
witness' = ScriptWitnessIndex
-> ScriptWitness WitCtxMint era -> ScriptWitness WitCtxMint era
forall witctx.
ScriptWitnessIndex
-> ScriptWitness witctx era -> ScriptWitness witctx era
f (Word -> ScriptWitnessIndex
ScriptWitnessIndexMint Word
ix) ScriptWitness WitCtxMint era
witness
        ]


collectTxBodyScriptWitnesses :: forall era.
                                TxBodyContent BuildTx era
                             -> [(ScriptWitnessIndex, AnyScriptWitness era)]
collectTxBodyScriptWitnesses :: TxBodyContent BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
collectTxBodyScriptWitnesses TxBodyContent {
                               TxIns BuildTx era
txIns :: TxIns BuildTx era
txIns :: forall build era. TxBodyContent build era -> TxIns build era
txIns,
                               TxWithdrawals BuildTx era
txWithdrawals :: TxWithdrawals BuildTx era
txWithdrawals :: forall build era.
TxBodyContent build era -> TxWithdrawals build era
txWithdrawals,
                               TxCertificates BuildTx era
txCertificates :: TxCertificates BuildTx era
txCertificates :: forall build era.
TxBodyContent build era -> TxCertificates build era
txCertificates,
                               TxMintValue BuildTx era
txMintValue :: TxMintValue BuildTx era
txMintValue :: forall build era. TxBodyContent build era -> TxMintValue build era
txMintValue
                             } =
    [[(ScriptWitnessIndex, AnyScriptWitness era)]]
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ TxIns BuildTx era -> [(ScriptWitnessIndex, AnyScriptWitness era)]
scriptWitnessesTxIns        TxIns BuildTx era
txIns
      , TxWithdrawals BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
scriptWitnessesWithdrawals  TxWithdrawals BuildTx era
txWithdrawals
      , TxCertificates BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
scriptWitnessesCertificates TxCertificates BuildTx era
txCertificates
      , TxMintValue BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
scriptWitnessesMinting      TxMintValue BuildTx era
txMintValue
      ]
  where
    scriptWitnessesTxIns
      :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
      -> [(ScriptWitnessIndex, AnyScriptWitness era)]
    scriptWitnessesTxIns :: TxIns BuildTx era -> [(ScriptWitnessIndex, AnyScriptWitness era)]
scriptWitnessesTxIns TxIns BuildTx era
txins =
        [ (Word -> ScriptWitnessIndex
ScriptWitnessIndexTxIn Word
ix, ScriptWitness WitCtxTxIn era -> AnyScriptWitness era
forall witctx era. ScriptWitness witctx era -> AnyScriptWitness era
AnyScriptWitness ScriptWitness WitCtxTxIn era
witness)
          -- The tx ins are indexed in the map order by txid
        | (Word
ix, (TxIn
_, BuildTxWith (ScriptWitness ScriptWitnessInCtx WitCtxTxIn
_ ScriptWitness WitCtxTxIn era
witness)))
            <- [Word]
-> TxIns BuildTx era
-> [(Word, (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0..] (TxIns BuildTx era -> TxIns BuildTx era
forall v. [(TxIn, v)] -> [(TxIn, v)]
orderTxIns TxIns BuildTx era
txins)
        ]

    scriptWitnessesWithdrawals
      :: TxWithdrawals BuildTx era
      -> [(ScriptWitnessIndex, AnyScriptWitness era)]
    scriptWitnessesWithdrawals :: TxWithdrawals BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
scriptWitnessesWithdrawals  TxWithdrawals BuildTx era
TxWithdrawalsNone = []
    scriptWitnessesWithdrawals (TxWithdrawals WithdrawalsSupportedInEra era
_ [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
withdrawals) =
        [ (Word -> ScriptWitnessIndex
ScriptWitnessIndexWithdrawal Word
ix, ScriptWitness WitCtxStake era -> AnyScriptWitness era
forall witctx era. ScriptWitness witctx era -> AnyScriptWitness era
AnyScriptWitness ScriptWitness WitCtxStake era
witness)
          -- The withdrawals are indexed in the map order by stake credential
        | (Word
ix, (StakeAddress
_, Entropic
_, BuildTxWith (ScriptWitness ScriptWitnessInCtx WitCtxStake
_ ScriptWitness WitCtxStake era
witness)))
             <- [Word]
-> [(StakeAddress, Entropic,
     BuildTxWith BuildTx (Witness WitCtxStake era))]
-> [(Word,
     (StakeAddress, Entropic,
      BuildTxWith BuildTx (Witness WitCtxStake era)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0..] ([(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
-> [(StakeAddress, Entropic,
     BuildTxWith BuildTx (Witness WitCtxStake era))]
forall x v. [(StakeAddress, x, v)] -> [(StakeAddress, x, v)]
orderStakeAddrs [(StakeAddress, Entropic,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
withdrawals)
        ]

    scriptWitnessesCertificates
      :: TxCertificates BuildTx era
      -> [(ScriptWitnessIndex, AnyScriptWitness era)]
    scriptWitnessesCertificates :: TxCertificates BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
scriptWitnessesCertificates  TxCertificates BuildTx era
TxCertificatesNone = []
    scriptWitnessesCertificates (TxCertificates CertificatesSupportedInEra era
_ [Certificate]
certs (BuildTxWith Map StakeCredential (Witness WitCtxStake era)
witnesses)) =
        [ (Word -> ScriptWitnessIndex
ScriptWitnessIndexCertificate Word
ix, ScriptWitness WitCtxStake era -> AnyScriptWitness era
forall witctx era. ScriptWitness witctx era -> AnyScriptWitness era
AnyScriptWitness ScriptWitness WitCtxStake era
witness)
          -- The certs are indexed in list order
        | (Word
ix, Certificate
cert) <- [Word] -> [Certificate] -> [(Word, Certificate)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0..] [Certificate]
certs
        , ScriptWitness ScriptWitnessInCtx WitCtxStake
_ ScriptWitness WitCtxStake era
witness <- Maybe (Witness WitCtxStake era) -> [Witness WitCtxStake era]
forall a. Maybe a -> [a]
maybeToList (Maybe (Witness WitCtxStake era) -> [Witness WitCtxStake era])
-> Maybe (Witness WitCtxStake era) -> [Witness WitCtxStake era]
forall a b. (a -> b) -> a -> b
$ do
                                       StakeCredential
stakecred <- Certificate -> Maybe StakeCredential
selectStakeCredential Certificate
cert
                                       StakeCredential
-> Map StakeCredential (Witness WitCtxStake era)
-> Maybe (Witness WitCtxStake era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup StakeCredential
stakecred Map StakeCredential (Witness WitCtxStake era)
witnesses
        ]

    selectStakeCredential :: Certificate -> Maybe StakeCredential
selectStakeCredential Certificate
cert =
      case Certificate
cert of
        StakeAddressDeregistrationCertificate StakeCredential
stakecred   -> StakeCredential -> Maybe StakeCredential
forall a. a -> Maybe a
Just StakeCredential
stakecred
        StakeAddressDelegationCertificate     StakeCredential
stakecred PoolId
_ -> StakeCredential -> Maybe StakeCredential
forall a. a -> Maybe a
Just StakeCredential
stakecred
        Certificate
_                                                 -> Maybe StakeCredential
forall a. Maybe a
Nothing

    scriptWitnessesMinting
      :: TxMintValue BuildTx era
      -> [(ScriptWitnessIndex, AnyScriptWitness era)]
    scriptWitnessesMinting :: TxMintValue BuildTx era
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
scriptWitnessesMinting  TxMintValue BuildTx era
TxMintNone = []
    scriptWitnessesMinting (TxMintValue MultiAssetSupportedInEra era
_ Value
value (BuildTxWith Map PolicyId (ScriptWitness WitCtxMint era)
witnesses)) =
        [ (Word -> ScriptWitnessIndex
ScriptWitnessIndexMint Word
ix, ScriptWitness WitCtxMint era -> AnyScriptWitness era
forall witctx era. ScriptWitness witctx era -> AnyScriptWitness era
AnyScriptWitness ScriptWitness WitCtxMint era
witness)
          -- The minting policies are indexed in policy id order in the value
        | let ValueNestedRep [ValueNestedBundle]
bundle = Value -> ValueNestedRep
valueToNestedRep Value
value
        , (Word
ix, ValueNestedBundle PolicyId
policyid Map AssetName Quantity
_) <- [Word] -> [ValueNestedBundle] -> [(Word, ValueNestedBundle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0..] [ValueNestedBundle]
bundle
        , ScriptWitness WitCtxMint era
witness <- Maybe (ScriptWitness WitCtxMint era)
-> [ScriptWitness WitCtxMint era]
forall a. Maybe a -> [a]
maybeToList (PolicyId
-> Map PolicyId (ScriptWitness WitCtxMint era)
-> Maybe (ScriptWitness WitCtxMint era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PolicyId
policyid Map PolicyId (ScriptWitness WitCtxMint era)
witnesses)
        ]

-- This relies on the TxId Ord instance being consistent with the
-- Sophie.TxId Ord instance via the toSophieTxId conversion
-- This is checked by prop_ord_distributive_TxId
orderTxIns :: [(TxIn, v)] -> [(TxIn, v)]
orderTxIns :: [(TxIn, v)] -> [(TxIn, v)]
orderTxIns = ((TxIn, v) -> (TxIn, v) -> Ordering) -> [(TxIn, v)] -> [(TxIn, v)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (TxIn -> TxIn -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TxIn -> TxIn -> Ordering)
-> ((TxIn, v) -> TxIn) -> (TxIn, v) -> (TxIn, v) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (TxIn, v) -> TxIn
forall a b. (a, b) -> a
fst)

-- This relies on the StakeAddress Ord instance being consistent with the
-- Sophie.RewardAcnt Ord instance via the toSophieStakeAddr conversion
-- This is checked by prop_ord_distributive_StakeAddress
orderStakeAddrs :: [(StakeAddress, x, v)] -> [(StakeAddress, x, v)]
orderStakeAddrs :: [(StakeAddress, x, v)] -> [(StakeAddress, x, v)]
orderStakeAddrs = ((StakeAddress, x, v) -> (StakeAddress, x, v) -> Ordering)
-> [(StakeAddress, x, v)] -> [(StakeAddress, x, v)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (StakeAddress -> StakeAddress -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (StakeAddress -> StakeAddress -> Ordering)
-> ((StakeAddress, x, v) -> StakeAddress)
-> (StakeAddress, x, v)
-> (StakeAddress, x, v)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\(StakeAddress
k, x
_, v
_) -> StakeAddress
k))


toSophieWithdrawal :: [(StakeAddress, Entropic, a)] -> Sophie.Wdrl StandardCrypto
toSophieWithdrawal :: [(StakeAddress, Entropic, a)] -> Wdrl StandardCrypto
toSophieWithdrawal [(StakeAddress, Entropic, a)]
withdrawals =
    Map (RewardAcnt StandardCrypto) Coin -> Wdrl StandardCrypto
forall crypto. Map (RewardAcnt crypto) Coin -> Wdrl crypto
Sophie.Wdrl (Map (RewardAcnt StandardCrypto) Coin -> Wdrl StandardCrypto)
-> Map (RewardAcnt StandardCrypto) Coin -> Wdrl StandardCrypto
forall a b. (a -> b) -> a -> b
$
      [(RewardAcnt StandardCrypto, Coin)]
-> Map (RewardAcnt StandardCrypto) Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (StakeAddress -> RewardAcnt StandardCrypto
toSophieStakeAddr StakeAddress
stakeAddr, Entropic -> Coin
toSophieEntropic Entropic
value)
        | (StakeAddress
stakeAddr, Entropic
value, a
_) <- [(StakeAddress, Entropic, a)]
withdrawals ]


fromSophieWithdrawal
  :: Sophie.Wdrl StandardCrypto
  -> [(StakeAddress, Entropic, BuildTxWith ViewTx (Witness WitCtxStake era))]
fromSophieWithdrawal :: Wdrl StandardCrypto
-> [(StakeAddress, Entropic,
     BuildTxWith ViewTx (Witness WitCtxStake era))]
fromSophieWithdrawal (Sophie.Wdrl Map (RewardAcnt StandardCrypto) Coin
withdrawals) =
  [ (RewardAcnt StandardCrypto -> StakeAddress
fromSophieStakeAddr RewardAcnt StandardCrypto
stakeAddr, Coin -> Entropic
fromSophieEntropic Coin
value, BuildTxWith ViewTx (Witness WitCtxStake era)
forall a. BuildTxWith ViewTx a
ViewTx)
  | (RewardAcnt StandardCrypto
stakeAddr, Coin
value) <- Map (RewardAcnt StandardCrypto) Coin
-> [(RewardAcnt StandardCrypto, Coin)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map (RewardAcnt StandardCrypto) Coin
withdrawals
  ]


-- | In the Sophie era the auxiliary data consists only of the tx metadata
toSophieAuxiliaryData :: Map Word64 TxMetadataValue
                       -> Ledger.AuxiliaryData StandardSophie
toSophieAuxiliaryData :: Map Word64 TxMetadataValue
-> AuxiliaryData (SophieEra StandardCrypto)
toSophieAuxiliaryData Map Word64 TxMetadataValue
m =
    Map Word64 Metadatum -> Metadata (SophieEra StandardCrypto)
forall era. Map Word64 Metadatum -> Metadata era
Sophie.Metadata
      (Map Word64 TxMetadataValue -> Map Word64 Metadatum
toSophieMetadata Map Word64 TxMetadataValue
m)


-- | In the Evie and Jen eras the auxiliary data consists of the tx metadata
-- and the axiliary scripts.
--
toEvieAuxiliaryData :: forall era ledgerera.
                          SophieLedgerEra era ~ ledgerera
                       => Ledger.AuxiliaryData ledgerera ~ Evie.AuxiliaryData ledgerera
                       => Ledger.AnnotatedData (Ledger.Script ledgerera)
                       => Ord (Ledger.Script ledgerera)
                       => Map Word64 TxMetadataValue
                       -> [ScriptInEra era]
                       -> Ledger.AuxiliaryData ledgerera
toEvieAuxiliaryData :: Map Word64 TxMetadataValue
-> [ScriptInEra era] -> AuxiliaryData ledgerera
toEvieAuxiliaryData Map Word64 TxMetadataValue
m [ScriptInEra era]
ss =
    Map Word64 Metadatum
-> StrictSeq (Script ledgerera) -> AuxiliaryData ledgerera
forall era.
(AnnotatedData (Script era), Ord (Script era)) =>
Map Word64 Metadatum -> StrictSeq (Script era) -> AuxiliaryData era
Evie.AuxiliaryData
      (Map Word64 TxMetadataValue -> Map Word64 Metadatum
toSophieMetadata Map Word64 TxMetadataValue
m)
      ([Script ledgerera] -> StrictSeq (Script ledgerera)
forall a. [a] -> StrictSeq a
Seq.fromList ((ScriptInEra era -> Script ledgerera)
-> [ScriptInEra era] -> [Script ledgerera]
forall a b. (a -> b) -> [a] -> [b]
map ScriptInEra era -> Script ledgerera
forall era. ScriptInEra era -> Script (SophieLedgerEra era)
toSophieScript [ScriptInEra era]
ss))


-- | In the Aurum and later eras the auxiliary data consists of the tx metadata
-- and the axiliary scripts, and the axiliary script data.
--
toAurumAuxiliaryData :: forall era ledgerera.
                         SophieLedgerEra era ~ ledgerera
                      => Ledger.AuxiliaryData ledgerera ~ Aurum.AuxiliaryData ledgerera
                      => Ledger.Script ledgerera ~ Aurum.Script ledgerera
                      => Ledger.Era ledgerera
                      => Map Word64 TxMetadataValue
                      -> [ScriptInEra era]
                      -> Ledger.AuxiliaryData ledgerera
toAurumAuxiliaryData :: Map Word64 TxMetadataValue
-> [ScriptInEra era] -> AuxiliaryData ledgerera
toAurumAuxiliaryData Map Word64 TxMetadataValue
m [ScriptInEra era]
ss =
    Map Word64 Metadatum
-> StrictSeq (Script ledgerera) -> AuxiliaryData ledgerera
forall era.
(Era era, ToCBOR (Script era), Script era ~ Script era,
 Ord (Script era)) =>
Map Word64 Metadatum -> StrictSeq (Script era) -> AuxiliaryData era
Aurum.AuxiliaryData
      (Map Word64 TxMetadataValue -> Map Word64 Metadatum
toSophieMetadata Map Word64 TxMetadataValue
m)
      ([Script ledgerera] -> StrictSeq (Script ledgerera)
forall a. [a] -> StrictSeq a
Seq.fromList ((ScriptInEra era -> Script ledgerera)
-> [ScriptInEra era] -> [Script ledgerera]
forall a b. (a -> b) -> [a] -> [b]
map ScriptInEra era -> Script ledgerera
forall era. ScriptInEra era -> Script (SophieLedgerEra era)
toSophieScript [ScriptInEra era]
ss))


-- ----------------------------------------------------------------------------
-- Other utilities helpful with making transaction bodies
--

-- | Compute the 'TxIn' of the initial UTxO pseudo-transaction corresponding
-- to the given address in the genesis initial funds.
--
-- The Sophie initial UTxO is constructed from the 'sgInitialFunds' which
-- is not a full UTxO but just a map from addresses to coin values.
--
-- This gets turned into a UTxO by making a pseudo-transaction for each address,
-- with the 0th output being the coin value. So to spend from the initial UTxO
-- we need this same 'TxIn' to use as an input to the spending transaction.
--
genesisUTxOPseudoTxIn :: NetworkId -> Hash GenesisUTxOKey -> TxIn
genesisUTxOPseudoTxIn :: NetworkId -> Hash GenesisUTxOKey -> TxIn
genesisUTxOPseudoTxIn NetworkId
nw (GenesisUTxOKeyHash kh) =
    --TODO: should handle Cole UTxO case too.
    TxIn StandardCrypto -> TxIn
fromSophieTxIn (Addr StandardCrypto -> TxIn StandardCrypto
forall crypto. Crypto crypto => Addr crypto -> TxIn crypto
Sophie.initialFundsPseudoTxIn Addr StandardCrypto
addr)
  where
    addr :: Sophie.Addr StandardCrypto
    addr :: Addr StandardCrypto
addr = Network
-> PaymentCredential StandardCrypto
-> StakeReference StandardCrypto
-> Addr StandardCrypto
forall crypto.
Network
-> PaymentCredential crypto -> StakeReference crypto -> Addr crypto
Sophie.Addr
             (NetworkId -> Network
toSophieNetwork NetworkId
nw)
             (KeyHash 'Payment StandardCrypto -> PaymentCredential StandardCrypto
forall (kr :: KeyRole) crypto.
KeyHash kr crypto -> Credential kr crypto
Sophie.KeyHashObj KeyHash 'Payment StandardCrypto
kh)
             StakeReference StandardCrypto
forall crypto. StakeReference crypto
Sophie.StakeRefNull