{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This module exports implementations of many of the functions outlined in the Alonzo specification.
--     The link to source of the specification
--       https://github.com/input-output-hk/cardano-ledger/tree/master/eras/alonzo/formal-spec
--     The most recent version of the document can be found here:
--       https://hydra.iohk.io/job/Cardano/cardano-ledger/specs.alonzo-ledger/latest/download-by-type/doc-pdf/alonzo-changes
--     The functions can be found in Figures in that document, and sections of this code refer to those figures.
module Cardano.Ledger.Alonzo.Tx
  ( -- Figure 1
    CostModel,
    getLanguageView,
    -- Figure 2
    Data,
    DataHash,
    IsValid (..),
    hashData,
    nonNativeLanguages,
    hashScriptIntegrity,
    getCoin,
    EraIndependentScriptIntegrity,
    ScriptIntegrity (ScriptIntegrity),
    ScriptIntegrityHash,
    -- Figure 3
    ValidatedTx (ValidatedTx, body, wits, isValid, auxiliaryData),
    txdats',
    txscripts',
    txrdmrs,
    TxBody (..),
    -- Figure 4
    totExUnits,
    isTwoPhaseScriptAddress,
    minfee,
    --  Figure 5
    Indexable (..), -- indexOf
    ScriptPurpose (..),
    isTwoPhaseScriptAddressFromMap,
    alonzoInputHashes,
    Shelley.txouts,
    indexedRdmrs,
    rdptr,
    -- Figure 6
    rdptrInv,
    getMapFromValue,
    -- Segwit
    segwitTx,
    -- Other
    toCBORForSizeComputation,
    toCBORForMempoolSubmission,
  )
where

import Cardano.Binary
  ( FromCBOR (..),
    ToCBOR (toCBOR),
    encodeListLen,
    serializeEncoding,
    serializeEncoding',
  )
import Cardano.Crypto.DSIGN.Class (SigDSIGN, VerKeyDSIGN)
import Cardano.Ledger.Address (Addr (..), RewardAcnt (..))
import Cardano.Ledger.Alonzo.Data (Data, DataHash, hashData)
import Cardano.Ledger.Alonzo.Language (nonNativeLanguages)
import Cardano.Ledger.Alonzo.PParams
  ( LangDepView (..),
    encodeLangViews,
    getLanguageView,
  )
import Cardano.Ledger.Alonzo.Scripts
  ( CostModel,
    ExUnits (..),
    Prices,
    Script,
    Tag (..),
    txscriptfee,
  )
import Cardano.Ledger.Alonzo.TxBody
  ( EraIndependentScriptIntegrity,
    ScriptIntegrityHash,
    TxBody (..),
    TxOut (..),
  )
import Cardano.Ledger.Alonzo.TxWitness
  ( RdmrPtr (..),
    Redeemers (..),
    TxDats (..),
    TxWitness (..),
    nullDats,
    nullRedeemers,
    txrdmrs,
    unRedeemers,
    unTxDats,
  )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Compactible
import qualified Cardano.Ledger.Core as Core
import qualified Cardano.Ledger.Crypto as CC
import Cardano.Ledger.Era (Crypto, Era, ValidateScript (hashScript, isNativeScript))
import Cardano.Ledger.Hashes (ScriptHash)
import Cardano.Ledger.Keys (KeyRole (Witness))
import Cardano.Ledger.Mary.Value (AssetName, PolicyID (..), Value (..))
import Cardano.Ledger.SafeHash
  ( HashAnnotated,
    SafeToHash (..),
    hashAnnotated,
  )
import Cardano.Ledger.Shelley.Address.Bootstrap (BootstrapWitness)
import Cardano.Ledger.Shelley.Delegation.Certificates (DCert (..))
import Cardano.Ledger.Shelley.TxBody (Wdrl (..), WitVKey, unWdrl)
import Cardano.Ledger.Shelley.UTxO (UTxO (..))
import qualified Cardano.Ledger.Shelley.UTxO as Shelley
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.Val (Val (coin, (<+>), (<×>)))
import Control.DeepSeq (NFData (..))
import Control.SetAlgebra (eval, (◁))
import qualified Data.ByteString.Lazy as LBS
import Data.Coders
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict
  ( StrictMaybe (..),
    maybeToStrictMaybe,
    strictMaybeToMaybe,
  )
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import Data.Word (Word64)
import GHC.Generics (Generic)
import GHC.Records (HasField (..))
import NoThunks.Class (NoThunks)
import Numeric.Natural (Natural)

-- ===================================================

-- | Tag indicating whether non-native scripts in this transaction are expected
-- to validate. This is added by the block creator when constructing the block.
newtype IsValid = IsValid Bool
  deriving (IsValid -> IsValid -> Bool
(IsValid -> IsValid -> Bool)
-> (IsValid -> IsValid -> Bool) -> Eq IsValid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsValid -> IsValid -> Bool
$c/= :: IsValid -> IsValid -> Bool
== :: IsValid -> IsValid -> Bool
$c== :: IsValid -> IsValid -> Bool
Eq, Int -> IsValid -> ShowS
[IsValid] -> ShowS
IsValid -> String
(Int -> IsValid -> ShowS)
-> (IsValid -> String) -> ([IsValid] -> ShowS) -> Show IsValid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsValid] -> ShowS
$cshowList :: [IsValid] -> ShowS
show :: IsValid -> String
$cshow :: IsValid -> String
showsPrec :: Int -> IsValid -> ShowS
$cshowsPrec :: Int -> IsValid -> ShowS
Show, (forall x. IsValid -> Rep IsValid x)
-> (forall x. Rep IsValid x -> IsValid) -> Generic IsValid
forall x. Rep IsValid x -> IsValid
forall x. IsValid -> Rep IsValid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IsValid x -> IsValid
$cfrom :: forall x. IsValid -> Rep IsValid x
Generic)
  deriving newtype (Context -> IsValid -> IO (Maybe ThunkInfo)
Proxy IsValid -> String
(Context -> IsValid -> IO (Maybe ThunkInfo))
-> (Context -> IsValid -> IO (Maybe ThunkInfo))
-> (Proxy IsValid -> String)
-> NoThunks IsValid
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy IsValid -> String
$cshowTypeOf :: Proxy IsValid -> String
wNoThunks :: Context -> IsValid -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> IsValid -> IO (Maybe ThunkInfo)
noThunks :: Context -> IsValid -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> IsValid -> IO (Maybe ThunkInfo)
NoThunks, IsValid -> ()
(IsValid -> ()) -> NFData IsValid
forall a. (a -> ()) -> NFData a
rnf :: IsValid -> ()
$crnf :: IsValid -> ()
NFData)

data ValidatedTx era = ValidatedTx
  { ValidatedTx era -> TxBody era
body :: !(Core.TxBody era),
    ValidatedTx era -> TxWitness era
wits :: !(TxWitness era),
    ValidatedTx era -> IsValid
isValid :: !IsValid,
    ValidatedTx era -> StrictMaybe (AuxiliaryData era)
auxiliaryData :: !(StrictMaybe (Core.AuxiliaryData era))
  }
  deriving ((forall x. ValidatedTx era -> Rep (ValidatedTx era) x)
-> (forall x. Rep (ValidatedTx era) x -> ValidatedTx era)
-> Generic (ValidatedTx era)
forall x. Rep (ValidatedTx era) x -> ValidatedTx era
forall x. ValidatedTx era -> Rep (ValidatedTx era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ValidatedTx era) x -> ValidatedTx era
forall era x. ValidatedTx era -> Rep (ValidatedTx era) x
$cto :: forall era x. Rep (ValidatedTx era) x -> ValidatedTx era
$cfrom :: forall era x. ValidatedTx era -> Rep (ValidatedTx era) x
Generic, Typeable)

deriving instance
  ( Era era,
    Eq (Core.AuxiliaryData era),
    Eq (Core.Script era),
    Eq (Core.TxBody era),
    Eq (Core.Value era),
    Eq (Core.PParamsDelta era),
    Compactible (Core.Value era)
  ) =>
  Eq (ValidatedTx era)

deriving instance
  ( Era era,
    Compactible (Core.Value era),
    Show (Core.AuxiliaryData era),
    Show (Core.Script era),
    Show (Core.TxBody era),
    Show (Core.Value era),
    Show (Core.PParamsDelta era)
  ) =>
  Show (ValidatedTx era)

instance
  ( Era era,
    NoThunks (Core.AuxiliaryData era),
    NoThunks (Core.Script era),
    NoThunks (Core.TxBody era),
    NoThunks (Core.Value era),
    NoThunks (Core.PParamsDelta era)
  ) =>
  NoThunks (ValidatedTx era)

instance
  ( Era era,
    Core.Script era ~ Script era,
    crypto ~ Crypto era,
    NFData (Core.AuxiliaryData era),
    NFData (Core.Script era),
    NFData (Core.TxBody era),
    NFData (Core.Value era),
    NFData (Core.PParamsDelta era),
    NFData (TxDats era),
    NFData (Redeemers era),
    NFData (VerKeyDSIGN (CC.DSIGN crypto)),
    NFData (SigDSIGN (CC.DSIGN crypto))
  ) =>
  NFData (ValidatedTx era)

-- ===================================
-- WellFormed instances

instance
  c ~ Crypto era =>
  HasField "addrWits" (ValidatedTx era) (Set (WitVKey 'Witness c))
  where
  getField :: ValidatedTx era -> Set (WitVKey 'Witness c)
getField = TxWitness era -> Set (WitVKey 'Witness c)
forall era. TxWitness era -> Set (WitVKey 'Witness (Crypto era))
txwitsVKey' (TxWitness era -> Set (WitVKey 'Witness c))
-> (ValidatedTx era -> TxWitness era)
-> ValidatedTx era
-> Set (WitVKey 'Witness c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidatedTx era -> TxWitness era
forall era. ValidatedTx era -> TxWitness era
wits

instance
  (c ~ Crypto era, script ~ Core.Script era) =>
  HasField "scriptWits" (ValidatedTx era) (Map.Map (ScriptHash c) script)
  where
  getField :: ValidatedTx era -> Map (ScriptHash c) script
getField = TxWitness era -> Map (ScriptHash c) script
forall era.
TxWitness era -> Map (ScriptHash (Crypto era)) (Script era)
txscripts' (TxWitness era -> Map (ScriptHash c) script)
-> (ValidatedTx era -> TxWitness era)
-> ValidatedTx era
-> Map (ScriptHash c) script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidatedTx era -> TxWitness era
forall era. ValidatedTx era -> TxWitness era
wits

instance
  c ~ Crypto era =>
  HasField "bootWits" (ValidatedTx era) (Set (BootstrapWitness c))
  where
  getField :: ValidatedTx era -> Set (BootstrapWitness c)
getField = TxWitness era -> Set (BootstrapWitness c)
forall era. TxWitness era -> Set (BootstrapWitness (Crypto era))
txwitsBoot' (TxWitness era -> Set (BootstrapWitness c))
-> (ValidatedTx era -> TxWitness era)
-> ValidatedTx era
-> Set (BootstrapWitness c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidatedTx era -> TxWitness era
forall era. ValidatedTx era -> TxWitness era
wits

instance
  c ~ Crypto era =>
  HasField "txdatahash" (ValidatedTx era) (Map.Map (DataHash c) (Data era))
  where
  getField :: ValidatedTx era -> Map (DataHash c) (Data era)
getField = TxDats era -> Map (DataHash c) (Data era)
forall era. TxDats era -> Map (DataHash (Crypto era)) (Data era)
unTxDats (TxDats era -> Map (DataHash c) (Data era))
-> (ValidatedTx era -> TxDats era)
-> ValidatedTx era
-> Map (DataHash c) (Data era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxWitness era -> TxDats era
forall era. TxWitness era -> TxDats era
txdats' (TxWitness era -> TxDats era)
-> (ValidatedTx era -> TxWitness era)
-> ValidatedTx era
-> TxDats era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidatedTx era -> TxWitness era
forall era. ValidatedTx era -> TxWitness era
wits

-- =========================================================
-- Figure 2: Definitions for Transactions

getCoin :: (Era era) => Core.TxOut era -> Coin
getCoin :: TxOut era -> Coin
getCoin TxOut era
txout = Value era -> Coin
forall t. Val t => t -> Coin
coin (TxOut era -> Value era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"value" TxOut era
txout)

-- | A ScriptIntegrityHash is the hash of three things.  The first two come
-- from the witnesses and the last comes from the Protocol Parameters.
data ScriptIntegrity era
  = ScriptIntegrity
      !(Redeemers era) -- From the witnesses
      !(TxDats era)
      !(Set LangDepView) -- From the Porotocl parameters
  deriving (Int -> ScriptIntegrity era -> ShowS
[ScriptIntegrity era] -> ShowS
ScriptIntegrity era -> String
(Int -> ScriptIntegrity era -> ShowS)
-> (ScriptIntegrity era -> String)
-> ([ScriptIntegrity era] -> ShowS)
-> Show (ScriptIntegrity era)
forall era. Int -> ScriptIntegrity era -> ShowS
forall era. [ScriptIntegrity era] -> ShowS
forall era. ScriptIntegrity era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptIntegrity era] -> ShowS
$cshowList :: forall era. [ScriptIntegrity era] -> ShowS
show :: ScriptIntegrity era -> String
$cshow :: forall era. ScriptIntegrity era -> String
showsPrec :: Int -> ScriptIntegrity era -> ShowS
$cshowsPrec :: forall era. Int -> ScriptIntegrity era -> ShowS
Show, ScriptIntegrity era -> ScriptIntegrity era -> Bool
(ScriptIntegrity era -> ScriptIntegrity era -> Bool)
-> (ScriptIntegrity era -> ScriptIntegrity era -> Bool)
-> Eq (ScriptIntegrity era)
forall era. ScriptIntegrity era -> ScriptIntegrity era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptIntegrity era -> ScriptIntegrity era -> Bool
$c/= :: forall era. ScriptIntegrity era -> ScriptIntegrity era -> Bool
== :: ScriptIntegrity era -> ScriptIntegrity era -> Bool
$c== :: forall era. ScriptIntegrity era -> ScriptIntegrity era -> Bool
Eq, (forall x. ScriptIntegrity era -> Rep (ScriptIntegrity era) x)
-> (forall x. Rep (ScriptIntegrity era) x -> ScriptIntegrity era)
-> Generic (ScriptIntegrity era)
forall x. Rep (ScriptIntegrity era) x -> ScriptIntegrity era
forall x. ScriptIntegrity era -> Rep (ScriptIntegrity era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ScriptIntegrity era) x -> ScriptIntegrity era
forall era x. ScriptIntegrity era -> Rep (ScriptIntegrity era) x
$cto :: forall era x. Rep (ScriptIntegrity era) x -> ScriptIntegrity era
$cfrom :: forall era x. ScriptIntegrity era -> Rep (ScriptIntegrity era) x
Generic, Typeable)

deriving instance Typeable era => NoThunks (ScriptIntegrity era)

-- ScriptIntegrity is not transmitted over the network. The bytes are independently
-- reconstructed by all nodes. There are no original bytes to preserve.
-- Instead, we must use a reproducable serialization
instance Era era => SafeToHash (ScriptIntegrity era) where
  originalBytes :: ScriptIntegrity era -> ByteString
originalBytes (ScriptIntegrity Redeemers era
m TxDats era
d Set LangDepView
l) =
    let dBytes :: ByteString
dBytes = if TxDats era -> Bool
forall era. TxDats era -> Bool
nullDats TxDats era
d then ByteString
forall a. Monoid a => a
mempty else TxDats era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes TxDats era
d
        lBytes :: ByteString
lBytes = Encoding -> ByteString
serializeEncoding' (Set LangDepView -> Encoding
encodeLangViews Set LangDepView
l)
     in Redeemers era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes Redeemers era
m ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
dBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
lBytes

instance (Era era, c ~ Crypto era) => HashAnnotated (ScriptIntegrity era) EraIndependentScriptIntegrity c

hashScriptIntegrity ::
  forall era.
  Era era =>
  Set LangDepView ->
  Redeemers era ->
  TxDats era ->
  StrictMaybe (ScriptIntegrityHash (Crypto era))
hashScriptIntegrity :: Set LangDepView
-> Redeemers era
-> TxDats era
-> StrictMaybe (ScriptIntegrityHash (Crypto era))
hashScriptIntegrity Set LangDepView
langViews Redeemers era
rdmrs TxDats era
dats =
  if Redeemers era -> Bool
forall era. Redeemers era -> Bool
nullRedeemers Redeemers era
rdmrs Bool -> Bool -> Bool
&& Set LangDepView -> Bool
forall a. Set a -> Bool
Set.null Set LangDepView
langViews Bool -> Bool -> Bool
&& TxDats era -> Bool
forall era. TxDats era -> Bool
nullDats TxDats era
dats
    then StrictMaybe (ScriptIntegrityHash (Crypto era))
forall a. StrictMaybe a
SNothing
    else ScriptIntegrityHash (Crypto era)
-> StrictMaybe (ScriptIntegrityHash (Crypto era))
forall a. a -> StrictMaybe a
SJust (ScriptIntegrity era -> ScriptIntegrityHash (Crypto era)
forall c i x.
(HasAlgorithm c, HashAnnotated x i c) =>
x -> SafeHash c i
hashAnnotated (Redeemers era
-> TxDats era -> Set LangDepView -> ScriptIntegrity era
forall era.
Redeemers era
-> TxDats era -> Set LangDepView -> ScriptIntegrity era
ScriptIntegrity Redeemers era
rdmrs TxDats era
dats Set LangDepView
langViews))

-- ===============================================================
-- From the specification, Figure 4 "Functions related to fees"
-- ===============================================================

isTwoPhaseScriptAddress ::
  forall era.
  (ValidateScript era) =>
  ValidatedTx era ->
  Addr (Crypto era) ->
  Bool
isTwoPhaseScriptAddress :: ValidatedTx era -> Addr (Crypto era) -> Bool
isTwoPhaseScriptAddress ValidatedTx era
tx = Map (ScriptHash (Crypto era)) (Script era)
-> Addr (Crypto era) -> Bool
forall era.
ValidateScript era =>
Map (ScriptHash (Crypto era)) (Script era)
-> Addr (Crypto era) -> Bool
isTwoPhaseScriptAddressFromMap @era (ValidatedTx era -> Map (ScriptHash (Crypto era)) (Script era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"scriptWits" ValidatedTx era
tx)

-- | txsize computes the length of the serialised bytes
instance
  ( Typeable era,
    ToCBOR (Core.TxBody era),
    ToCBOR (Core.AuxiliaryData era)
  ) =>
  HasField "txsize" (ValidatedTx era) Integer
  where
  getField :: ValidatedTx era -> Integer
getField ValidatedTx era
tx =
    Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Integer) -> (Encoding -> Int64) -> Encoding -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
LBS.length (ByteString -> Int64)
-> (Encoding -> ByteString) -> Encoding -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
serializeEncoding (Encoding -> Integer) -> Encoding -> Integer
forall a b. (a -> b) -> a -> b
$
      ValidatedTx era -> Encoding
forall era.
(Typeable era, ToCBOR (TxBody era), ToCBOR (AuxiliaryData era)) =>
ValidatedTx era -> Encoding
toCBORForSizeComputation ValidatedTx era
tx

-- | This ensures that the size of transactions from Mary is unchanged.
-- The individual components all store their bytes; the only work we do in this
-- function is concatenating
toCBORForSizeComputation ::
  ( Typeable era,
    ToCBOR (Core.TxBody era),
    ToCBOR (Core.AuxiliaryData era)
  ) =>
  ValidatedTx era ->
  Encoding
toCBORForSizeComputation :: ValidatedTx era -> Encoding
toCBORForSizeComputation ValidatedTx {TxBody era
body :: TxBody era
body :: forall era. ValidatedTx era -> TxBody era
body, TxWitness era
wits :: TxWitness era
wits :: forall era. ValidatedTx era -> TxWitness era
wits, StrictMaybe (AuxiliaryData era)
auxiliaryData :: StrictMaybe (AuxiliaryData era)
auxiliaryData :: forall era. ValidatedTx era -> StrictMaybe (AuxiliaryData era)
auxiliaryData} =
  Word -> Encoding
encodeListLen Word
3
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxBody era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TxBody era
body
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxWitness era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TxWitness era
wits
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (AuxiliaryData era -> Encoding)
-> Maybe (AuxiliaryData era) -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe AuxiliaryData era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (StrictMaybe (AuxiliaryData era) -> Maybe (AuxiliaryData era)
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (AuxiliaryData era)
auxiliaryData)

minfee ::
  ( HasField "_minfeeA" (Core.PParams era) Natural,
    HasField "_minfeeB" (Core.PParams era) Natural,
    HasField "_prices" (Core.PParams era) Prices,
    HasField "wits" (Core.Tx era) (Core.Witnesses era),
    HasField "txrdmrs" (Core.Witnesses era) (Redeemers era),
    HasField "txsize" (Core.Tx era) Integer
  ) =>
  Core.PParams era ->
  Core.Tx era ->
  Coin
minfee :: PParams era -> Tx era -> Coin
minfee PParams era
pp Tx era
tx =
  (Tx era -> Integer
forall k (x :: k) r a. HasField x r a => r -> a
getField @"txsize" Tx era
tx Integer -> Coin -> Coin
forall t i. (Val t, Integral i) => i -> t -> t
<×> PParams era -> Coin
forall a r. (Integral a, HasField "_minfeeA" r a) => r -> Coin
a PParams era
pp)
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> PParams era -> Coin
forall a r. (Integral a, HasField "_minfeeB" r a) => r -> Coin
b PParams era
pp
    Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Prices -> ExUnits -> Coin
txscriptfee (PParams era -> Prices
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_prices" PParams era
pp) ExUnits
allExunits
  where
    a :: r -> Coin
a r
protparam = Integer -> Coin
Coin (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (r -> a
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_minfeeA" r
protparam))
    b :: r -> Coin
b r
protparam = Integer -> Coin
Coin (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (r -> a
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_minfeeB" r
protparam))
    allExunits :: ExUnits
allExunits = Tx era -> ExUnits
forall era.
(HasField "wits" (Tx era) (Witnesses era),
 HasField "txrdmrs" (Witnesses era) (Redeemers era)) =>
Tx era -> ExUnits
totExUnits Tx era
tx

totExUnits ::
  ( HasField "wits" (Core.Tx era) (Core.Witnesses era),
    HasField "txrdmrs" (Core.Witnesses era) (Redeemers era)
  ) =>
  Core.Tx era ->
  ExUnits
totExUnits :: Tx era -> ExUnits
totExUnits = ((Data era, ExUnits) -> ExUnits)
-> [(Data era, ExUnits)] -> ExUnits
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Data era, ExUnits) -> ExUnits
forall a b. (a, b) -> b
snd ([(Data era, ExUnits)] -> ExUnits)
-> (Tx era -> [(Data era, ExUnits)]) -> Tx era -> ExUnits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map RdmrPtr (Data era, ExUnits) -> [(Data era, ExUnits)]
forall k a. Map k a -> [a]
Map.elems (Map RdmrPtr (Data era, ExUnits) -> [(Data era, ExUnits)])
-> (Tx era -> Map RdmrPtr (Data era, ExUnits))
-> Tx era
-> [(Data era, ExUnits)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redeemers era -> Map RdmrPtr (Data era, ExUnits)
forall era. Redeemers era -> Map RdmrPtr (Data era, ExUnits)
unRedeemers (Redeemers era -> Map RdmrPtr (Data era, ExUnits))
-> (Tx era -> Redeemers era)
-> Tx era
-> Map RdmrPtr (Data era, ExUnits)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "txrdmrs" r a => r -> a
getField @"txrdmrs" (Witnesses era -> Redeemers era)
-> (Tx era -> Witnesses era) -> Tx era -> Redeemers era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "wits" r a => r -> a
getField @"wits"

-- ===============================================================
-- Operations on scripts from specification
-- Figure 6:Indexing script and data objects
-- ===============================================================

data ScriptPurpose crypto
  = Minting !(PolicyID crypto)
  | Spending !(TxIn crypto)
  | Rewarding !(RewardAcnt crypto) -- Not sure if this is the right type.
  | Certifying !(DCert crypto)
  deriving (ScriptPurpose crypto -> ScriptPurpose crypto -> Bool
(ScriptPurpose crypto -> ScriptPurpose crypto -> Bool)
-> (ScriptPurpose crypto -> ScriptPurpose crypto -> Bool)
-> Eq (ScriptPurpose crypto)
forall crypto. ScriptPurpose crypto -> ScriptPurpose crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptPurpose crypto -> ScriptPurpose crypto -> Bool
$c/= :: forall crypto. ScriptPurpose crypto -> ScriptPurpose crypto -> Bool
== :: ScriptPurpose crypto -> ScriptPurpose crypto -> Bool
$c== :: forall crypto. ScriptPurpose crypto -> ScriptPurpose crypto -> Bool
Eq, Int -> ScriptPurpose crypto -> ShowS
[ScriptPurpose crypto] -> ShowS
ScriptPurpose crypto -> String
(Int -> ScriptPurpose crypto -> ShowS)
-> (ScriptPurpose crypto -> String)
-> ([ScriptPurpose crypto] -> ShowS)
-> Show (ScriptPurpose crypto)
forall crypto. Int -> ScriptPurpose crypto -> ShowS
forall crypto. [ScriptPurpose crypto] -> ShowS
forall crypto. ScriptPurpose crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptPurpose crypto] -> ShowS
$cshowList :: forall crypto. [ScriptPurpose crypto] -> ShowS
show :: ScriptPurpose crypto -> String
$cshow :: forall crypto. ScriptPurpose crypto -> String
showsPrec :: Int -> ScriptPurpose crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> ScriptPurpose crypto -> ShowS
Show, (forall x. ScriptPurpose crypto -> Rep (ScriptPurpose crypto) x)
-> (forall x. Rep (ScriptPurpose crypto) x -> ScriptPurpose crypto)
-> Generic (ScriptPurpose crypto)
forall x. Rep (ScriptPurpose crypto) x -> ScriptPurpose crypto
forall x. ScriptPurpose crypto -> Rep (ScriptPurpose crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (ScriptPurpose crypto) x -> ScriptPurpose crypto
forall crypto x.
ScriptPurpose crypto -> Rep (ScriptPurpose crypto) x
$cto :: forall crypto x.
Rep (ScriptPurpose crypto) x -> ScriptPurpose crypto
$cfrom :: forall crypto x.
ScriptPurpose crypto -> Rep (ScriptPurpose crypto) x
Generic, Context -> ScriptPurpose crypto -> IO (Maybe ThunkInfo)
Proxy (ScriptPurpose crypto) -> String
(Context -> ScriptPurpose crypto -> IO (Maybe ThunkInfo))
-> (Context -> ScriptPurpose crypto -> IO (Maybe ThunkInfo))
-> (Proxy (ScriptPurpose crypto) -> String)
-> NoThunks (ScriptPurpose crypto)
forall crypto.
Context -> ScriptPurpose crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (ScriptPurpose crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (ScriptPurpose crypto) -> String
$cshowTypeOf :: forall crypto. Proxy (ScriptPurpose crypto) -> String
wNoThunks :: Context -> ScriptPurpose crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto.
Context -> ScriptPurpose crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> ScriptPurpose crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto.
Context -> ScriptPurpose crypto -> IO (Maybe ThunkInfo)
NoThunks, ScriptPurpose crypto -> ()
(ScriptPurpose crypto -> ()) -> NFData (ScriptPurpose crypto)
forall crypto. Crypto crypto => ScriptPurpose crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: ScriptPurpose crypto -> ()
$crnf :: forall crypto. Crypto crypto => ScriptPurpose crypto -> ()
NFData)

instance (Typeable c, CC.Crypto c) => ToCBOR (ScriptPurpose c) where
  toCBOR :: ScriptPurpose c -> Encoding
toCBOR (Minting PolicyID c
x) = Encode 'Open (ScriptPurpose c) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode ((PolicyID c -> ScriptPurpose c)
-> Word -> Encode 'Open (PolicyID c -> ScriptPurpose c)
forall t. t -> Word -> Encode 'Open t
Sum PolicyID c -> ScriptPurpose c
forall crypto. PolicyID crypto -> ScriptPurpose crypto
Minting Word
0 Encode 'Open (PolicyID c -> ScriptPurpose c)
-> Encode ('Closed 'Dense) (PolicyID c)
-> Encode 'Open (ScriptPurpose c)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PolicyID c -> Encode ('Closed 'Dense) (PolicyID c)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To PolicyID c
x)
  toCBOR (Spending TxIn c
x) = Encode 'Open (ScriptPurpose c) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode ((TxIn c -> ScriptPurpose c)
-> Word -> Encode 'Open (TxIn c -> ScriptPurpose c)
forall t. t -> Word -> Encode 'Open t
Sum TxIn c -> ScriptPurpose c
forall crypto. TxIn crypto -> ScriptPurpose crypto
Spending Word
1 Encode 'Open (TxIn c -> ScriptPurpose c)
-> Encode ('Closed 'Dense) (TxIn c)
-> Encode 'Open (ScriptPurpose c)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxIn c -> Encode ('Closed 'Dense) (TxIn c)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To TxIn c
x)
  toCBOR (Rewarding RewardAcnt c
x) = Encode 'Open (ScriptPurpose c) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode ((RewardAcnt c -> ScriptPurpose c)
-> Word -> Encode 'Open (RewardAcnt c -> ScriptPurpose c)
forall t. t -> Word -> Encode 'Open t
Sum RewardAcnt c -> ScriptPurpose c
forall crypto. RewardAcnt crypto -> ScriptPurpose crypto
Rewarding Word
2 Encode 'Open (RewardAcnt c -> ScriptPurpose c)
-> Encode ('Closed 'Dense) (RewardAcnt c)
-> Encode 'Open (ScriptPurpose c)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> RewardAcnt c -> Encode ('Closed 'Dense) (RewardAcnt c)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To RewardAcnt c
x)
  toCBOR (Certifying DCert c
x) = Encode 'Open (ScriptPurpose c) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode ((DCert c -> ScriptPurpose c)
-> Word -> Encode 'Open (DCert c -> ScriptPurpose c)
forall t. t -> Word -> Encode 'Open t
Sum DCert c -> ScriptPurpose c
forall crypto. DCert crypto -> ScriptPurpose crypto
Certifying Word
3 Encode 'Open (DCert c -> ScriptPurpose c)
-> Encode ('Closed 'Dense) (DCert c)
-> Encode 'Open (ScriptPurpose c)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> DCert c -> Encode ('Closed 'Dense) (DCert c)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To DCert c
x)

instance (Typeable c, CC.Crypto c) => FromCBOR (ScriptPurpose c) where
  fromCBOR :: Decoder s (ScriptPurpose c)
fromCBOR = Decode ('Closed 'Dense) (ScriptPurpose c)
-> Decoder s (ScriptPurpose c)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (String
-> (Word -> Decode 'Open (ScriptPurpose c))
-> Decode ('Closed 'Dense) (ScriptPurpose c)
forall t.
String -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands String
"ScriptPurpose" Word -> Decode 'Open (ScriptPurpose c)
forall crypto.
Crypto crypto =>
Word -> Decode 'Open (ScriptPurpose crypto)
dec)
    where
      dec :: Word -> Decode 'Open (ScriptPurpose crypto)
dec Word
0 = (PolicyID crypto -> ScriptPurpose crypto)
-> Decode 'Open (PolicyID crypto -> ScriptPurpose crypto)
forall t. t -> Decode 'Open t
SumD PolicyID crypto -> ScriptPurpose crypto
forall crypto. PolicyID crypto -> ScriptPurpose crypto
Minting Decode 'Open (PolicyID crypto -> ScriptPurpose crypto)
-> Decode ('Closed Any) (PolicyID crypto)
-> Decode 'Open (ScriptPurpose crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (PolicyID crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
1 = (TxIn crypto -> ScriptPurpose crypto)
-> Decode 'Open (TxIn crypto -> ScriptPurpose crypto)
forall t. t -> Decode 'Open t
SumD TxIn crypto -> ScriptPurpose crypto
forall crypto. TxIn crypto -> ScriptPurpose crypto
Spending Decode 'Open (TxIn crypto -> ScriptPurpose crypto)
-> Decode ('Closed Any) (TxIn crypto)
-> Decode 'Open (ScriptPurpose crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (TxIn crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
2 = (RewardAcnt crypto -> ScriptPurpose crypto)
-> Decode 'Open (RewardAcnt crypto -> ScriptPurpose crypto)
forall t. t -> Decode 'Open t
SumD RewardAcnt crypto -> ScriptPurpose crypto
forall crypto. RewardAcnt crypto -> ScriptPurpose crypto
Rewarding Decode 'Open (RewardAcnt crypto -> ScriptPurpose crypto)
-> Decode ('Closed Any) (RewardAcnt crypto)
-> Decode 'Open (ScriptPurpose crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (RewardAcnt crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
3 = (DCert crypto -> ScriptPurpose crypto)
-> Decode 'Open (DCert crypto -> ScriptPurpose crypto)
forall t. t -> Decode 'Open t
SumD DCert crypto -> ScriptPurpose crypto
forall crypto. DCert crypto -> ScriptPurpose crypto
Certifying Decode 'Open (DCert crypto -> ScriptPurpose crypto)
-> Decode ('Closed Any) (DCert crypto)
-> Decode 'Open (ScriptPurpose crypto)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (DCert crypto)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
      dec Word
n = Word -> Decode 'Open (ScriptPurpose crypto)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

-- =======================================

class Indexable elem container where
  indexOf :: elem -> container -> StrictMaybe Word64
  fromIndex :: Word64 -> container -> StrictMaybe elem

instance Ord k => Indexable k (Set k) where
  indexOf :: k -> Set k -> StrictMaybe Word64
indexOf k
n Set k
set = case k -> Set k -> Maybe Int
forall a. Ord a => a -> Set a -> Maybe Int
Set.lookupIndex k
n Set k
set of
    Just Int
x -> Word64 -> StrictMaybe Word64
forall a. a -> StrictMaybe a
SJust (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
    Maybe Int
Nothing -> StrictMaybe Word64
forall a. StrictMaybe a
SNothing
  fromIndex :: Word64 -> Set k -> StrictMaybe k
fromIndex Word64
i Set k
set =
    if Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Set k -> Int
forall a. Set a -> Int
Set.size Set k
set
      then k -> StrictMaybe k
forall a. a -> StrictMaybe a
SJust (k -> StrictMaybe k) -> k -> StrictMaybe k
forall a b. (a -> b) -> a -> b
$ Int -> Set k -> k
forall a. Int -> Set a -> a
Set.elemAt (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i) Set k
set
      else StrictMaybe k
forall a. StrictMaybe a
SNothing

instance Eq k => Indexable k (StrictSeq k) where
  indexOf :: k -> StrictSeq k -> StrictMaybe Word64
indexOf k
n StrictSeq k
seqx = case (k -> Bool) -> StrictSeq k -> Maybe Int
forall a. (a -> Bool) -> StrictSeq a -> Maybe Int
StrictSeq.findIndexL (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
n) StrictSeq k
seqx of
    Just Int
m -> Word64 -> StrictMaybe Word64
forall a. a -> StrictMaybe a
SJust (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)
    Maybe Int
Nothing -> StrictMaybe Word64
forall a. StrictMaybe a
SNothing
  fromIndex :: Word64 -> StrictSeq k -> StrictMaybe k
fromIndex Word64
i StrictSeq k
seqx = Maybe k -> StrictMaybe k
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe k -> StrictMaybe k) -> Maybe k -> StrictMaybe k
forall a b. (a -> b) -> a -> b
$ Int -> StrictSeq k -> Maybe k
forall a. Int -> StrictSeq a -> Maybe a
StrictSeq.lookup (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i) StrictSeq k
seqx

instance Ord k => Indexable k (Map.Map k v) where
  indexOf :: k -> Map k v -> StrictMaybe Word64
indexOf k
n Map k v
mp = case k -> Map k v -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe Int
Map.lookupIndex k
n Map k v
mp of
    Just Int
x -> Word64 -> StrictMaybe Word64
forall a. a -> StrictMaybe a
SJust (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
    Maybe Int
Nothing -> StrictMaybe Word64
forall a. StrictMaybe a
SNothing
  fromIndex :: Word64 -> Map k v -> StrictMaybe k
fromIndex Word64
i Map k v
mp =
    if Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Map k v -> Int
forall k a. Map k a -> Int
Map.size Map k v
mp
      then k -> StrictMaybe k
forall a. a -> StrictMaybe a
SJust (k -> StrictMaybe k) -> ((k, v) -> k) -> (k, v) -> StrictMaybe k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, v) -> k
forall a b. (a, b) -> a
fst ((k, v) -> StrictMaybe k) -> (k, v) -> StrictMaybe k
forall a b. (a -> b) -> a -> b
$ Int -> Map k v -> (k, v)
forall k a. Int -> Map k a -> (k, a)
Map.elemAt (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i) Map k v
mp
      else StrictMaybe k
forall a. StrictMaybe a
SNothing

rdptr ::
  forall era.
  ( HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
    HasField "minted" (Core.TxBody era) (Set (ScriptHash (Crypto era)))
  ) =>
  Core.TxBody era ->
  ScriptPurpose (Crypto era) ->
  StrictMaybe RdmrPtr
rdptr :: TxBody era -> ScriptPurpose (Crypto era) -> StrictMaybe RdmrPtr
rdptr TxBody era
txb (Minting (PolicyID ScriptHash (Crypto era)
hash)) =
  Tag -> Word64 -> RdmrPtr
RdmrPtr Tag
Mint (Word64 -> RdmrPtr) -> StrictMaybe Word64 -> StrictMaybe RdmrPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptHash (Crypto era)
-> Set (ScriptHash (Crypto era)) -> StrictMaybe Word64
forall elem container.
Indexable elem container =>
elem -> container -> StrictMaybe Word64
indexOf ScriptHash (Crypto era)
hash (TxBody era -> Set (ScriptHash (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"minted" TxBody era
txb :: Set (ScriptHash (Crypto era)))
rdptr TxBody era
txb (Spending TxIn (Crypto era)
txin) = Tag -> Word64 -> RdmrPtr
RdmrPtr Tag
Spend (Word64 -> RdmrPtr) -> StrictMaybe Word64 -> StrictMaybe RdmrPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxIn (Crypto era) -> Set (TxIn (Crypto era)) -> StrictMaybe Word64
forall elem container.
Indexable elem container =>
elem -> container -> StrictMaybe Word64
indexOf TxIn (Crypto era)
txin (TxBody era -> Set (TxIn (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"inputs" TxBody era
txb)
rdptr TxBody era
txb (Rewarding RewardAcnt (Crypto era)
racnt) = Tag -> Word64 -> RdmrPtr
RdmrPtr Tag
Rewrd (Word64 -> RdmrPtr) -> StrictMaybe Word64 -> StrictMaybe RdmrPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RewardAcnt (Crypto era)
-> Map (RewardAcnt (Crypto era)) Coin -> StrictMaybe Word64
forall elem container.
Indexable elem container =>
elem -> container -> StrictMaybe Word64
indexOf RewardAcnt (Crypto era)
racnt (Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin
forall crypto. Wdrl crypto -> Map (RewardAcnt crypto) Coin
unWdrl (TxBody era -> Wdrl (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wdrls" TxBody era
txb))
rdptr TxBody era
txb (Certifying DCert (Crypto era)
d) = Tag -> Word64 -> RdmrPtr
RdmrPtr Tag
Cert (Word64 -> RdmrPtr) -> StrictMaybe Word64 -> StrictMaybe RdmrPtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DCert (Crypto era)
-> StrictSeq (DCert (Crypto era)) -> StrictMaybe Word64
forall elem container.
Indexable elem container =>
elem -> container -> StrictMaybe Word64
indexOf DCert (Crypto era)
d (TxBody era -> StrictSeq (DCert (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"certs" TxBody era
txb)

rdptrInv ::
  forall era.
  ( HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
    HasField "minted" (Core.TxBody era) (Set (ScriptHash (Crypto era)))
  ) =>
  Core.TxBody era ->
  RdmrPtr ->
  StrictMaybe (ScriptPurpose (Crypto era))
rdptrInv :: TxBody era -> RdmrPtr -> StrictMaybe (ScriptPurpose (Crypto era))
rdptrInv TxBody era
txb (RdmrPtr Tag
Mint Word64
idx) =
  PolicyID (Crypto era) -> ScriptPurpose (Crypto era)
forall crypto. PolicyID crypto -> ScriptPurpose crypto
Minting (PolicyID (Crypto era) -> ScriptPurpose (Crypto era))
-> (ScriptHash (Crypto era) -> PolicyID (Crypto era))
-> ScriptHash (Crypto era)
-> ScriptPurpose (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash (Crypto era) -> PolicyID (Crypto era)
forall crypto. ScriptHash crypto -> PolicyID crypto
PolicyID (ScriptHash (Crypto era) -> ScriptPurpose (Crypto era))
-> StrictMaybe (ScriptHash (Crypto era))
-> StrictMaybe (ScriptPurpose (Crypto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64
-> Set (ScriptHash (Crypto era))
-> StrictMaybe (ScriptHash (Crypto era))
forall elem container.
Indexable elem container =>
Word64 -> container -> StrictMaybe elem
fromIndex Word64
idx (TxBody era -> Set (ScriptHash (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"minted" TxBody era
txb)
rdptrInv TxBody era
txb (RdmrPtr Tag
Spend Word64
idx) =
  TxIn (Crypto era) -> ScriptPurpose (Crypto era)
forall crypto. TxIn crypto -> ScriptPurpose crypto
Spending (TxIn (Crypto era) -> ScriptPurpose (Crypto era))
-> StrictMaybe (TxIn (Crypto era))
-> StrictMaybe (ScriptPurpose (Crypto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64
-> Set (TxIn (Crypto era)) -> StrictMaybe (TxIn (Crypto era))
forall elem container.
Indexable elem container =>
Word64 -> container -> StrictMaybe elem
fromIndex Word64
idx (TxBody era -> Set (TxIn (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"inputs" TxBody era
txb)
rdptrInv TxBody era
txb (RdmrPtr Tag
Rewrd Word64
idx) =
  RewardAcnt (Crypto era) -> ScriptPurpose (Crypto era)
forall crypto. RewardAcnt crypto -> ScriptPurpose crypto
Rewarding (RewardAcnt (Crypto era) -> ScriptPurpose (Crypto era))
-> StrictMaybe (RewardAcnt (Crypto era))
-> StrictMaybe (ScriptPurpose (Crypto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64
-> Map (RewardAcnt (Crypto era)) Coin
-> StrictMaybe (RewardAcnt (Crypto era))
forall elem container.
Indexable elem container =>
Word64 -> container -> StrictMaybe elem
fromIndex Word64
idx (Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin
forall crypto. Wdrl crypto -> Map (RewardAcnt crypto) Coin
unWdrl (TxBody era -> Wdrl (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wdrls" TxBody era
txb))
rdptrInv TxBody era
txb (RdmrPtr Tag
Cert Word64
idx) =
  DCert (Crypto era) -> ScriptPurpose (Crypto era)
forall crypto. DCert crypto -> ScriptPurpose crypto
Certifying (DCert (Crypto era) -> ScriptPurpose (Crypto era))
-> StrictMaybe (DCert (Crypto era))
-> StrictMaybe (ScriptPurpose (Crypto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64
-> StrictSeq (DCert (Crypto era))
-> StrictMaybe (DCert (Crypto era))
forall elem container.
Indexable elem container =>
Word64 -> container -> StrictMaybe elem
fromIndex Word64
idx (TxBody era -> StrictSeq (DCert (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"certs" TxBody era
txb)

getMapFromValue :: Value crypto -> Map.Map (PolicyID crypto) (Map.Map AssetName Integer)
getMapFromValue :: Value crypto -> Map (PolicyID crypto) (Map AssetName Integer)
getMapFromValue (Value Integer
_ Map (PolicyID crypto) (Map AssetName Integer)
m) = Map (PolicyID crypto) (Map AssetName Integer)
m

-- | Find the Data and ExUnits assigned to a script.
indexedRdmrs ::
  forall era tx.
  ( Era era,
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
    HasField "wits" tx (TxWitness era),
    HasField "body" tx (Core.TxBody era)
  ) =>
  tx ->
  ScriptPurpose (Crypto era) ->
  Maybe (Data era, ExUnits)
indexedRdmrs :: tx -> ScriptPurpose (Crypto era) -> Maybe (Data era, ExUnits)
indexedRdmrs tx
tx ScriptPurpose (Crypto era)
sp = case TxBody era -> ScriptPurpose (Crypto era) -> StrictMaybe RdmrPtr
forall era.
(HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField "wdrls" (TxBody era) (Wdrl (Crypto era)),
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))),
 HasField "minted" (TxBody era) (Set (ScriptHash (Crypto era)))) =>
TxBody era -> ScriptPurpose (Crypto era) -> StrictMaybe RdmrPtr
rdptr @era (tx -> TxBody era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"body" tx
tx) ScriptPurpose (Crypto era)
sp of
  StrictMaybe RdmrPtr
SNothing -> Maybe (Data era, ExUnits)
forall a. Maybe a
Nothing
  SJust RdmrPtr
rPtr -> RdmrPtr
-> Map RdmrPtr (Data era, ExUnits) -> Maybe (Data era, ExUnits)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RdmrPtr
rPtr Map RdmrPtr (Data era, ExUnits)
rdmrs
    where
      rdmrs :: Map RdmrPtr (Data era, ExUnits)
rdmrs = Redeemers era -> Map RdmrPtr (Data era, ExUnits)
forall era. Redeemers era -> Map RdmrPtr (Data era, ExUnits)
unRedeemers (Redeemers era -> Map RdmrPtr (Data era, ExUnits))
-> Redeemers era -> Map RdmrPtr (Data era, ExUnits)
forall a b. (a -> b) -> a -> b
$ TxWitness era -> Redeemers era
forall era. TxWitness era -> Redeemers era
txrdmrs' (TxWitness era -> Redeemers era)
-> (tx -> TxWitness era) -> tx -> Redeemers era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "wits" r a => r -> a
getField @"wits" (tx -> Redeemers era) -> tx -> Redeemers era
forall a b. (a -> b) -> a -> b
$ tx
tx

--------------------------------------------------------------------------------
-- Serialisation
--------------------------------------------------------------------------------

deriving newtype instance FromCBOR IsValid

deriving newtype instance ToCBOR IsValid

segwitTx ::
  Annotator (Core.TxBody era) ->
  Annotator (TxWitness era) ->
  IsValid ->
  Maybe (Annotator (Core.AuxiliaryData era)) ->
  Annotator (ValidatedTx era)
segwitTx :: Annotator (TxBody era)
-> Annotator (TxWitness era)
-> IsValid
-> Maybe (Annotator (AuxiliaryData era))
-> Annotator (ValidatedTx era)
segwitTx
  Annotator (TxBody era)
bodyAnn
  Annotator (TxWitness era)
witsAnn
  IsValid
isval
  Maybe (Annotator (AuxiliaryData era))
metaAnn = (FullByteString -> ValidatedTx era) -> Annotator (ValidatedTx era)
forall a. (FullByteString -> a) -> Annotator a
Annotator ((FullByteString -> ValidatedTx era)
 -> Annotator (ValidatedTx era))
-> (FullByteString -> ValidatedTx era)
-> Annotator (ValidatedTx era)
forall a b. (a -> b) -> a -> b
$ \FullByteString
bytes ->
    let bodyb :: TxBody era
bodyb = Annotator (TxBody era) -> FullByteString -> TxBody era
forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxBody era)
bodyAnn FullByteString
bytes
        witnessSet :: TxWitness era
witnessSet = Annotator (TxWitness era) -> FullByteString -> TxWitness era
forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxWitness era)
witsAnn FullByteString
bytes
        metadata :: Maybe (AuxiliaryData era)
metadata = (Annotator (AuxiliaryData era)
 -> FullByteString -> AuxiliaryData era)
-> FullByteString
-> Annotator (AuxiliaryData era)
-> AuxiliaryData era
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (AuxiliaryData era)
-> FullByteString -> AuxiliaryData era
forall a. Annotator a -> FullByteString -> a
runAnnotator FullByteString
bytes (Annotator (AuxiliaryData era) -> AuxiliaryData era)
-> Maybe (Annotator (AuxiliaryData era))
-> Maybe (AuxiliaryData era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Annotator (AuxiliaryData era))
metaAnn
     in TxBody era
-> TxWitness era
-> IsValid
-> StrictMaybe (AuxiliaryData era)
-> ValidatedTx era
forall era.
TxBody era
-> TxWitness era
-> IsValid
-> StrictMaybe (AuxiliaryData era)
-> ValidatedTx era
ValidatedTx
          TxBody era
bodyb
          TxWitness era
witnessSet
          IsValid
isval
          (Maybe (AuxiliaryData era) -> StrictMaybe (AuxiliaryData era)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (AuxiliaryData era)
metadata)

--------------------------------------------------------------------------------
-- Mempool Serialisation
--
-- We do not store the Tx bytes for the following reasons:
-- - A Tx serialised in this way never forms part of any hashed structure, hence
--   we do not worry about the serialisation changing and thus seeing a new
--   hash.
-- - The three principal components of this Tx already store their own bytes;
--   here we simply concatenate them. The final component, `IsValid`, is
--   just a flag and very cheap to serialise.
--------------------------------------------------------------------------------

-- | Encode to CBOR for the purposes of transmission from node to node, or from
-- wallet to node.
--
-- Note that this serialisation is neither the serialisation used on-chain
-- (where Txs are deconstructed using segwit), nor the serialisation used for
-- computing the transaction size (which omits the `IsValid` field for
-- compatibility with Mary - see 'toCBORForSizeComputation').
toCBORForMempoolSubmission ::
  ( Typeable era,
    ToCBOR (Core.TxBody era),
    ToCBOR (Core.AuxiliaryData era)
  ) =>
  ValidatedTx era ->
  Encoding
toCBORForMempoolSubmission :: ValidatedTx era -> Encoding
toCBORForMempoolSubmission
  ValidatedTx {TxBody era
body :: TxBody era
body :: forall era. ValidatedTx era -> TxBody era
body, TxWitness era
wits :: TxWitness era
wits :: forall era. ValidatedTx era -> TxWitness era
wits, StrictMaybe (AuxiliaryData era)
auxiliaryData :: StrictMaybe (AuxiliaryData era)
auxiliaryData :: forall era. ValidatedTx era -> StrictMaybe (AuxiliaryData era)
auxiliaryData, IsValid
isValid :: IsValid
isValid :: forall era. ValidatedTx era -> IsValid
isValid} =
    Encode ('Closed 'Dense) (ValidatedTx era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (ValidatedTx era) -> Encoding)
-> Encode ('Closed 'Dense) (ValidatedTx era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (TxBody era
 -> TxWitness era
 -> IsValid
 -> StrictMaybe (AuxiliaryData era)
 -> ValidatedTx era)
-> Encode
     ('Closed 'Dense)
     (TxBody era
      -> TxWitness era
      -> IsValid
      -> StrictMaybe (AuxiliaryData era)
      -> ValidatedTx era)
forall t. t -> Encode ('Closed 'Dense) t
Rec TxBody era
-> TxWitness era
-> IsValid
-> StrictMaybe (AuxiliaryData era)
-> ValidatedTx era
forall era.
TxBody era
-> TxWitness era
-> IsValid
-> StrictMaybe (AuxiliaryData era)
-> ValidatedTx era
ValidatedTx
        Encode
  ('Closed 'Dense)
  (TxBody era
   -> TxWitness era
   -> IsValid
   -> StrictMaybe (AuxiliaryData era)
   -> ValidatedTx era)
-> Encode ('Closed 'Dense) (TxBody era)
-> Encode
     ('Closed 'Dense)
     (TxWitness era
      -> IsValid -> StrictMaybe (AuxiliaryData era) -> ValidatedTx era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxBody era -> Encode ('Closed 'Dense) (TxBody era)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To TxBody era
body
        Encode
  ('Closed 'Dense)
  (TxWitness era
   -> IsValid -> StrictMaybe (AuxiliaryData era) -> ValidatedTx era)
-> Encode ('Closed 'Dense) (TxWitness era)
-> Encode
     ('Closed 'Dense)
     (IsValid -> StrictMaybe (AuxiliaryData era) -> ValidatedTx era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxWitness era -> Encode ('Closed 'Dense) (TxWitness era)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To TxWitness era
wits
        Encode
  ('Closed 'Dense)
  (IsValid -> StrictMaybe (AuxiliaryData era) -> ValidatedTx era)
-> Encode ('Closed 'Dense) IsValid
-> Encode
     ('Closed 'Dense)
     (StrictMaybe (AuxiliaryData era) -> ValidatedTx era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> IsValid -> Encode ('Closed 'Dense) IsValid
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To IsValid
isValid
        Encode
  ('Closed 'Dense)
  (StrictMaybe (AuxiliaryData era) -> ValidatedTx era)
-> Encode ('Closed 'Dense) (StrictMaybe (AuxiliaryData era))
-> Encode ('Closed 'Dense) (ValidatedTx era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe (AuxiliaryData era) -> Encoding)
-> StrictMaybe (AuxiliaryData era)
-> Encode ('Closed 'Dense) (StrictMaybe (AuxiliaryData era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ((AuxiliaryData era -> Encoding)
-> Maybe (AuxiliaryData era) -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe AuxiliaryData era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Maybe (AuxiliaryData era) -> Encoding)
-> (StrictMaybe (AuxiliaryData era) -> Maybe (AuxiliaryData era))
-> StrictMaybe (AuxiliaryData era)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMaybe (AuxiliaryData era) -> Maybe (AuxiliaryData era)
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe) StrictMaybe (AuxiliaryData era)
auxiliaryData

instance
  ( Typeable era,
    ToCBOR (Core.TxBody era),
    ToCBOR (Core.AuxiliaryData era)
  ) =>
  ToCBOR (ValidatedTx era)
  where
  toCBOR :: ValidatedTx era -> Encoding
toCBOR = ValidatedTx era -> Encoding
forall era.
(Typeable era, ToCBOR (TxBody era), ToCBOR (AuxiliaryData era)) =>
ValidatedTx era -> Encoding
toCBORForMempoolSubmission

instance
  ( Era era,
    FromCBOR (Annotator (Core.TxBody era)),
    FromCBOR (Annotator (Core.AuxiliaryData era)),
    FromCBOR (Annotator (Core.Witnesses era)),
    ValidateScript era,
    Core.Script era ~ Script era
  ) =>
  FromCBOR (Annotator (ValidatedTx era))
  where
  fromCBOR :: Decoder s (Annotator (ValidatedTx era))
fromCBOR =
    Decode ('Closed 'Dense) (Annotator (ValidatedTx era))
-> Decoder s (Annotator (ValidatedTx era))
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (Annotator (ValidatedTx era))
 -> Decoder s (Annotator (ValidatedTx era)))
-> Decode ('Closed 'Dense) (Annotator (ValidatedTx era))
-> Decoder s (Annotator (ValidatedTx era))
forall a b. (a -> b) -> a -> b
$
      Decode
  ('Closed 'Dense)
  (TxBody era
   -> TxWitness era
   -> IsValid
   -> StrictMaybe (AuxiliaryData era)
   -> ValidatedTx era)
-> Decode
     ('Closed 'Dense)
     (Annotator
        (TxBody era
         -> TxWitness era
         -> IsValid
         -> StrictMaybe (AuxiliaryData era)
         -> ValidatedTx era))
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann ((TxBody era
 -> TxWitness era
 -> IsValid
 -> StrictMaybe (AuxiliaryData era)
 -> ValidatedTx era)
-> Decode
     ('Closed 'Dense)
     (TxBody era
      -> TxWitness era
      -> IsValid
      -> StrictMaybe (AuxiliaryData era)
      -> ValidatedTx era)
forall t. t -> Decode ('Closed 'Dense) t
RecD TxBody era
-> TxWitness era
-> IsValid
-> StrictMaybe (AuxiliaryData era)
-> ValidatedTx era
forall era.
TxBody era
-> TxWitness era
-> IsValid
-> StrictMaybe (AuxiliaryData era)
-> ValidatedTx era
ValidatedTx)
        Decode
  ('Closed 'Dense)
  (Annotator
     (TxBody era
      -> TxWitness era
      -> IsValid
      -> StrictMaybe (AuxiliaryData era)
      -> ValidatedTx era))
-> Decode ('Closed Any) (Annotator (TxBody era))
-> Decode
     ('Closed 'Dense)
     (Annotator
        (TxWitness era
         -> IsValid -> StrictMaybe (AuxiliaryData era) -> ValidatedTx era))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed Any) (Annotator (TxBody era))
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Annotator
     (TxWitness era
      -> IsValid -> StrictMaybe (AuxiliaryData era) -> ValidatedTx era))
-> Decode ('Closed Any) (Annotator (TxWitness era))
-> Decode
     ('Closed 'Dense)
     (Annotator
        (IsValid -> StrictMaybe (AuxiliaryData era) -> ValidatedTx era))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed Any) (Annotator (TxWitness era))
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Annotator
     (IsValid -> StrictMaybe (AuxiliaryData era) -> ValidatedTx era))
-> Decode ('Closed Any) (Annotator IsValid)
-> Decode
     ('Closed 'Dense)
     (Annotator (StrictMaybe (AuxiliaryData era) -> ValidatedTx era))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed Any) IsValid
-> Decode ('Closed Any) (Annotator IsValid)
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann Decode ('Closed Any) IsValid
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Annotator (StrictMaybe (AuxiliaryData era) -> ValidatedTx era))
-> Decode
     ('Closed 'Dense) (Annotator (StrictMaybe (AuxiliaryData era)))
-> Decode ('Closed 'Dense) (Annotator (ValidatedTx era))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! (forall s. Decoder s (Annotator (StrictMaybe (AuxiliaryData era))))
-> Decode
     ('Closed 'Dense) (Annotator (StrictMaybe (AuxiliaryData era)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D
          ( StrictMaybe (Annotator (AuxiliaryData era))
-> Annotator (StrictMaybe (AuxiliaryData era))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (StrictMaybe (Annotator (AuxiliaryData era))
 -> Annotator (StrictMaybe (AuxiliaryData era)))
-> (Maybe (Annotator (AuxiliaryData era))
    -> StrictMaybe (Annotator (AuxiliaryData era)))
-> Maybe (Annotator (AuxiliaryData era))
-> Annotator (StrictMaybe (AuxiliaryData era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Annotator (AuxiliaryData era))
-> StrictMaybe (Annotator (AuxiliaryData era))
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe
              (Maybe (Annotator (AuxiliaryData era))
 -> Annotator (StrictMaybe (AuxiliaryData era)))
-> Decoder s (Maybe (Annotator (AuxiliaryData era)))
-> Decoder s (Annotator (StrictMaybe (AuxiliaryData era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (AuxiliaryData era))
-> Decoder s (Maybe (Annotator (AuxiliaryData era)))
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s (Annotator (AuxiliaryData era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
          )

-- =======================================================================
-- Some generic functions that compute over Tx. We try to be abstract over
-- things that might differ from Era to Era like
--    1) TxOut might have additional fields (uses txOutView from UsesTxOut)
--    2) Scripts might appear in places other than the witness set. So
--       we need such a 'witness' we pass it as a parameter and each call site
--       can use a different method to compute it in the current Era.

-- | Compute if an Addr has the hash of a TwoPhaseScript, we can tell
--   what kind of Script from the Hash, by looking it up in the Map
isTwoPhaseScriptAddressFromMap ::
  forall era.
  (ValidateScript era) =>
  Map.Map (ScriptHash (Crypto era)) (Core.Script era) ->
  Addr (Crypto era) ->
  Bool
isTwoPhaseScriptAddressFromMap :: Map (ScriptHash (Crypto era)) (Script era)
-> Addr (Crypto era) -> Bool
isTwoPhaseScriptAddressFromMap Map (ScriptHash (Crypto era)) (Script era)
hashScriptMap Addr (Crypto era)
addr =
  case Addr (Crypto era) -> Maybe (ScriptHash (Crypto era))
forall crypto. Addr crypto -> Maybe (ScriptHash crypto)
Shelley.getScriptHash @(Crypto era) Addr (Crypto era)
addr of
    Maybe (ScriptHash (Crypto era))
Nothing -> Bool
False
    Just ScriptHash (Crypto era)
hash -> (Script era -> Bool)
-> Map (ScriptHash (Crypto era)) (Script era) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Script era -> Bool
ok Map (ScriptHash (Crypto era)) (Script era)
hashScriptMap
      where
        ok :: Script era -> Bool
ok Script era
script = Script era -> ScriptHash (Crypto era)
forall era.
ValidateScript era =>
Script era -> ScriptHash (Crypto era)
hashScript @era Script era
script ScriptHash (Crypto era) -> ScriptHash (Crypto era) -> Bool
forall a. Eq a => a -> a -> Bool
== ScriptHash (Crypto era)
hash Bool -> Bool -> Bool
&& Bool -> Bool
not (Script era -> Bool
forall era. ValidateScript era => Script era -> Bool
isNativeScript @era Script era
script)

alonzoInputHashes ::
  forall era.
  ( HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    ValidateScript era,
    Core.TxOut era ~ TxOut era
  ) =>
  Map.Map (ScriptHash (Crypto era)) (Core.Script era) ->
  ValidatedTx era ->
  UTxO era ->
  (Set (DataHash (Crypto era)), Set (TxIn (Crypto era)))
alonzoInputHashes :: Map (ScriptHash (Crypto era)) (Script era)
-> ValidatedTx era
-> UTxO era
-> (Set (DataHash (Crypto era)), Set (TxIn (Crypto era)))
alonzoInputHashes Map (ScriptHash (Crypto era)) (Script era)
hashScriptMap ValidatedTx era
tx (UTxO Map (TxIn (Crypto era)) (TxOut era)
mp) = ((Set (DataHash (Crypto era)), Set (TxIn (Crypto era)))
 -> TxIn (Crypto era)
 -> TxOut era
 -> (Set (DataHash (Crypto era)), Set (TxIn (Crypto era))))
-> (Set (DataHash (Crypto era)), Set (TxIn (Crypto era)))
-> Map (TxIn (Crypto era)) (TxOut era)
-> (Set (DataHash (Crypto era)), Set (TxIn (Crypto era)))
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (Set (DataHash (Crypto era)), Set (TxIn (Crypto era)))
-> TxIn (Crypto era)
-> TxOut era
-> (Set (DataHash (Crypto era)), Set (TxIn (Crypto era)))
accum (Set (DataHash (Crypto era))
forall a. Set a
Set.empty, Set (TxIn (Crypto era))
forall a. Set a
Set.empty) Map (TxIn (Crypto era)) (TxOut era)
smallUtxo
  where
    txbody :: TxBody era
txbody = ValidatedTx era -> TxBody era
forall era. ValidatedTx era -> TxBody era
body ValidatedTx era
tx
    spendinputs :: Set (TxIn (Crypto era))
spendinputs = TxBody era -> Set (TxIn (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"inputs" TxBody era
txbody :: Set (TxIn (Crypto era))
    smallUtxo :: Map (TxIn (Crypto era)) (TxOut era)
smallUtxo = Exp (Map (TxIn (Crypto era)) (TxOut era))
-> Map (TxIn (Crypto era)) (TxOut era)
forall s t. Embed s t => Exp t -> s
eval (Set (TxIn (Crypto era))
spendinputs Set (TxIn (Crypto era))
-> Map (TxIn (Crypto era)) (TxOut era)
-> Exp (Map (TxIn (Crypto era)) (TxOut era))
forall k s1 s2 (f :: * -> * -> *) v.
(Ord k, HasExp s1 (Sett k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
◁ Map (TxIn (Crypto era)) (TxOut era)
Map (TxIn (Crypto era)) (TxOut era)
mp)
    accum :: (Set (DataHash (Crypto era)), Set (TxIn (Crypto era)))
-> TxIn (Crypto era)
-> TxOut era
-> (Set (DataHash (Crypto era)), Set (TxIn (Crypto era)))
accum ans :: (Set (DataHash (Crypto era)), Set (TxIn (Crypto era)))
ans@(Set (DataHash (Crypto era))
hashSet, Set (TxIn (Crypto era))
inputSet) TxIn (Crypto era)
txin TxOut era
txout =
      case TxOut era
txout of
        (TxOut Addr (Crypto era)
addr Value era
_ StrictMaybe (DataHash (Crypto era))
SNothing) ->
          if Map (ScriptHash (Crypto era)) (Script era)
-> Addr (Crypto era) -> Bool
forall era.
ValidateScript era =>
Map (ScriptHash (Crypto era)) (Script era)
-> Addr (Crypto era) -> Bool
isTwoPhaseScriptAddressFromMap @era Map (ScriptHash (Crypto era)) (Script era)
hashScriptMap Addr (Crypto era)
addr
            then (Set (DataHash (Crypto era))
hashSet, TxIn (Crypto era)
-> Set (TxIn (Crypto era)) -> Set (TxIn (Crypto era))
forall a. Ord a => a -> Set a -> Set a
Set.insert TxIn (Crypto era)
txin Set (TxIn (Crypto era))
inputSet)
            else (Set (DataHash (Crypto era)), Set (TxIn (Crypto era)))
ans
        (TxOut Addr (Crypto era)
addr Value era
_ (SJust DataHash (Crypto era)
dhash)) ->
          if Map (ScriptHash (Crypto era)) (Script era)
-> Addr (Crypto era) -> Bool
forall era.
ValidateScript era =>
Map (ScriptHash (Crypto era)) (Script era)
-> Addr (Crypto era) -> Bool
isTwoPhaseScriptAddressFromMap @era Map (ScriptHash (Crypto era)) (Script era)
hashScriptMap Addr (Crypto era)
addr
            then (DataHash (Crypto era)
-> Set (DataHash (Crypto era)) -> Set (DataHash (Crypto era))
forall a. Ord a => a -> Set a -> Set a
Set.insert DataHash (Crypto era)
dhash Set (DataHash (Crypto era))
hashSet, Set (TxIn (Crypto era))
inputSet)
            else (Set (DataHash (Crypto era)), Set (TxIn (Crypto era)))
ans