{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- This module provides the main transaction data types used by the wallet.
--
module Cardano.Wallet.Primitive.Types.Tx
    (
    -- * Types
      Tx (..)
    , TxIn (..)
    , TxOut (..)
    , TxChange (..)
    , TxMeta (..)
    , TxMetadata (..)
    , TxMetadataValue (..)
    , TxStatus (..)
    , UnsignedTx (..)
    , TransactionInfo (..)
    , Direction (..)
    , LocalTxSubmissionStatus (..)
    , TokenBundleSizeAssessor (..)
    , TokenBundleSizeAssessment (..)
    , TxScriptValidity(..)
    , ScriptWitnessIndex (..)

    -- * Serialisation
    , SealedTx (serialisedTx)
    , cardanoTxIdeallyNoLaterThan
    , sealedTxFromBytes
    , sealedTxFromBytes'
    , sealedTxFromCardano
    , sealedTxFromCardano'
    , sealedTxFromCardanoBody
    , getSerialisedTxParts
    , unsafeSealedTxFromBytes
    , SerialisedTx (..)
    , SerialisedTxParts (..)
    , getSealedTxBody
    , getSealedTxWitnesses
    , persistSealedTx
    , unPersistSealedTx

    -- ** Unit testing helpers
    , mockSealedTx
    , withinEra

    -- * Functions
    , fromTransactionInfo
    , inputs
    , collateralInputs
    , isPending
    , toTxHistory
    , txIns
    , txMetadataIsNull
    , txOutCoin
    , txOutAddCoin
    , txOutSubtractCoin
    , txScriptInvalid

    -- * Constants
    , txOutMinCoin
    , txOutMaxCoin
    , txOutMinTokenQuantity
    , txOutMaxTokenQuantity
    , txMintBurnMaxTokenQuantity

    -- * Constraints
    , TxConstraints (..)
    , txOutputCoinCost
    , txOutputCoinSize
    , txOutputHasValidSize
    , txOutputHasValidTokenQuantities
    , TxSize (..)
    , txSizeDistance

    -- * Queries
    , txAssetIds
    , txOutAssetIds

    -- * Transformations
    , txMapAssetIds
    , txMapTxIds
    , txRemoveAssetId
    , txOutMapAssetIds
    , txOutRemoveAssetId

    -- * Checks
    , coinIsValidForTxOut

    -- * Conversions (Unsafe)
    , unsafeCoinToTxOutCoinValue

    ) where

import Prelude

import Cardano.Api
    ( AnyCardanoEra (..)
    , CardanoEra (..)
    , InAnyCardanoEra (..)
    , ScriptWitnessIndex (..)
    , TxMetadata (..)
    , TxMetadataValue (..)
    , anyCardanoEra
    , deserialiseFromCBOR
    , serialiseToCBOR
    )
import Cardano.Binary
    ( DecoderError )
import Cardano.Slotting.Slot
    ( SlotNo (..) )
import Cardano.Wallet.Orphans
    ()
import Cardano.Wallet.Primitive.Types.Address
    ( Address (..) )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin (..) )
import Cardano.Wallet.Primitive.Types.Hash
    ( Hash (..) )
import Cardano.Wallet.Primitive.Types.RewardAccount
    ( RewardAccount (..) )
import Cardano.Wallet.Primitive.Types.TokenBundle
    ( TokenBundle (..) )
import Cardano.Wallet.Primitive.Types.TokenMap
    ( AssetId, Lexicographic (..), TokenMap )
import Cardano.Wallet.Primitive.Types.TokenQuantity
    ( TokenQuantity (..) )
import Cardano.Wallet.Util
    ( HasCallStack, internalError )
import Control.DeepSeq
    ( NFData (..), deepseq )
import Data.Bifunctor
    ( first )
import Data.ByteArray
    ( ByteArray, ByteArrayAccess )
import Data.ByteString
    ( ByteString )
import Data.Either
    ( partitionEithers )
import Data.Function
    ( on, (&) )
import Data.Generics.Internal.VL.Lens
    ( over, view )
import Data.Generics.Labels
    ()
import Data.Int
    ( Int64 )
import Data.Map.Strict
    ( Map )
import Data.Ord
    ( comparing )
import Data.Quantity
    ( Quantity (..) )
import Data.Set
    ( Set )
import Data.Text
    ( Text )
import Data.Text.Class
    ( CaseStyle (..)
    , FromText (..)
    , ToText (..)
    , fromTextToBoundedEnum
    , toTextFromBoundedEnum
    )
import Data.Time.Clock
    ( UTCTime )
import Data.Type.Equality
    ( (:~:) (..), testEquality )
import Data.Word
    ( Word32, Word64 )
import Fmt
    ( Buildable (..)
    , Builder
    , blockListF'
    , blockMapF
    , hexF
    , nameF
    , ordinalF
    , prefixF
    , suffixF
    , tupleF
    , (+||)
    , (||+)
    )
import GHC.Generics
    ( Generic )
import Numeric.Natural
    ( Natural )
import Quiet
    ( Quiet (..) )
import Text.Pretty.Simple
    ( pShowNoColor )

import qualified Cardano.Api as Cardano
import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
import qualified Data.ByteString.Char8 as B8
import qualified Data.Foldable as F
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as Builder

-- | Primitive @Tx@-type.
--
-- Currently tailored for jormungandr in that inputs are @(TxIn, Coin)@
-- instead of @TxIn@. We might have to revisit this when supporting another
-- node.
data Tx = Tx
    { Tx -> Hash "Tx"
txId
        :: Hash "Tx"
        -- ^ Jörmungandr computes transaction id by hashing the full content of
        -- the transaction, which includes witnesses. Therefore, we need either
        -- to keep track of the witnesses to be able to re-compute the tx id
        -- every time, or, simply keep track of the id itself.

    , Tx -> Maybe Coin
fee
        :: !(Maybe Coin)
        -- ^ Explicit fee for that transaction, if available. Fee are available
        -- explicitly in Shelley, but not in Byron although in Byron they can
        -- easily be re-computed from the delta between outputs and inputs.

    , Tx -> [(TxIn, Coin)]
resolvedInputs
        :: ![(TxIn, Coin)]
        -- ^ NOTE: Order of inputs matters in the transaction representation.
        -- The transaction id is computed from the binary representation of a
        -- tx, for which inputs are serialized in a specific order.

    , Tx -> [(TxIn, Coin)]
resolvedCollateralInputs
        :: ![(TxIn, Coin)]
        -- ^ NOTE: The order of collateral inputs matters in the transaction
        -- representation.  The transaction id is computed from the binary
        -- representation of a tx, for which collateral inputs are serialized
        -- in a specific order.

    , Tx -> [TxOut]
outputs
        :: ![TxOut]
        -- ^ NOTE: Order of outputs matters in the transaction representations.
        -- Outputs are used as inputs for next transactions which refer to them
        -- using their indexes. It matters also for serialization.

    , Tx -> Maybe TxOut
collateralOutput :: !(Maybe TxOut)
        -- ^ An output that is only created if a transaction script fails.

    , Tx -> Map RewardAccount Coin
withdrawals
        :: !(Map RewardAccount Coin)
        -- ^ Withdrawals (of funds from a registered reward account) embedded in
        -- a transaction. The order does not matter.

    , Tx -> Maybe TxMetadata
metadata
        :: !(Maybe TxMetadata)
        -- ^ Semi-structured application-specific extension data stored in the
        -- transaction on chain.
        --
        -- This is not to be confused with 'TxMeta', which is information about
        -- a transaction derived from the ledger.
        --
        -- See Appendix E of
        -- <https://hydra.iohk.io/job/Cardano/cardano-ledger-specs/delegationDesignSpec/latest/download-by-type/doc-pdf/delegation_design_spec Shelley Ledger: Delegation/Incentives Design Spec>.

    , Tx -> Maybe TxScriptValidity
scriptValidity
        :: !(Maybe TxScriptValidity)
        -- ^ Tag indicating whether non-native scripts in this transaction
        -- passed validation. This is added by the block creator when
        -- constructing the block. May be 'Nothing' for pre-Alonzo and pending
        -- transactions.
    } deriving (Int -> Tx -> ShowS
[Tx] -> ShowS
Tx -> String
(Int -> Tx -> ShowS)
-> (Tx -> String) -> ([Tx] -> ShowS) -> Show Tx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tx] -> ShowS
$cshowList :: [Tx] -> ShowS
show :: Tx -> String
$cshow :: Tx -> String
showsPrec :: Int -> Tx -> ShowS
$cshowsPrec :: Int -> Tx -> ShowS
Show, (forall x. Tx -> Rep Tx x)
-> (forall x. Rep Tx x -> Tx) -> Generic Tx
forall x. Rep Tx x -> Tx
forall x. Tx -> Rep Tx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tx x -> Tx
$cfrom :: forall x. Tx -> Rep Tx x
Generic, Eq Tx
Eq Tx
-> (Tx -> Tx -> Ordering)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Tx)
-> (Tx -> Tx -> Tx)
-> Ord Tx
Tx -> Tx -> Bool
Tx -> Tx -> Ordering
Tx -> Tx -> Tx
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 :: Tx -> Tx -> Tx
$cmin :: Tx -> Tx -> Tx
max :: Tx -> Tx -> Tx
$cmax :: Tx -> Tx -> Tx
>= :: Tx -> Tx -> Bool
$c>= :: Tx -> Tx -> Bool
> :: Tx -> Tx -> Bool
$c> :: Tx -> Tx -> Bool
<= :: Tx -> Tx -> Bool
$c<= :: Tx -> Tx -> Bool
< :: Tx -> Tx -> Bool
$c< :: Tx -> Tx -> Bool
compare :: Tx -> Tx -> Ordering
$ccompare :: Tx -> Tx -> Ordering
$cp1Ord :: Eq Tx
Ord, Tx -> Tx -> Bool
(Tx -> Tx -> Bool) -> (Tx -> Tx -> Bool) -> Eq Tx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tx -> Tx -> Bool
$c/= :: Tx -> Tx -> Bool
== :: Tx -> Tx -> Bool
$c== :: Tx -> Tx -> Bool
Eq)

instance NFData Tx

instance Buildable Tx where
    build :: Tx -> Builder
build Tx
t = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ Hash "Tx" -> Builder
forall p. Buildable p => p -> Builder
build (((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
 -> Tx -> Const (Hash "Tx") Tx)
-> Tx -> Hash "Tx"
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId Tx
t)
        , String -> Builder
forall p. Buildable p => p -> Builder
build (String
"\n" :: String)
        , Text -> (TxIn -> Builder) -> [TxIn] -> Builder
forall (f :: * -> *) a.
Foldable f =>
Text -> (a -> Builder) -> f a -> Builder
blockListF' Text
"inputs"
            TxIn -> Builder
forall p. Buildable p => p -> Builder
build ((TxIn, Coin) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, Coin) -> TxIn) -> [(TxIn, Coin)] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([(TxIn, Coin)] -> Const [(TxIn, Coin)] [(TxIn, Coin)])
 -> Tx -> Const [(TxIn, Coin)] Tx)
-> Tx -> [(TxIn, Coin)]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "resolvedInputs"
  (([(TxIn, Coin)] -> Const [(TxIn, Coin)] [(TxIn, Coin)])
   -> Tx -> Const [(TxIn, Coin)] Tx)
([(TxIn, Coin)] -> Const [(TxIn, Coin)] [(TxIn, Coin)])
-> Tx -> Const [(TxIn, Coin)] Tx
#resolvedInputs Tx
t)
        , Text -> (TxIn -> Builder) -> [TxIn] -> Builder
forall (f :: * -> *) a.
Foldable f =>
Text -> (a -> Builder) -> f a -> Builder
blockListF' Text
"collateral inputs"
            TxIn -> Builder
forall p. Buildable p => p -> Builder
build ((TxIn, Coin) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, Coin) -> TxIn) -> [(TxIn, Coin)] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([(TxIn, Coin)] -> Const [(TxIn, Coin)] [(TxIn, Coin)])
 -> Tx -> Const [(TxIn, Coin)] Tx)
-> Tx -> [(TxIn, Coin)]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "resolvedCollateralInputs"
  (([(TxIn, Coin)] -> Const [(TxIn, Coin)] [(TxIn, Coin)])
   -> Tx -> Const [(TxIn, Coin)] Tx)
([(TxIn, Coin)] -> Const [(TxIn, Coin)] [(TxIn, Coin)])
-> Tx -> Const [(TxIn, Coin)] Tx
#resolvedCollateralInputs Tx
t)
        , Text -> (TxOut -> Builder) -> [TxOut] -> Builder
forall (f :: * -> *) a.
Foldable f =>
Text -> (a -> Builder) -> f a -> Builder
blockListF' Text
"outputs"
            TxOut -> Builder
forall p. Buildable p => p -> Builder
build ((([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx)
-> Tx -> [TxOut]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "outputs"
  (([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx)
([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx
#outputs Tx
t)
        , Text -> (TxOut -> Builder) -> Maybe TxOut -> Builder
forall (f :: * -> *) a.
Foldable f =>
Text -> (a -> Builder) -> f a -> Builder
blockListF' Text
"collateral outputs"
            TxOut -> Builder
forall p. Buildable p => p -> Builder
build (((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
 -> Tx -> Const (Maybe TxOut) Tx)
-> Tx -> Maybe TxOut
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "collateralOutput"
  ((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
   -> Tx -> Const (Maybe TxOut) Tx)
(Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
-> Tx -> Const (Maybe TxOut) Tx
#collateralOutput Tx
t)
        , Text
-> ((RewardAccount, Coin) -> Builder)
-> [(RewardAccount, Coin)]
-> Builder
forall (f :: * -> *) a.
Foldable f =>
Text -> (a -> Builder) -> f a -> Builder
blockListF' Text
"withdrawals"
            (RewardAccount, Coin) -> Builder
forall a. TupleF a => a -> Builder
tupleF (Map RewardAccount Coin -> [(RewardAccount, Coin)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map RewardAccount Coin -> [(RewardAccount, Coin)])
-> Map RewardAccount Coin -> [(RewardAccount, Coin)]
forall a b. (a -> b) -> a -> b
$ ((Map RewardAccount Coin
  -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
 -> Tx -> Const (Map RewardAccount Coin) Tx)
-> Tx -> Map RewardAccount Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "withdrawals"
  ((Map RewardAccount Coin
    -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
   -> Tx -> Const (Map RewardAccount Coin) Tx)
(Map RewardAccount Coin
 -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
-> Tx -> Const (Map RewardAccount Coin) Tx
#withdrawals Tx
t)
        , Builder -> Builder -> Builder
nameF Builder
"metadata"
            (Builder -> (TxMetadata -> Builder) -> Maybe TxMetadata -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" TxMetadata -> Builder
forall p. Buildable p => p -> Builder
build (Maybe TxMetadata -> Builder) -> Maybe TxMetadata -> Builder
forall a b. (a -> b) -> a -> b
$ ((Maybe TxMetadata -> Const (Maybe TxMetadata) (Maybe TxMetadata))
 -> Tx -> Const (Maybe TxMetadata) Tx)
-> Tx -> Maybe TxMetadata
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "metadata"
  ((Maybe TxMetadata -> Const (Maybe TxMetadata) (Maybe TxMetadata))
   -> Tx -> Const (Maybe TxMetadata) Tx)
(Maybe TxMetadata -> Const (Maybe TxMetadata) (Maybe TxMetadata))
-> Tx -> Const (Maybe TxMetadata) Tx
#metadata Tx
t)
        , Builder -> Builder -> Builder
nameF Builder
"scriptValidity" (Maybe TxScriptValidity -> Builder
forall p. Buildable p => p -> Builder
build (Maybe TxScriptValidity -> Builder)
-> Maybe TxScriptValidity -> Builder
forall a b. (a -> b) -> a -> b
$ ((Maybe TxScriptValidity
  -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
 -> Tx -> Const (Maybe TxScriptValidity) Tx)
-> Tx -> Maybe TxScriptValidity
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "scriptValidity"
  ((Maybe TxScriptValidity
    -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
   -> Tx -> Const (Maybe TxScriptValidity) Tx)
(Maybe TxScriptValidity
 -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
-> Tx -> Const (Maybe TxScriptValidity) Tx
#scriptValidity Tx
t)
        ]

instance Buildable TxScriptValidity where
    build :: TxScriptValidity -> Builder
build TxScriptValidity
TxScriptValid = Builder
"valid"
    build TxScriptValidity
TxScriptInvalid = Builder
"invalid"

txIns :: Set Tx -> Set TxIn
txIns :: Set Tx -> Set TxIn
txIns = (Tx -> Set TxIn) -> Set Tx -> Set TxIn
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Tx
tx -> [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList (Tx -> [TxIn]
inputs Tx
tx [TxIn] -> [TxIn] -> [TxIn]
forall a. Semigroup a => a -> a -> a
<> Tx -> [TxIn]
collateralInputs Tx
tx))

inputs :: Tx -> [TxIn]
inputs :: Tx -> [TxIn]
inputs = ((TxIn, Coin) -> TxIn) -> [(TxIn, Coin)] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, Coin) -> TxIn
forall a b. (a, b) -> a
fst ([(TxIn, Coin)] -> [TxIn])
-> (Tx -> [(TxIn, Coin)]) -> Tx -> [TxIn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> [(TxIn, Coin)]
resolvedInputs

collateralInputs :: Tx -> [TxIn]
collateralInputs :: Tx -> [TxIn]
collateralInputs = ((TxIn, Coin) -> TxIn) -> [(TxIn, Coin)] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, Coin) -> TxIn
forall a b. (a, b) -> a
fst ([(TxIn, Coin)] -> [TxIn])
-> (Tx -> [(TxIn, Coin)]) -> Tx -> [TxIn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> [(TxIn, Coin)]
resolvedCollateralInputs

data TxIn = TxIn
    { TxIn -> Hash "Tx"
inputId
        :: !(Hash "Tx")
    , TxIn -> Word32
inputIx
        :: !Word32
    } deriving (ReadPrec [TxIn]
ReadPrec TxIn
Int -> ReadS TxIn
ReadS [TxIn]
(Int -> ReadS TxIn)
-> ReadS [TxIn] -> ReadPrec TxIn -> ReadPrec [TxIn] -> Read TxIn
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TxIn]
$creadListPrec :: ReadPrec [TxIn]
readPrec :: ReadPrec TxIn
$creadPrec :: ReadPrec TxIn
readList :: ReadS [TxIn]
$creadList :: ReadS [TxIn]
readsPrec :: Int -> ReadS TxIn
$creadsPrec :: Int -> ReadS TxIn
Read, 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, (forall x. TxIn -> Rep TxIn x)
-> (forall x. Rep TxIn x -> TxIn) -> Generic TxIn
forall x. Rep TxIn x -> TxIn
forall x. TxIn -> Rep TxIn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxIn x -> TxIn
$cfrom :: forall x. TxIn -> Rep TxIn x
Generic, 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)

instance NFData TxIn

instance Buildable TxIn where
    build :: TxIn -> Builder
build TxIn
txin = Builder
forall a. Monoid a => a
mempty
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
forall a. (Buildable a, Integral a) => a -> Builder
ordinalF (TxIn -> Word32
inputIx TxIn
txin Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Hash "Tx" -> Builder
forall p. Buildable p => p -> Builder
build (TxIn -> Hash "Tx"
inputId TxIn
txin)

data TxOut = TxOut
    { TxOut -> Address
address
        :: !Address
    , TxOut -> TokenBundle
tokens
        :: !TokenBundle
    } deriving (ReadPrec [TxOut]
ReadPrec TxOut
Int -> ReadS TxOut
ReadS [TxOut]
(Int -> ReadS TxOut)
-> ReadS [TxOut]
-> ReadPrec TxOut
-> ReadPrec [TxOut]
-> Read TxOut
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TxOut]
$creadListPrec :: ReadPrec [TxOut]
readPrec :: ReadPrec TxOut
$creadPrec :: ReadPrec TxOut
readList :: ReadS [TxOut]
$creadList :: ReadS [TxOut]
readsPrec :: Int -> ReadS TxOut
$creadsPrec :: Int -> ReadS TxOut
Read, Int -> TxOut -> ShowS
[TxOut] -> ShowS
TxOut -> String
(Int -> TxOut -> ShowS)
-> (TxOut -> String) -> ([TxOut] -> ShowS) -> Show TxOut
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxOut] -> ShowS
$cshowList :: [TxOut] -> ShowS
show :: TxOut -> String
$cshow :: TxOut -> String
showsPrec :: Int -> TxOut -> ShowS
$cshowsPrec :: Int -> TxOut -> ShowS
Show, (forall x. TxOut -> Rep TxOut x)
-> (forall x. Rep TxOut x -> TxOut) -> Generic TxOut
forall x. Rep TxOut x -> TxOut
forall x. TxOut -> Rep TxOut x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxOut x -> TxOut
$cfrom :: forall x. TxOut -> Rep TxOut x
Generic, TxOut -> TxOut -> Bool
(TxOut -> TxOut -> Bool) -> (TxOut -> TxOut -> Bool) -> Eq TxOut
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxOut -> TxOut -> Bool
$c/= :: TxOut -> TxOut -> Bool
== :: TxOut -> TxOut -> Bool
$c== :: TxOut -> TxOut -> Bool
Eq)

-- Gets the current 'Coin' value from a transaction output.
--
-- 'Coin' values correspond to the ada asset.
--
txOutCoin :: TxOut -> Coin
txOutCoin :: TxOut -> Coin
txOutCoin = TokenBundle -> Coin
TokenBundle.getCoin (TokenBundle -> Coin) -> (TxOut -> TokenBundle) -> TxOut -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TokenBundle -> Const TokenBundle TokenBundle)
 -> TxOut -> Const TokenBundle TxOut)
-> TxOut -> TokenBundle
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenBundle -> Const TokenBundle TokenBundle)
   -> TxOut -> Const TokenBundle TxOut)
(TokenBundle -> Const TokenBundle TokenBundle)
-> TxOut -> Const TokenBundle TxOut
#tokens

-- | Increments the 'Coin' value of a 'TxOut'.
--
-- Satisfies the following property for all values of 'c':
--
-- >>> txOutSubtractCoin c . txOutAddCoin c == id
--
txOutAddCoin :: Coin -> TxOut -> TxOut
txOutAddCoin :: Coin -> TxOut -> TxOut
txOutAddCoin Coin
val (TxOut Address
addr TokenBundle
tokens) =
    Address -> TokenBundle -> TxOut
TxOut Address
addr (TokenBundle
tokens TokenBundle -> TokenBundle -> TokenBundle
forall a. Semigroup a => a -> a -> a
<> Coin -> TokenBundle
TokenBundle.fromCoin Coin
val)

-- | Decrements the 'Coin' value of a 'TxOut'.
--
-- Satisfies the following property for all values of 'c':
--
-- >>> txOutSubtractCoin c . txOutAddCoin c == id
--
-- If the given 'Coin' is greater than the 'Coin' value of the given 'TxOut',
-- the resulting 'TxOut' will have a 'Coin' value of zero.
--
txOutSubtractCoin :: Coin -> TxOut -> TxOut
txOutSubtractCoin :: Coin -> TxOut -> TxOut
txOutSubtractCoin Coin
toSubtract =
    ((Coin -> Identity Coin) -> TxOut -> Identity TxOut)
-> (Coin -> Coin) -> TxOut -> TxOut
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over (IsLabel
  "tokens"
  ((TokenBundle -> Identity TokenBundle) -> TxOut -> Identity TxOut)
(TokenBundle -> Identity TokenBundle) -> TxOut -> Identity TxOut
#tokens ((TokenBundle -> Identity TokenBundle) -> TxOut -> Identity TxOut)
-> ((Coin -> Identity Coin) -> TokenBundle -> Identity TokenBundle)
-> (Coin -> Identity Coin)
-> TxOut
-> Identity TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "coin"
  ((Coin -> Identity Coin) -> TokenBundle -> Identity TokenBundle)
(Coin -> Identity Coin) -> TokenBundle -> Identity TokenBundle
#coin) (Coin -> Coin -> Coin
`Coin.difference` Coin
toSubtract)

-- Since the 'TokenBundle' type deliberately does not provide an 'Ord' instance
-- (as that would lead to arithmetically invalid orderings), this means we can't
-- automatically derive an 'Ord' instance for the 'TxOut' type.
--
-- Instead, we define an 'Ord' instance that makes comparisons based on
-- lexicographic ordering of 'TokenBundle' values.
--
instance Ord TxOut where
    compare :: TxOut -> TxOut -> Ordering
compare = (TxOut -> (Address, Lexicographic TokenBundle))
-> TxOut -> TxOut -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing TxOut -> (Address, Lexicographic TokenBundle)
projection
      where
        projection :: TxOut -> (Address, Lexicographic TokenBundle)
projection (TxOut Address
address TokenBundle
bundle) = (Address
address, TokenBundle -> Lexicographic TokenBundle
forall a. a -> Lexicographic a
Lexicographic TokenBundle
bundle)

data TxChange derivationPath = TxChange
    { TxChange derivationPath -> Address
address
        :: !Address
    , TxChange derivationPath -> Coin
amount
        :: !Coin
    , TxChange derivationPath -> TokenMap
assets
        :: !TokenMap
    , TxChange derivationPath -> derivationPath
derivationPath
        :: derivationPath
    } deriving (Int -> TxChange derivationPath -> ShowS
[TxChange derivationPath] -> ShowS
TxChange derivationPath -> String
(Int -> TxChange derivationPath -> ShowS)
-> (TxChange derivationPath -> String)
-> ([TxChange derivationPath] -> ShowS)
-> Show (TxChange derivationPath)
forall derivationPath.
Show derivationPath =>
Int -> TxChange derivationPath -> ShowS
forall derivationPath.
Show derivationPath =>
[TxChange derivationPath] -> ShowS
forall derivationPath.
Show derivationPath =>
TxChange derivationPath -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxChange derivationPath] -> ShowS
$cshowList :: forall derivationPath.
Show derivationPath =>
[TxChange derivationPath] -> ShowS
show :: TxChange derivationPath -> String
$cshow :: forall derivationPath.
Show derivationPath =>
TxChange derivationPath -> String
showsPrec :: Int -> TxChange derivationPath -> ShowS
$cshowsPrec :: forall derivationPath.
Show derivationPath =>
Int -> TxChange derivationPath -> ShowS
Show, (forall x.
 TxChange derivationPath -> Rep (TxChange derivationPath) x)
-> (forall x.
    Rep (TxChange derivationPath) x -> TxChange derivationPath)
-> Generic (TxChange derivationPath)
forall x.
Rep (TxChange derivationPath) x -> TxChange derivationPath
forall x.
TxChange derivationPath -> Rep (TxChange derivationPath) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall derivationPath x.
Rep (TxChange derivationPath) x -> TxChange derivationPath
forall derivationPath x.
TxChange derivationPath -> Rep (TxChange derivationPath) x
$cto :: forall derivationPath x.
Rep (TxChange derivationPath) x -> TxChange derivationPath
$cfrom :: forall derivationPath x.
TxChange derivationPath -> Rep (TxChange derivationPath) x
Generic, TxChange derivationPath -> TxChange derivationPath -> Bool
(TxChange derivationPath -> TxChange derivationPath -> Bool)
-> (TxChange derivationPath -> TxChange derivationPath -> Bool)
-> Eq (TxChange derivationPath)
forall derivationPath.
Eq derivationPath =>
TxChange derivationPath -> TxChange derivationPath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxChange derivationPath -> TxChange derivationPath -> Bool
$c/= :: forall derivationPath.
Eq derivationPath =>
TxChange derivationPath -> TxChange derivationPath -> Bool
== :: TxChange derivationPath -> TxChange derivationPath -> Bool
$c== :: forall derivationPath.
Eq derivationPath =>
TxChange derivationPath -> TxChange derivationPath -> Bool
Eq, Eq (TxChange derivationPath)
Eq (TxChange derivationPath)
-> (TxChange derivationPath -> TxChange derivationPath -> Ordering)
-> (TxChange derivationPath -> TxChange derivationPath -> Bool)
-> (TxChange derivationPath -> TxChange derivationPath -> Bool)
-> (TxChange derivationPath -> TxChange derivationPath -> Bool)
-> (TxChange derivationPath -> TxChange derivationPath -> Bool)
-> (TxChange derivationPath
    -> TxChange derivationPath -> TxChange derivationPath)
-> (TxChange derivationPath
    -> TxChange derivationPath -> TxChange derivationPath)
-> Ord (TxChange derivationPath)
TxChange derivationPath -> TxChange derivationPath -> Bool
TxChange derivationPath -> TxChange derivationPath -> Ordering
TxChange derivationPath
-> TxChange derivationPath -> TxChange derivationPath
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
forall derivationPath.
((TypeError ...), Ord derivationPath) =>
Eq (TxChange derivationPath)
forall derivationPath.
((TypeError ...), Ord derivationPath) =>
TxChange derivationPath -> TxChange derivationPath -> Bool
forall derivationPath.
((TypeError ...), Ord derivationPath) =>
TxChange derivationPath -> TxChange derivationPath -> Ordering
forall derivationPath.
((TypeError ...), Ord derivationPath) =>
TxChange derivationPath
-> TxChange derivationPath -> TxChange derivationPath
min :: TxChange derivationPath
-> TxChange derivationPath -> TxChange derivationPath
$cmin :: forall derivationPath.
((TypeError ...), Ord derivationPath) =>
TxChange derivationPath
-> TxChange derivationPath -> TxChange derivationPath
max :: TxChange derivationPath
-> TxChange derivationPath -> TxChange derivationPath
$cmax :: forall derivationPath.
((TypeError ...), Ord derivationPath) =>
TxChange derivationPath
-> TxChange derivationPath -> TxChange derivationPath
>= :: TxChange derivationPath -> TxChange derivationPath -> Bool
$c>= :: forall derivationPath.
((TypeError ...), Ord derivationPath) =>
TxChange derivationPath -> TxChange derivationPath -> Bool
> :: TxChange derivationPath -> TxChange derivationPath -> Bool
$c> :: forall derivationPath.
((TypeError ...), Ord derivationPath) =>
TxChange derivationPath -> TxChange derivationPath -> Bool
<= :: TxChange derivationPath -> TxChange derivationPath -> Bool
$c<= :: forall derivationPath.
((TypeError ...), Ord derivationPath) =>
TxChange derivationPath -> TxChange derivationPath -> Bool
< :: TxChange derivationPath -> TxChange derivationPath -> Bool
$c< :: forall derivationPath.
((TypeError ...), Ord derivationPath) =>
TxChange derivationPath -> TxChange derivationPath -> Bool
compare :: TxChange derivationPath -> TxChange derivationPath -> Ordering
$ccompare :: forall derivationPath.
((TypeError ...), Ord derivationPath) =>
TxChange derivationPath -> TxChange derivationPath -> Ordering
$cp1Ord :: forall derivationPath.
((TypeError ...), Ord derivationPath) =>
Eq (TxChange derivationPath)
Ord)

instance NFData TxOut

instance Buildable TxOut where
    build :: TxOut -> Builder
build TxOut
txOut = [(String, Builder)] -> Builder
buildMap
        [ (String
"address"
          , Builder
addressShort)
        , (String
"coin"
          , Coin -> Builder
forall p. Buildable p => p -> Builder
build (TxOut -> Coin
txOutCoin TxOut
txOut))
        , (String
"tokens"
          , Nested TokenMap -> Builder
forall p. Buildable p => p -> Builder
build (TokenMap -> Nested TokenMap
forall a. a -> Nested a
TokenMap.Nested (TokenMap -> Nested TokenMap) -> TokenMap -> Nested TokenMap
forall a b. (a -> b) -> a -> b
$ ((TokenMap -> Const TokenMap TokenMap)
 -> TxOut -> Const TokenMap TxOut)
-> TxOut -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view (IsLabel
  "tokens"
  ((TokenBundle -> Const TokenMap TokenBundle)
   -> TxOut -> Const TokenMap TxOut)
(TokenBundle -> Const TokenMap TokenBundle)
-> TxOut -> Const TokenMap TxOut
#tokens ((TokenBundle -> Const TokenMap TokenBundle)
 -> TxOut -> Const TokenMap TxOut)
-> ((TokenMap -> Const TokenMap TokenMap)
    -> TokenBundle -> Const TokenMap TokenBundle)
-> (TokenMap -> Const TokenMap TokenMap)
-> TxOut
-> Const TokenMap TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens) TxOut
txOut))
        ]
      where
        addressShort :: Builder
addressShort = Builder
forall a. Monoid a => a
mempty
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
forall a. Buildable a => Int -> a -> Builder
prefixF Int
8 Builder
addressFull
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"..."
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder -> Builder
forall a. Buildable a => Int -> a -> Builder
suffixF Int
8 Builder
addressFull
        addressFull :: Builder
addressFull = Address -> Builder
forall p. Buildable p => p -> Builder
build (Address -> Builder) -> Address -> Builder
forall a b. (a -> b) -> a -> b
$ ((Address -> Const Address Address)
 -> TxOut -> Const Address TxOut)
-> TxOut -> Address
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "address"
  ((Address -> Const Address Address)
   -> TxOut -> Const Address TxOut)
(Address -> Const Address Address) -> TxOut -> Const Address TxOut
#address TxOut
txOut
        buildMap :: [(String, Builder)] -> Builder
buildMap = [(String, Builder)] -> Builder
forall t k v.
(IsList t, Item t ~ (k, v), Buildable k, Buildable v) =>
t -> Builder
blockMapF ([(String, Builder)] -> Builder)
-> ([(String, Builder)] -> [(String, Builder)])
-> [(String, Builder)]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Builder) -> (String, Builder))
-> [(String, Builder)] -> [(String, Builder)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS -> (String, Builder) -> (String, Builder)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ShowS -> (String, Builder) -> (String, Builder))
-> ShowS -> (String, Builder) -> (String, Builder)
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. a -> a
id @String)

instance Buildable (TxIn, TxOut) where
    build :: (TxIn, TxOut) -> Builder
build (TxIn
txin, TxOut
txout) = TxIn -> Builder
forall p. Buildable p => p -> Builder
build TxIn
txin Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" ==> " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TxOut -> Builder
forall p. Buildable p => p -> Builder
build TxOut
txout

-- | Additional information about a transaction, derived from the transaction
-- and ledger state. This should not be confused with 'TxMetadata' which is
-- application-specific data included with the transaction.
--
-- TODO: TxProperties or TxProps would be a good name for this type.
data TxMeta = TxMeta
    { TxMeta -> TxStatus
status :: !TxStatus
    , TxMeta -> Direction
direction :: !Direction
    , TxMeta -> SlotNo
slotNo :: !SlotNo
    , TxMeta -> Quantity "block" Word32
blockHeight :: !(Quantity "block" Word32)
    , TxMeta -> Coin
amount :: !Coin
    -- ^ Amount seen from the perspective of the wallet. Refers either to a
    -- spent value for outgoing transaction, or a received value on incoming
    -- transaction.
    , TxMeta -> Maybe SlotNo
expiry :: !(Maybe SlotNo)
      -- ^ The slot at which a pending transaction will no longer be accepted
      -- into mempools.
    } deriving (Int -> TxMeta -> ShowS
[TxMeta] -> ShowS
TxMeta -> String
(Int -> TxMeta -> ShowS)
-> (TxMeta -> String) -> ([TxMeta] -> ShowS) -> Show TxMeta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxMeta] -> ShowS
$cshowList :: [TxMeta] -> ShowS
show :: TxMeta -> String
$cshow :: TxMeta -> String
showsPrec :: Int -> TxMeta -> ShowS
$cshowsPrec :: Int -> TxMeta -> ShowS
Show, TxMeta -> TxMeta -> Bool
(TxMeta -> TxMeta -> Bool)
-> (TxMeta -> TxMeta -> Bool) -> Eq TxMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxMeta -> TxMeta -> Bool
$c/= :: TxMeta -> TxMeta -> Bool
== :: TxMeta -> TxMeta -> Bool
$c== :: TxMeta -> TxMeta -> Bool
Eq, Eq TxMeta
Eq TxMeta
-> (TxMeta -> TxMeta -> Ordering)
-> (TxMeta -> TxMeta -> Bool)
-> (TxMeta -> TxMeta -> Bool)
-> (TxMeta -> TxMeta -> Bool)
-> (TxMeta -> TxMeta -> Bool)
-> (TxMeta -> TxMeta -> TxMeta)
-> (TxMeta -> TxMeta -> TxMeta)
-> Ord TxMeta
TxMeta -> TxMeta -> Bool
TxMeta -> TxMeta -> Ordering
TxMeta -> TxMeta -> TxMeta
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 :: TxMeta -> TxMeta -> TxMeta
$cmin :: TxMeta -> TxMeta -> TxMeta
max :: TxMeta -> TxMeta -> TxMeta
$cmax :: TxMeta -> TxMeta -> TxMeta
>= :: TxMeta -> TxMeta -> Bool
$c>= :: TxMeta -> TxMeta -> Bool
> :: TxMeta -> TxMeta -> Bool
$c> :: TxMeta -> TxMeta -> Bool
<= :: TxMeta -> TxMeta -> Bool
$c<= :: TxMeta -> TxMeta -> Bool
< :: TxMeta -> TxMeta -> Bool
$c< :: TxMeta -> TxMeta -> Bool
compare :: TxMeta -> TxMeta -> Ordering
$ccompare :: TxMeta -> TxMeta -> Ordering
$cp1Ord :: Eq TxMeta
Ord, (forall x. TxMeta -> Rep TxMeta x)
-> (forall x. Rep TxMeta x -> TxMeta) -> Generic TxMeta
forall x. Rep TxMeta x -> TxMeta
forall x. TxMeta -> Rep TxMeta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxMeta x -> TxMeta
$cfrom :: forall x. TxMeta -> Rep TxMeta x
Generic)

instance NFData TxMeta

instance Buildable TxMeta where
    build :: TxMeta -> Builder
build (TxMeta TxStatus
s Direction
d SlotNo
sl (Quantity Word32
bh) Coin
c Maybe SlotNo
mex) = Builder
forall a. Monoid a => a
mempty
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> WithDirection Coin -> Builder
forall p. Buildable p => p -> Builder
build (Direction -> Coin -> WithDirection Coin
forall a. Direction -> a -> WithDirection a
WithDirection Direction
d Coin
c)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TxStatus -> Builder
forall p. Buildable p => p -> Builder
build TxStatus
s
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" since " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Builder
forall p. Buildable p => p -> Builder
build SlotNo
sl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"#" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
forall p. Buildable p => p -> Builder
build Word32
bh
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (SlotNo -> Builder) -> Maybe SlotNo -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty (\SlotNo
ex -> Builder
" (expires slot " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Builder
forall p. Buildable p => p -> Builder
build SlotNo
ex Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")") Maybe SlotNo
mex

data TxStatus
    = Pending
        -- ^ Created, but not yet in a block.
    | InLedger
        -- ^ Has been found in a block.
    | Expired
        -- ^ Time to live (TTL) has passed.
    deriving (Int -> TxStatus -> ShowS
[TxStatus] -> ShowS
TxStatus -> String
(Int -> TxStatus -> ShowS)
-> (TxStatus -> String) -> ([TxStatus] -> ShowS) -> Show TxStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxStatus] -> ShowS
$cshowList :: [TxStatus] -> ShowS
show :: TxStatus -> String
$cshow :: TxStatus -> String
showsPrec :: Int -> TxStatus -> ShowS
$cshowsPrec :: Int -> TxStatus -> ShowS
Show, TxStatus -> TxStatus -> Bool
(TxStatus -> TxStatus -> Bool)
-> (TxStatus -> TxStatus -> Bool) -> Eq TxStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxStatus -> TxStatus -> Bool
$c/= :: TxStatus -> TxStatus -> Bool
== :: TxStatus -> TxStatus -> Bool
$c== :: TxStatus -> TxStatus -> Bool
Eq, Eq TxStatus
Eq TxStatus
-> (TxStatus -> TxStatus -> Ordering)
-> (TxStatus -> TxStatus -> Bool)
-> (TxStatus -> TxStatus -> Bool)
-> (TxStatus -> TxStatus -> Bool)
-> (TxStatus -> TxStatus -> Bool)
-> (TxStatus -> TxStatus -> TxStatus)
-> (TxStatus -> TxStatus -> TxStatus)
-> Ord TxStatus
TxStatus -> TxStatus -> Bool
TxStatus -> TxStatus -> Ordering
TxStatus -> TxStatus -> TxStatus
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 :: TxStatus -> TxStatus -> TxStatus
$cmin :: TxStatus -> TxStatus -> TxStatus
max :: TxStatus -> TxStatus -> TxStatus
$cmax :: TxStatus -> TxStatus -> TxStatus
>= :: TxStatus -> TxStatus -> Bool
$c>= :: TxStatus -> TxStatus -> Bool
> :: TxStatus -> TxStatus -> Bool
$c> :: TxStatus -> TxStatus -> Bool
<= :: TxStatus -> TxStatus -> Bool
$c<= :: TxStatus -> TxStatus -> Bool
< :: TxStatus -> TxStatus -> Bool
$c< :: TxStatus -> TxStatus -> Bool
compare :: TxStatus -> TxStatus -> Ordering
$ccompare :: TxStatus -> TxStatus -> Ordering
$cp1Ord :: Eq TxStatus
Ord, TxStatus
TxStatus -> TxStatus -> Bounded TxStatus
forall a. a -> a -> Bounded a
maxBound :: TxStatus
$cmaxBound :: TxStatus
minBound :: TxStatus
$cminBound :: TxStatus
Bounded, Int -> TxStatus
TxStatus -> Int
TxStatus -> [TxStatus]
TxStatus -> TxStatus
TxStatus -> TxStatus -> [TxStatus]
TxStatus -> TxStatus -> TxStatus -> [TxStatus]
(TxStatus -> TxStatus)
-> (TxStatus -> TxStatus)
-> (Int -> TxStatus)
-> (TxStatus -> Int)
-> (TxStatus -> [TxStatus])
-> (TxStatus -> TxStatus -> [TxStatus])
-> (TxStatus -> TxStatus -> [TxStatus])
-> (TxStatus -> TxStatus -> TxStatus -> [TxStatus])
-> Enum TxStatus
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 :: TxStatus -> TxStatus -> TxStatus -> [TxStatus]
$cenumFromThenTo :: TxStatus -> TxStatus -> TxStatus -> [TxStatus]
enumFromTo :: TxStatus -> TxStatus -> [TxStatus]
$cenumFromTo :: TxStatus -> TxStatus -> [TxStatus]
enumFromThen :: TxStatus -> TxStatus -> [TxStatus]
$cenumFromThen :: TxStatus -> TxStatus -> [TxStatus]
enumFrom :: TxStatus -> [TxStatus]
$cenumFrom :: TxStatus -> [TxStatus]
fromEnum :: TxStatus -> Int
$cfromEnum :: TxStatus -> Int
toEnum :: Int -> TxStatus
$ctoEnum :: Int -> TxStatus
pred :: TxStatus -> TxStatus
$cpred :: TxStatus -> TxStatus
succ :: TxStatus -> TxStatus
$csucc :: TxStatus -> TxStatus
Enum, (forall x. TxStatus -> Rep TxStatus x)
-> (forall x. Rep TxStatus x -> TxStatus) -> Generic TxStatus
forall x. Rep TxStatus x -> TxStatus
forall x. TxStatus -> Rep TxStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxStatus x -> TxStatus
$cfrom :: forall x. TxStatus -> Rep TxStatus x
Generic)

instance NFData TxStatus

instance Buildable TxStatus where
    build :: TxStatus -> Builder
build = Text -> Builder
Builder.fromText (Text -> Builder) -> (TxStatus -> Text) -> TxStatus -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CaseStyle -> TxStatus -> Text
forall a. (Bounded a, Enum a, Show a) => CaseStyle -> a -> Text
toTextFromBoundedEnum CaseStyle
SpacedLowerCase

instance FromText TxStatus where
    fromText :: Text -> Either TextDecodingError TxStatus
fromText = CaseStyle -> Text -> Either TextDecodingError TxStatus
forall a.
(Bounded a, Enum a, Show a) =>
CaseStyle -> Text -> Either TextDecodingError a
fromTextToBoundedEnum CaseStyle
SnakeLowerCase

instance ToText TxStatus where
    toText :: TxStatus -> Text
toText = CaseStyle -> TxStatus -> Text
forall a. (Bounded a, Enum a, Show a) => CaseStyle -> a -> Text
toTextFromBoundedEnum CaseStyle
SnakeLowerCase

-- | An unsigned transaction.
--
-- See 'Tx' for a signed transaction.
--
data UnsignedTx input output change withdrawal = UnsignedTx
    { UnsignedTx input output change withdrawal -> [input]
unsignedCollateral
        :: [input]
        -- Inputs used for collateral.

    , UnsignedTx input output change withdrawal -> [input]
unsignedInputs
        :: [input]
        -- ^ Inputs are *necessarily* non-empty because Cardano requires at least
        -- one UTxO input per transaction to prevent replayable transactions.
        -- (each UTxO being unique, including at least one UTxO in the
        -- transaction body makes it seemingly unique).
        --
        -- *However* when used to represent the inputs known by the wallet, in
        -- contrast to all inputs, it can be empty.

    , UnsignedTx input output change withdrawal -> [output]
unsignedOutputs
        :: [output]
        -- Unlike inputs, it is perfectly reasonable to have empty outputs. The
        -- main scenario where this might occur is when constructing a
        -- delegation for the sake of submitting a certificate. This type of
        -- transaction does not typically include any target output and,
        -- depending on which input(s) get selected to fuel the transaction, it
        -- may or may not include a change output should its value be less than
        -- the minimal UTxO value set by the network.

    , UnsignedTx input output change withdrawal -> [change]
unsignedChange
        :: [change]

    , UnsignedTx input output change withdrawal -> [withdrawal]
unsignedWithdrawals
        :: [withdrawal]
    }
    deriving (UnsignedTx input output change withdrawal
-> UnsignedTx input output change withdrawal -> Bool
(UnsignedTx input output change withdrawal
 -> UnsignedTx input output change withdrawal -> Bool)
-> (UnsignedTx input output change withdrawal
    -> UnsignedTx input output change withdrawal -> Bool)
-> Eq (UnsignedTx input output change withdrawal)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall input output change withdrawal.
(Eq input, Eq output, Eq change, Eq withdrawal) =>
UnsignedTx input output change withdrawal
-> UnsignedTx input output change withdrawal -> Bool
/= :: UnsignedTx input output change withdrawal
-> UnsignedTx input output change withdrawal -> Bool
$c/= :: forall input output change withdrawal.
(Eq input, Eq output, Eq change, Eq withdrawal) =>
UnsignedTx input output change withdrawal
-> UnsignedTx input output change withdrawal -> Bool
== :: UnsignedTx input output change withdrawal
-> UnsignedTx input output change withdrawal -> Bool
$c== :: forall input output change withdrawal.
(Eq input, Eq output, Eq change, Eq withdrawal) =>
UnsignedTx input output change withdrawal
-> UnsignedTx input output change withdrawal -> Bool
Eq, (forall x.
 UnsignedTx input output change withdrawal
 -> Rep (UnsignedTx input output change withdrawal) x)
-> (forall x.
    Rep (UnsignedTx input output change withdrawal) x
    -> UnsignedTx input output change withdrawal)
-> Generic (UnsignedTx input output change withdrawal)
forall x.
Rep (UnsignedTx input output change withdrawal) x
-> UnsignedTx input output change withdrawal
forall x.
UnsignedTx input output change withdrawal
-> Rep (UnsignedTx input output change withdrawal) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall input output change withdrawal x.
Rep (UnsignedTx input output change withdrawal) x
-> UnsignedTx input output change withdrawal
forall input output change withdrawal x.
UnsignedTx input output change withdrawal
-> Rep (UnsignedTx input output change withdrawal) x
$cto :: forall input output change withdrawal x.
Rep (UnsignedTx input output change withdrawal) x
-> UnsignedTx input output change withdrawal
$cfrom :: forall input output change withdrawal x.
UnsignedTx input output change withdrawal
-> Rep (UnsignedTx input output change withdrawal) x
Generic, Int -> UnsignedTx input output change withdrawal -> ShowS
[UnsignedTx input output change withdrawal] -> ShowS
UnsignedTx input output change withdrawal -> String
(Int -> UnsignedTx input output change withdrawal -> ShowS)
-> (UnsignedTx input output change withdrawal -> String)
-> ([UnsignedTx input output change withdrawal] -> ShowS)
-> Show (UnsignedTx input output change withdrawal)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall input output change withdrawal.
(Show input, Show output, Show change, Show withdrawal) =>
Int -> UnsignedTx input output change withdrawal -> ShowS
forall input output change withdrawal.
(Show input, Show output, Show change, Show withdrawal) =>
[UnsignedTx input output change withdrawal] -> ShowS
forall input output change withdrawal.
(Show input, Show output, Show change, Show withdrawal) =>
UnsignedTx input output change withdrawal -> String
showList :: [UnsignedTx input output change withdrawal] -> ShowS
$cshowList :: forall input output change withdrawal.
(Show input, Show output, Show change, Show withdrawal) =>
[UnsignedTx input output change withdrawal] -> ShowS
show :: UnsignedTx input output change withdrawal -> String
$cshow :: forall input output change withdrawal.
(Show input, Show output, Show change, Show withdrawal) =>
UnsignedTx input output change withdrawal -> String
showsPrec :: Int -> UnsignedTx input output change withdrawal -> ShowS
$cshowsPrec :: forall input output change withdrawal.
(Show input, Show output, Show change, Show withdrawal) =>
Int -> UnsignedTx input output change withdrawal -> ShowS
Show)

-- | The effect of a @Transaction@ on the wallet balance.
data Direction
    = Outgoing -- ^ The wallet balance decreases.
    | Incoming -- ^ The wallet balance increases or stays the same.
    deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show, Direction
Direction -> Direction -> Bounded Direction
forall a. a -> a -> Bounded a
maxBound :: Direction
$cmaxBound :: Direction
minBound :: Direction
$cminBound :: Direction
Bounded, Int -> Direction
Direction -> Int
Direction -> [Direction]
Direction -> Direction
Direction -> Direction -> [Direction]
Direction -> Direction -> Direction -> [Direction]
(Direction -> Direction)
-> (Direction -> Direction)
-> (Int -> Direction)
-> (Direction -> Int)
-> (Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> Direction -> [Direction])
-> Enum Direction
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 :: Direction -> Direction -> Direction -> [Direction]
$cenumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
enumFromTo :: Direction -> Direction -> [Direction]
$cenumFromTo :: Direction -> Direction -> [Direction]
enumFromThen :: Direction -> Direction -> [Direction]
$cenumFromThen :: Direction -> Direction -> [Direction]
enumFrom :: Direction -> [Direction]
$cenumFrom :: Direction -> [Direction]
fromEnum :: Direction -> Int
$cfromEnum :: Direction -> Int
toEnum :: Int -> Direction
$ctoEnum :: Int -> Direction
pred :: Direction -> Direction
$cpred :: Direction -> Direction
succ :: Direction -> Direction
$csucc :: Direction -> Direction
Enum, Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Eq Direction
Eq Direction
-> (Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
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 :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmax :: Direction -> Direction -> Direction
>= :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c< :: Direction -> Direction -> Bool
compare :: Direction -> Direction -> Ordering
$ccompare :: Direction -> Direction -> Ordering
$cp1Ord :: Eq Direction
Ord, (forall x. Direction -> Rep Direction x)
-> (forall x. Rep Direction x -> Direction) -> Generic Direction
forall x. Rep Direction x -> Direction
forall x. Direction -> Rep Direction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Direction x -> Direction
$cfrom :: forall x. Direction -> Rep Direction x
Generic)

instance NFData Direction

instance Buildable Direction where
    build :: Direction -> Builder
build = Text -> Builder
Builder.fromText (Text -> Builder) -> (Direction -> Text) -> Direction -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CaseStyle -> Direction -> Text
forall a. (Bounded a, Enum a, Show a) => CaseStyle -> a -> Text
toTextFromBoundedEnum CaseStyle
SpacedLowerCase

instance FromText Direction where
    fromText :: Text -> Either TextDecodingError Direction
fromText = CaseStyle -> Text -> Either TextDecodingError Direction
forall a.
(Bounded a, Enum a, Show a) =>
CaseStyle -> Text -> Either TextDecodingError a
fromTextToBoundedEnum CaseStyle
SnakeLowerCase

instance ToText Direction where
    toText :: Direction -> Text
toText = CaseStyle -> Direction -> Text
forall a. (Bounded a, Enum a, Show a) => CaseStyle -> a -> Text
toTextFromBoundedEnum CaseStyle
SnakeLowerCase

data WithDirection a = WithDirection Direction a

instance Buildable a => Buildable (WithDirection a) where
    build :: WithDirection a -> Builder
build (WithDirection Direction
d a
a) = Builder
forall a. Monoid a => a
mempty
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (case Direction
d of; Direction
Incoming -> Builder
"+"; Direction
Outgoing -> Builder
"-")
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall p. Buildable p => p -> Builder
build a
a

-- | 'SealedTx' is a transaction for any hard fork era, possibly incomplete,
-- possibly unsigned, with dual representations to make it convenient to use.
--
-- Serialisation/deserialisation is usually done at the application boundaries
-- (e.g. in the API server), and then the wallet core can use it either as a
-- 'ByteString', or as a 'Cardano.Api.Tx'.
--
-- Construct it with either 'sealedTxFromCardano' or 'sealedTxFromBytes'.
data SealedTx = SealedTx
    { SealedTx -> Bool
valid :: Bool
    -- ^ Internal flag - indicates that the 'serialisedTx' bytes encode a valid
    -- Cardano transaction. If the "proper" constructors are used, this will
    -- always be True, but it will be False if 'mockSealedTx' is used to
    -- construct a 'SealedTx' for unit tests.

    , SealedTx -> InAnyCardanoEra Tx
unsafeCardanoTx :: InAnyCardanoEra Cardano.Tx
    -- ^ Decoded transaction. Potentially in the wrong era.

    , SealedTx -> ByteString
serialisedTx :: ByteString
    -- ^ CBOR-serialised bytes of the transaction.

    } deriving stock (forall x. SealedTx -> Rep SealedTx x)
-> (forall x. Rep SealedTx x -> SealedTx) -> Generic SealedTx
forall x. Rep SealedTx x -> SealedTx
forall x. SealedTx -> Rep SealedTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SealedTx x -> SealedTx
$cfrom :: forall x. SealedTx -> Rep SealedTx x
Generic

instance Show SealedTx where
    -- InAnyCardanoEra is missing a Show instance, so define one inline.
    showsPrec :: Int -> SealedTx -> ShowS
showsPrec Int
d (SealedTx Bool
v InAnyCardanoEra Tx
tx' ByteString
bs) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"SealedTx " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (if Bool
v then Bool -> ShowS -> ShowS
showParen Bool
True (InAnyCardanoEra Tx -> ShowS
showsTx InAnyCardanoEra Tx
tx') else String -> ShowS
showString String
"undefined") 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 -> ByteString -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ByteString
bs 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 -> Bool -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Bool
v
      where
        showsTx :: InAnyCardanoEra Cardano.Tx -> ShowS
        showsTx :: InAnyCardanoEra Tx -> ShowS
showsTx (InAnyCardanoEra CardanoEra era
era Tx era
tx) =
            String -> ShowS
showString String
"InAnyCardanoEra" 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 -> CardanoEra era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 CardanoEra era
era 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 -> Tx era -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Tx era
tx

instance Buildable SealedTx where
    build :: SealedTx -> Builder
build (SealedTx Bool
v InAnyCardanoEra Tx
tx' ByteString
bs) = if Bool
v then InAnyCardanoEra Tx -> Builder
buildTx InAnyCardanoEra Tx
tx' else ByteString -> Builder
forall a. FormatAsHex a => a -> Builder
hexF ByteString
bs
      where
        buildTx :: InAnyCardanoEra Cardano.Tx -> Builder
        buildTx :: InAnyCardanoEra Tx -> Builder
buildTx (InAnyCardanoEra CardanoEra era
_ Tx era
tx) = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Tx era -> Text
forall a. Show a => a -> Text
pShowNoColor Tx era
tx

instance Eq SealedTx where
    SealedTx Bool
v1 InAnyCardanoEra Tx
tx1 ByteString
bs1 == :: SealedTx -> SealedTx -> Bool
== SealedTx Bool
v2 InAnyCardanoEra Tx
tx2 ByteString
bs2
        | Bool
v1 Bool -> Bool -> Bool
&& Bool
v2 = InAnyCardanoEra Tx -> InAnyCardanoEra Tx -> Bool
forall (a :: * -> *).
InAnyCardanoEra a -> InAnyCardanoEra a -> Bool
sameEra InAnyCardanoEra Tx
tx1 InAnyCardanoEra Tx
tx2 Bool -> Bool -> Bool
&& ByteString
bs1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bs2
        | Bool
v1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
v2 = ByteString
bs1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bs2
        | Bool
otherwise = Bool
False

sameEra :: InAnyCardanoEra a -> InAnyCardanoEra a -> Bool
sameEra :: InAnyCardanoEra a -> InAnyCardanoEra a -> Bool
sameEra (InAnyCardanoEra CardanoEra era
e1 a era
_) (InAnyCardanoEra CardanoEra era
e2 a era
_) =
    case CardanoEra era -> CardanoEra era -> Maybe (era :~: era)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality CardanoEra era
e1 CardanoEra era
e2 of
        Just era :~: era
Refl -> Bool
True
        Maybe (era :~: era)
Nothing -> Bool
False

instance NFData SealedTx where
    rnf :: SealedTx -> ()
rnf (SealedTx Bool
v (InAnyCardanoEra CardanoEra era
_ Tx era
tx) ByteString
bs) = String
tx' String -> ByteString -> ByteString
forall a b. NFData a => a -> b -> b
`deepseq` ByteString
bs ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
      where
        -- Showing the transaction should be enough to fully evaluate it.
        tx' :: String
tx' = if Bool
v then Tx era -> String
forall a. Show a => a -> String
show Tx era
tx else String
""

-- Helper function to constrain the era of a 'SealedTx' to at most the provided
-- era. If this is not possible, the original 'SealedTx' is returned.
--
-- In contrast to the "most recent era" argument of @sealedTxFromBytes'@, this
-- function allows constraining the era at a point after the tx has been
-- deserialised. For instance, in a server handler with known current era,
-- instead of in an @Aeson.FromJSON@ instance.
--
-- >>> ideallyNoLaterThan alonzoEra alonzoCompatibleBabbageTx
-- alonzoCompatibleBabbageTx
--
-- >>> ideallyNoLaterThan alonzoEra alonzoIncompatibleBabbageTx
-- babbageTx
--
-- == Is this what we want? (for the new tx-workflow..)
--
-- Probably not. This is a minimally invasive approach to ensure:
-- - tx workflow works in both Alonzo and Babbage
-- - tx workflow tries to create Alonzo txs in Alonzo and Babbage txs in Babbage
--
-- With the added behaviour:
-- - tx workflow may partially work for babbage-only txs when in alonzo
ideallyNoLaterThan
    :: AnyCardanoEra
    -> SealedTx
    -> SealedTx
ideallyNoLaterThan :: AnyCardanoEra -> SealedTx -> SealedTx
ideallyNoLaterThan AnyCardanoEra
maxEra SealedTx
sealedTx =
    (DecoderError -> SealedTx)
-> (InAnyCardanoEra Tx -> SealedTx)
-> Either DecoderError (InAnyCardanoEra Tx)
-> SealedTx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (SealedTx -> DecoderError -> SealedTx
forall a b. a -> b -> a
const SealedTx
sealedTx) (InAnyCardanoEra Tx -> SealedTx
sealedTxFromCardano)
        (AnyCardanoEra
-> ByteString -> Either DecoderError (InAnyCardanoEra Tx)
cardanoTxFromBytes AnyCardanoEra
maxEra (SealedTx -> ByteString
serialisedTx SealedTx
sealedTx))

cardanoTxIdeallyNoLaterThan
    :: AnyCardanoEra
    -> SealedTx
    -> InAnyCardanoEra Cardano.Tx
cardanoTxIdeallyNoLaterThan :: AnyCardanoEra -> SealedTx -> InAnyCardanoEra Tx
cardanoTxIdeallyNoLaterThan AnyCardanoEra
era = SealedTx -> InAnyCardanoEra Tx
unsafeCardanoTx (SealedTx -> InAnyCardanoEra Tx)
-> (SealedTx -> SealedTx) -> SealedTx -> InAnyCardanoEra Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCardanoEra -> SealedTx -> SealedTx
ideallyNoLaterThan AnyCardanoEra
era

getSealedTxBody :: SealedTx -> InAnyCardanoEra Cardano.TxBody
getSealedTxBody :: SealedTx -> InAnyCardanoEra TxBody
getSealedTxBody (SealedTx Bool
_ (InAnyCardanoEra CardanoEra era
era Tx era
tx) ByteString
_) =
    CardanoEra era -> TxBody era -> InAnyCardanoEra TxBody
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra era
era (Tx era -> TxBody era
forall era. Tx era -> TxBody era
Cardano.getTxBody Tx era
tx)

getSealedTxWitnesses :: SealedTx -> [InAnyCardanoEra Cardano.KeyWitness]
getSealedTxWitnesses :: SealedTx -> [InAnyCardanoEra KeyWitness]
getSealedTxWitnesses (SealedTx Bool
_ (InAnyCardanoEra CardanoEra era
era Tx era
tx) ByteString
_) =
    [CardanoEra era -> KeyWitness era -> InAnyCardanoEra KeyWitness
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra era
era KeyWitness era
w | KeyWitness era
w <- Tx era -> [KeyWitness era]
forall era. Tx era -> [KeyWitness era]
Cardano.getTxWitnesses Tx era
tx]

-- | Construct a 'SealedTx' from a "Cardano.Api" transaction.
sealedTxFromCardano :: InAnyCardanoEra Cardano.Tx -> SealedTx
sealedTxFromCardano :: InAnyCardanoEra Tx -> SealedTx
sealedTxFromCardano InAnyCardanoEra Tx
tx = Bool -> InAnyCardanoEra Tx -> ByteString -> SealedTx
SealedTx Bool
True InAnyCardanoEra Tx
tx (InAnyCardanoEra Tx -> ByteString
cardanoTxToBytes InAnyCardanoEra Tx
tx)
  where
    cardanoTxToBytes :: InAnyCardanoEra Cardano.Tx -> ByteString
    cardanoTxToBytes :: InAnyCardanoEra Tx -> ByteString
cardanoTxToBytes (InAnyCardanoEra CardanoEra era
_era Tx era
tx') = Tx era -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
Cardano.serialiseToCBOR Tx era
tx'

-- | Construct a 'SealedTx' from a "Cardano.Api" transaction.
sealedTxFromCardano' :: Cardano.IsCardanoEra era => Cardano.Tx era -> SealedTx
sealedTxFromCardano' :: Tx era -> SealedTx
sealedTxFromCardano' = InAnyCardanoEra Tx -> SealedTx
sealedTxFromCardano (InAnyCardanoEra Tx -> SealedTx)
-> (Tx era -> InAnyCardanoEra Tx) -> Tx era -> SealedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoEra era -> Tx era -> InAnyCardanoEra Tx
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra era
forall era. IsCardanoEra era => CardanoEra era
Cardano.cardanoEra

-- | Construct a 'SealedTx' from a 'Cardano.Api.TxBody'.
sealedTxFromCardanoBody :: Cardano.IsCardanoEra era => Cardano.TxBody era -> SealedTx
sealedTxFromCardanoBody :: TxBody era -> SealedTx
sealedTxFromCardanoBody = InAnyCardanoEra Tx -> SealedTx
sealedTxFromCardano (InAnyCardanoEra Tx -> SealedTx)
-> (TxBody era -> InAnyCardanoEra Tx) -> TxBody era -> SealedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoEra era -> Tx era -> InAnyCardanoEra Tx
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra era
forall era. IsCardanoEra era => CardanoEra era
Cardano.cardanoEra (Tx era -> InAnyCardanoEra Tx)
-> (TxBody era -> Tx era) -> TxBody era -> InAnyCardanoEra Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody era -> Tx era
forall era. TxBody era -> Tx era
mk
  where
    mk :: TxBody era -> Tx era
mk TxBody era
body = TxBody era -> [KeyWitness era] -> Tx era
forall era. TxBody era -> [KeyWitness era] -> Tx era
Cardano.Tx TxBody era
body []

-- | Deserialise a Cardano transaction. The transaction can be in the format of
-- any era. This function will try the most recent era first, then
-- previous eras until 'ByronEra'.
cardanoTxFromBytes
    :: AnyCardanoEra -- ^ Most recent era
    -> ByteString -- ^ Serialised transaction
    -> Either DecoderError (InAnyCardanoEra Cardano.Tx)
cardanoTxFromBytes :: AnyCardanoEra
-> ByteString -> Either DecoderError (InAnyCardanoEra Tx)
cardanoTxFromBytes AnyCardanoEra
maxEra ByteString
bs = [Either DecoderError (InAnyCardanoEra Tx)]
-> Either DecoderError (InAnyCardanoEra Tx)
forall e a. [Either e a] -> Either e a
asum ([Either DecoderError (InAnyCardanoEra Tx)]
 -> Either DecoderError (InAnyCardanoEra Tx))
-> [Either DecoderError (InAnyCardanoEra Tx)]
-> Either DecoderError (InAnyCardanoEra Tx)
forall a b. (a -> b) -> a -> b
$ ((AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
 -> Either DecoderError (InAnyCardanoEra Tx))
-> [(AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))]
-> [Either DecoderError (InAnyCardanoEra Tx)]
forall a b. (a -> b) -> [a] -> [b]
map (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
-> Either DecoderError (InAnyCardanoEra Tx)
forall a b. (a, b) -> b
snd ([(AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))]
 -> [Either DecoderError (InAnyCardanoEra Tx)])
-> [(AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))]
-> [Either DecoderError (InAnyCardanoEra Tx)]
forall a b. (a -> b) -> a -> b
$ ((AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx)) -> Bool)
-> [(AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))]
-> [(AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))]
forall a. (a -> Bool) -> [a] -> [a]
filter (AnyCardanoEra -> AnyCardanoEra -> Bool
withinEra AnyCardanoEra
maxEra (AnyCardanoEra -> Bool)
-> ((AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
    -> AnyCardanoEra)
-> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
-> AnyCardanoEra
forall a b. (a, b) -> a
fst)
    [ CardanoEra BabbageEra
-> AsType BabbageEra
-> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
forall era.
IsCardanoEra era =>
CardanoEra era
-> AsType era
-> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
deserialise CardanoEra BabbageEra
BabbageEra AsType BabbageEra
Cardano.AsBabbageEra
    , CardanoEra AlonzoEra
-> AsType AlonzoEra
-> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
forall era.
IsCardanoEra era =>
CardanoEra era
-> AsType era
-> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
deserialise CardanoEra AlonzoEra
AlonzoEra  AsType AlonzoEra
Cardano.AsAlonzoEra
    , CardanoEra MaryEra
-> AsType MaryEra
-> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
forall era.
IsCardanoEra era =>
CardanoEra era
-> AsType era
-> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
deserialise CardanoEra MaryEra
MaryEra    AsType MaryEra
Cardano.AsMaryEra
    , CardanoEra AllegraEra
-> AsType AllegraEra
-> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
forall era.
IsCardanoEra era =>
CardanoEra era
-> AsType era
-> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
deserialise CardanoEra AllegraEra
AllegraEra AsType AllegraEra
Cardano.AsAllegraEra
    , CardanoEra ShelleyEra
-> AsType ShelleyEra
-> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
forall era.
IsCardanoEra era =>
CardanoEra era
-> AsType era
-> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
deserialise CardanoEra ShelleyEra
ShelleyEra AsType ShelleyEra
Cardano.AsShelleyEra
    , CardanoEra ByronEra
-> AsType ByronEra
-> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
forall era.
IsCardanoEra era =>
CardanoEra era
-> AsType era
-> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
deserialise CardanoEra ByronEra
ByronEra   AsType ByronEra
Cardano.AsByronEra
    ]
  where
    deserialise
        :: forall era. Cardano.IsCardanoEra era
        => CardanoEra era
        -> Cardano.AsType era
        -> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Cardano.Tx))
    deserialise :: CardanoEra era
-> AsType era
-> (AnyCardanoEra, Either DecoderError (InAnyCardanoEra Tx))
deserialise CardanoEra era
era AsType era
asEra =
        ( CardanoEra era -> AnyCardanoEra
forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
era
        , CardanoEra era -> Tx era -> InAnyCardanoEra Tx
forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra era
era (Tx era -> InAnyCardanoEra Tx)
-> Either DecoderError (Tx era)
-> Either DecoderError (InAnyCardanoEra Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (Tx era) -> ByteString -> Either DecoderError (Tx era)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR (AsType era -> AsType (Tx era)
forall era. AsType era -> AsType (Tx era)
Cardano.AsTx AsType era
asEra) ByteString
bs
        )

    -- | Given a list of deserialise results that may fail, return the first
    -- success. If there was no success, then return the first failure message.
    asum :: [Either e a] -> Either e a
    asum :: [Either e a] -> Either e a
asum [Either e a]
xs = case [Either e a] -> ([e], [a])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either e a]
xs of
        ([e]
_, (a
a:[a]
_)) -> a -> Either e a
forall a b. b -> Either a b
Right a
a
        ((e
e:[e]
_), []) -> e -> Either e a
forall a b. a -> Either a b
Left e
e
        ([], []) -> Builder -> Either e a
forall a. HasCallStack => Builder -> a
internalError Builder
"cardanoTxFromBytes: impossible"

-- | @a `withinEra` b@ is 'True' iff @b@ is the same era as @a@, or an earlier
-- one.
withinEra :: AnyCardanoEra -> AnyCardanoEra -> Bool
withinEra :: AnyCardanoEra -> AnyCardanoEra -> Bool
withinEra = Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>=) (Int -> Int -> Bool)
-> (AnyCardanoEra -> Int) -> AnyCardanoEra -> AnyCardanoEra -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` AnyCardanoEra -> Int
numberEra
  where
    numberEra :: AnyCardanoEra -> Int
    numberEra :: AnyCardanoEra -> Int
numberEra (AnyCardanoEra CardanoEra era
e) = case CardanoEra era
e of
        CardanoEra era
ByronEra   -> Int
1
        CardanoEra era
ShelleyEra -> Int
2
        CardanoEra era
AllegraEra -> Int
3
        CardanoEra era
MaryEra    -> Int
4
        CardanoEra era
AlonzoEra  -> Int
5
        CardanoEra era
BabbageEra -> Int
6

-- | Deserialise a transaction to construct a 'SealedTx'.
sealedTxFromBytes :: ByteString -> Either DecoderError SealedTx
sealedTxFromBytes :: ByteString -> Either DecoderError SealedTx
sealedTxFromBytes = AnyCardanoEra -> ByteString -> Either DecoderError SealedTx
sealedTxFromBytes' (CardanoEra BabbageEra -> AnyCardanoEra
forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra BabbageEra
BabbageEra)

-- | Deserialise a transaction to construct a 'SealedTx'.
sealedTxFromBytes'
    :: AnyCardanoEra -- ^ Most recent era
    -> ByteString -- ^ Serialised transaction
    -> Either DecoderError SealedTx
sealedTxFromBytes' :: AnyCardanoEra -> ByteString -> Either DecoderError SealedTx
sealedTxFromBytes' AnyCardanoEra
era ByteString
bs = Bool -> InAnyCardanoEra Tx -> ByteString -> SealedTx
SealedTx Bool
True
    (InAnyCardanoEra Tx -> ByteString -> SealedTx)
-> Either DecoderError (InAnyCardanoEra Tx)
-> Either DecoderError (ByteString -> SealedTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnyCardanoEra
-> ByteString -> Either DecoderError (InAnyCardanoEra Tx)
cardanoTxFromBytes AnyCardanoEra
era ByteString
bs
    Either DecoderError (ByteString -> SealedTx)
-> Either DecoderError ByteString -> Either DecoderError SealedTx
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Either DecoderError ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs

-- | Serialise a 'SealedTx' for storage in a database field. The difference
-- between 'persistSealedTx' and 'serialisedTx' is that this function has a
-- special check for values created by 'mockSealedTx'.
persistSealedTx :: SealedTx -> ByteString
persistSealedTx :: SealedTx -> ByteString
persistSealedTx SealedTx
tx = ByteString
header ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SealedTx -> ByteString
serialisedTx SealedTx
tx
  where
    header :: ByteString
header = if SealedTx -> Bool
valid SealedTx
tx then ByteString
forall a. Monoid a => a
mempty else ByteString
mockSealedTxMagic

-- | Deserialise a 'SealedTx' which has been stored in a database field. This
-- function includes a special check for 'mockSealedTx' values.
unPersistSealedTx :: ByteString -> Either Text SealedTx
unPersistSealedTx :: ByteString -> Either Text SealedTx
unPersistSealedTx ByteString
bs = case ByteString -> Maybe ByteString
unPersistMock ByteString
bs of
    Maybe ByteString
Nothing -> (DecoderError -> Text)
-> Either DecoderError SealedTx -> Either Text SealedTx
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
T.pack (String -> Text)
-> (DecoderError -> String) -> DecoderError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> String
forall a. Show a => a -> String
show) (Either DecoderError SealedTx -> Either Text SealedTx)
-> Either DecoderError SealedTx -> Either Text SealedTx
forall a b. (a -> b) -> a -> b
$ ByteString -> Either DecoderError SealedTx
sealedTxFromBytes ByteString
bs
    Just ByteString
bs' -> SealedTx -> Either Text SealedTx
forall a b. b -> Either a b
Right (SealedTx -> Either Text SealedTx)
-> SealedTx -> Either Text SealedTx
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> SealedTx
ByteString -> SealedTx
mockSealedTx ByteString
bs'

-- | A header for use by 'persistSealedTx' and 'unPersistSealedTx'. A valid
-- serialised Cardano transaction could not have this header, because they
-- always start with a CBOR map.
mockSealedTxMagic :: ByteString
mockSealedTxMagic :: ByteString
mockSealedTxMagic = ByteString
"MOCK"

unPersistMock :: ByteString -> Maybe ByteString
unPersistMock :: ByteString -> Maybe ByteString
unPersistMock ByteString
bs
    | ByteString
header ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
mockSealedTxMagic = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
body
    | Bool
otherwise = Maybe ByteString
forall a. Maybe a
Nothing
  where
    (ByteString
header, ByteString
body) = Int -> ByteString -> (ByteString, ByteString)
B8.splitAt (ByteString -> Int
B8.length ByteString
mockSealedTxMagic) ByteString
bs

-- | Get the serialised transaction body and witnesses from a 'SealedTx'.
getSerialisedTxParts :: SealedTx -> SerialisedTxParts
getSerialisedTxParts :: SealedTx -> SerialisedTxParts
getSerialisedTxParts (SealedTx Bool
_ (InAnyCardanoEra CardanoEra era
_ Tx era
tx) ByteString
_) = SerialisedTxParts :: ByteString -> [ByteString] -> SerialisedTxParts
SerialisedTxParts
    { $sel:serialisedTxBody:SerialisedTxParts :: ByteString
serialisedTxBody = TxBody era -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR (TxBody era -> ByteString) -> TxBody era -> ByteString
forall a b. (a -> b) -> a -> b
$ Tx era -> TxBody era
forall era. Tx era -> TxBody era
Cardano.getTxBody Tx era
tx
    , $sel:serialisedTxWitnesses:SerialisedTxParts :: [ByteString]
serialisedTxWitnesses = KeyWitness era -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR (KeyWitness era -> ByteString) -> [KeyWitness era] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tx era -> [KeyWitness era]
forall era. Tx era -> [KeyWitness era]
Cardano.getTxWitnesses Tx era
tx
    }

-- | A serialised transaction that may be only partially signed, or even
-- invalid.
newtype SerialisedTx = SerialisedTx { SerialisedTx -> ByteString
payload :: ByteString }
    deriving stock (Int -> SerialisedTx -> ShowS
[SerialisedTx] -> ShowS
SerialisedTx -> String
(Int -> SerialisedTx -> ShowS)
-> (SerialisedTx -> String)
-> ([SerialisedTx] -> ShowS)
-> Show SerialisedTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SerialisedTx] -> ShowS
$cshowList :: [SerialisedTx] -> ShowS
show :: SerialisedTx -> String
$cshow :: SerialisedTx -> String
showsPrec :: Int -> SerialisedTx -> ShowS
$cshowsPrec :: Int -> SerialisedTx -> ShowS
Show, SerialisedTx -> SerialisedTx -> Bool
(SerialisedTx -> SerialisedTx -> Bool)
-> (SerialisedTx -> SerialisedTx -> Bool) -> Eq SerialisedTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SerialisedTx -> SerialisedTx -> Bool
$c/= :: SerialisedTx -> SerialisedTx -> Bool
== :: SerialisedTx -> SerialisedTx -> Bool
$c== :: SerialisedTx -> SerialisedTx -> Bool
Eq, (forall x. SerialisedTx -> Rep SerialisedTx x)
-> (forall x. Rep SerialisedTx x -> SerialisedTx)
-> Generic SerialisedTx
forall x. Rep SerialisedTx x -> SerialisedTx
forall x. SerialisedTx -> Rep SerialisedTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SerialisedTx x -> SerialisedTx
$cfrom :: forall x. SerialisedTx -> Rep SerialisedTx x
Generic, Eq SerialisedTx
Eq SerialisedTx
-> (SerialisedTx -> SerialisedTx -> Ordering)
-> (SerialisedTx -> SerialisedTx -> Bool)
-> (SerialisedTx -> SerialisedTx -> Bool)
-> (SerialisedTx -> SerialisedTx -> Bool)
-> (SerialisedTx -> SerialisedTx -> Bool)
-> (SerialisedTx -> SerialisedTx -> SerialisedTx)
-> (SerialisedTx -> SerialisedTx -> SerialisedTx)
-> Ord SerialisedTx
SerialisedTx -> SerialisedTx -> Bool
SerialisedTx -> SerialisedTx -> Ordering
SerialisedTx -> SerialisedTx -> SerialisedTx
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 :: SerialisedTx -> SerialisedTx -> SerialisedTx
$cmin :: SerialisedTx -> SerialisedTx -> SerialisedTx
max :: SerialisedTx -> SerialisedTx -> SerialisedTx
$cmax :: SerialisedTx -> SerialisedTx -> SerialisedTx
>= :: SerialisedTx -> SerialisedTx -> Bool
$c>= :: SerialisedTx -> SerialisedTx -> Bool
> :: SerialisedTx -> SerialisedTx -> Bool
$c> :: SerialisedTx -> SerialisedTx -> Bool
<= :: SerialisedTx -> SerialisedTx -> Bool
$c<= :: SerialisedTx -> SerialisedTx -> Bool
< :: SerialisedTx -> SerialisedTx -> Bool
$c< :: SerialisedTx -> SerialisedTx -> Bool
compare :: SerialisedTx -> SerialisedTx -> Ordering
$ccompare :: SerialisedTx -> SerialisedTx -> Ordering
$cp1Ord :: Eq SerialisedTx
Ord)
    deriving newtype (b -> SerialisedTx -> SerialisedTx
NonEmpty SerialisedTx -> SerialisedTx
SerialisedTx -> SerialisedTx -> SerialisedTx
(SerialisedTx -> SerialisedTx -> SerialisedTx)
-> (NonEmpty SerialisedTx -> SerialisedTx)
-> (forall b. Integral b => b -> SerialisedTx -> SerialisedTx)
-> Semigroup SerialisedTx
forall b. Integral b => b -> SerialisedTx -> SerialisedTx
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> SerialisedTx -> SerialisedTx
$cstimes :: forall b. Integral b => b -> SerialisedTx -> SerialisedTx
sconcat :: NonEmpty SerialisedTx -> SerialisedTx
$csconcat :: NonEmpty SerialisedTx -> SerialisedTx
<> :: SerialisedTx -> SerialisedTx -> SerialisedTx
$c<> :: SerialisedTx -> SerialisedTx -> SerialisedTx
Semigroup, Semigroup SerialisedTx
SerialisedTx
Semigroup SerialisedTx
-> SerialisedTx
-> (SerialisedTx -> SerialisedTx -> SerialisedTx)
-> ([SerialisedTx] -> SerialisedTx)
-> Monoid SerialisedTx
[SerialisedTx] -> SerialisedTx
SerialisedTx -> SerialisedTx -> SerialisedTx
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [SerialisedTx] -> SerialisedTx
$cmconcat :: [SerialisedTx] -> SerialisedTx
mappend :: SerialisedTx -> SerialisedTx -> SerialisedTx
$cmappend :: SerialisedTx -> SerialisedTx -> SerialisedTx
mempty :: SerialisedTx
$cmempty :: SerialisedTx
$cp1Monoid :: Semigroup SerialisedTx
Monoid, Eq SerialisedTx
Ord SerialisedTx
Monoid SerialisedTx
ByteArrayAccess SerialisedTx
Eq SerialisedTx
-> Ord SerialisedTx
-> Monoid SerialisedTx
-> ByteArrayAccess SerialisedTx
-> (forall p a. Int -> (Ptr p -> IO a) -> IO (a, SerialisedTx))
-> ByteArray SerialisedTx
Int -> (Ptr p -> IO a) -> IO (a, SerialisedTx)
forall ba.
Eq ba
-> Ord ba
-> Monoid ba
-> ByteArrayAccess ba
-> (forall p a. Int -> (Ptr p -> IO a) -> IO (a, ba))
-> ByteArray ba
forall p a. Int -> (Ptr p -> IO a) -> IO (a, SerialisedTx)
allocRet :: Int -> (Ptr p -> IO a) -> IO (a, SerialisedTx)
$callocRet :: forall p a. Int -> (Ptr p -> IO a) -> IO (a, SerialisedTx)
$cp4ByteArray :: ByteArrayAccess SerialisedTx
$cp3ByteArray :: Monoid SerialisedTx
$cp2ByteArray :: Ord SerialisedTx
$cp1ByteArray :: Eq SerialisedTx
ByteArray, SerialisedTx -> Int
SerialisedTx -> Ptr p -> IO ()
SerialisedTx -> (Ptr p -> IO a) -> IO a
(SerialisedTx -> Int)
-> (forall p a. SerialisedTx -> (Ptr p -> IO a) -> IO a)
-> (forall p. SerialisedTx -> Ptr p -> IO ())
-> ByteArrayAccess SerialisedTx
forall p. SerialisedTx -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. SerialisedTx -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: SerialisedTx -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. SerialisedTx -> Ptr p -> IO ()
withByteArray :: SerialisedTx -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. SerialisedTx -> (Ptr p -> IO a) -> IO a
length :: SerialisedTx -> Int
$clength :: SerialisedTx -> Int
ByteArrayAccess, SerialisedTx -> ()
(SerialisedTx -> ()) -> NFData SerialisedTx
forall a. (a -> ()) -> NFData a
rnf :: SerialisedTx -> ()
$crnf :: SerialisedTx -> ()
NFData)

-- | @SerialisedTxParts@ is a serialised transaction body, and a possibly
-- incomplete set of serialised witnesses.
data SerialisedTxParts = SerialisedTxParts
    { SerialisedTxParts -> ByteString
serialisedTxBody :: ByteString
    , SerialisedTxParts -> [ByteString]
serialisedTxWitnesses :: [ByteString]
    } deriving stock (Int -> SerialisedTxParts -> ShowS
[SerialisedTxParts] -> ShowS
SerialisedTxParts -> String
(Int -> SerialisedTxParts -> ShowS)
-> (SerialisedTxParts -> String)
-> ([SerialisedTxParts] -> ShowS)
-> Show SerialisedTxParts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SerialisedTxParts] -> ShowS
$cshowList :: [SerialisedTxParts] -> ShowS
show :: SerialisedTxParts -> String
$cshow :: SerialisedTxParts -> String
showsPrec :: Int -> SerialisedTxParts -> ShowS
$cshowsPrec :: Int -> SerialisedTxParts -> ShowS
Show, SerialisedTxParts -> SerialisedTxParts -> Bool
(SerialisedTxParts -> SerialisedTxParts -> Bool)
-> (SerialisedTxParts -> SerialisedTxParts -> Bool)
-> Eq SerialisedTxParts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SerialisedTxParts -> SerialisedTxParts -> Bool
$c/= :: SerialisedTxParts -> SerialisedTxParts -> Bool
== :: SerialisedTxParts -> SerialisedTxParts -> Bool
$c== :: SerialisedTxParts -> SerialisedTxParts -> Bool
Eq, (forall x. SerialisedTxParts -> Rep SerialisedTxParts x)
-> (forall x. Rep SerialisedTxParts x -> SerialisedTxParts)
-> Generic SerialisedTxParts
forall x. Rep SerialisedTxParts x -> SerialisedTxParts
forall x. SerialisedTxParts -> Rep SerialisedTxParts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SerialisedTxParts x -> SerialisedTxParts
$cfrom :: forall x. SerialisedTxParts -> Rep SerialisedTxParts x
Generic)

-- | True if the given metadata refers to a pending transaction
isPending :: TxMeta -> Bool
isPending :: TxMeta -> Bool
isPending = (TxStatus -> TxStatus -> Bool
forall a. Eq a => a -> a -> Bool
== TxStatus
Pending) (TxStatus -> Bool) -> (TxMeta -> TxStatus) -> TxMeta -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxMeta -> TxStatus
status :: TxMeta -> TxStatus)

-- | Full expanded and resolved information about a transaction, suitable for
-- presentation to the user.
data TransactionInfo = TransactionInfo
    { TransactionInfo -> Hash "Tx"
txInfoId :: !(Hash "Tx")
    -- ^ Transaction ID of this transaction
    , TransactionInfo -> Maybe Coin
txInfoFee :: !(Maybe Coin)
    -- ^ Explicit transaction fee
    , TransactionInfo -> [(TxIn, Coin, Maybe TxOut)]
txInfoInputs :: ![(TxIn, Coin, Maybe TxOut)]
    -- ^ Transaction inputs and (maybe) corresponding outputs of the
    -- source. Source information can only be provided for outgoing payments.
    , TransactionInfo -> [(TxIn, Coin, Maybe TxOut)]
txInfoCollateralInputs :: ![(TxIn, Coin, Maybe TxOut)]
    -- ^ Collateral inputs and (maybe) corresponding outputs.
    , TransactionInfo -> [TxOut]
txInfoOutputs :: ![TxOut]
    -- ^ Payment destination.
    , TransactionInfo -> Maybe TxOut
txInfoCollateralOutput :: !(Maybe TxOut)
    -- ^ An output that is only created if a transaction script fails.
    , TransactionInfo -> Map RewardAccount Coin
txInfoWithdrawals :: !(Map RewardAccount Coin)
    -- ^ Withdrawals on this transaction.
    , TransactionInfo -> TxMeta
txInfoMeta :: !TxMeta
    -- ^ Other information calculated from the transaction.
    , TransactionInfo -> Quantity "block" Natural
txInfoDepth :: Quantity "block" Natural
    -- ^ Number of slots since the transaction slot.
    , TransactionInfo -> UTCTime
txInfoTime :: UTCTime
    -- ^ Creation time of the block including this transaction.
    , TransactionInfo -> Maybe TxMetadata
txInfoMetadata :: !(Maybe TxMetadata)
    -- ^ Application-specific extension data.
    , TransactionInfo -> Maybe TxScriptValidity
txInfoScriptValidity :: !(Maybe TxScriptValidity)
    -- ^ Tag indicating whether non-native scripts in this transaction passed
    -- validation. This is added by the block creator when constructing the
    -- block. May be 'Nothing' for pre-Alonzo and pending transactions.
    } deriving ((forall x. TransactionInfo -> Rep TransactionInfo x)
-> (forall x. Rep TransactionInfo x -> TransactionInfo)
-> Generic TransactionInfo
forall x. Rep TransactionInfo x -> TransactionInfo
forall x. TransactionInfo -> Rep TransactionInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransactionInfo x -> TransactionInfo
$cfrom :: forall x. TransactionInfo -> Rep TransactionInfo x
Generic, Int -> TransactionInfo -> ShowS
[TransactionInfo] -> ShowS
TransactionInfo -> String
(Int -> TransactionInfo -> ShowS)
-> (TransactionInfo -> String)
-> ([TransactionInfo] -> ShowS)
-> Show TransactionInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionInfo] -> ShowS
$cshowList :: [TransactionInfo] -> ShowS
show :: TransactionInfo -> String
$cshow :: TransactionInfo -> String
showsPrec :: Int -> TransactionInfo -> ShowS
$cshowsPrec :: Int -> TransactionInfo -> ShowS
Show, TransactionInfo -> TransactionInfo -> Bool
(TransactionInfo -> TransactionInfo -> Bool)
-> (TransactionInfo -> TransactionInfo -> Bool)
-> Eq TransactionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactionInfo -> TransactionInfo -> Bool
$c/= :: TransactionInfo -> TransactionInfo -> Bool
== :: TransactionInfo -> TransactionInfo -> Bool
$c== :: TransactionInfo -> TransactionInfo -> Bool
Eq)

instance NFData TransactionInfo

-- | Indicates whether or not a transaction is marked as having an invalid
--   script.
--
-- Pre-Alonzo era, scripts were not supported.
--
data TxScriptValidity
    = TxScriptValid
    -- ^ The transaction is not marked as having an invalid script.
    | TxScriptInvalid
    -- ^ The transaction is marked as having an invalid script.
  deriving ((forall x. TxScriptValidity -> Rep TxScriptValidity x)
-> (forall x. Rep TxScriptValidity x -> TxScriptValidity)
-> Generic TxScriptValidity
forall x. Rep TxScriptValidity x -> TxScriptValidity
forall x. TxScriptValidity -> Rep TxScriptValidity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxScriptValidity x -> TxScriptValidity
$cfrom :: forall x. TxScriptValidity -> Rep TxScriptValidity x
Generic, Int -> TxScriptValidity -> ShowS
[TxScriptValidity] -> ShowS
TxScriptValidity -> String
(Int -> TxScriptValidity -> ShowS)
-> (TxScriptValidity -> String)
-> ([TxScriptValidity] -> ShowS)
-> Show TxScriptValidity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxScriptValidity] -> ShowS
$cshowList :: [TxScriptValidity] -> ShowS
show :: TxScriptValidity -> String
$cshow :: TxScriptValidity -> String
showsPrec :: Int -> TxScriptValidity -> ShowS
$cshowsPrec :: Int -> TxScriptValidity -> ShowS
Show, TxScriptValidity -> TxScriptValidity -> Bool
(TxScriptValidity -> TxScriptValidity -> Bool)
-> (TxScriptValidity -> TxScriptValidity -> Bool)
-> Eq TxScriptValidity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxScriptValidity -> TxScriptValidity -> Bool
$c/= :: TxScriptValidity -> TxScriptValidity -> Bool
== :: TxScriptValidity -> TxScriptValidity -> Bool
$c== :: TxScriptValidity -> TxScriptValidity -> Bool
Eq, Eq TxScriptValidity
Eq TxScriptValidity
-> (TxScriptValidity -> TxScriptValidity -> Ordering)
-> (TxScriptValidity -> TxScriptValidity -> Bool)
-> (TxScriptValidity -> TxScriptValidity -> Bool)
-> (TxScriptValidity -> TxScriptValidity -> Bool)
-> (TxScriptValidity -> TxScriptValidity -> Bool)
-> (TxScriptValidity -> TxScriptValidity -> TxScriptValidity)
-> (TxScriptValidity -> TxScriptValidity -> TxScriptValidity)
-> Ord TxScriptValidity
TxScriptValidity -> TxScriptValidity -> Bool
TxScriptValidity -> TxScriptValidity -> Ordering
TxScriptValidity -> TxScriptValidity -> TxScriptValidity
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 :: TxScriptValidity -> TxScriptValidity -> TxScriptValidity
$cmin :: TxScriptValidity -> TxScriptValidity -> TxScriptValidity
max :: TxScriptValidity -> TxScriptValidity -> TxScriptValidity
$cmax :: TxScriptValidity -> TxScriptValidity -> TxScriptValidity
>= :: TxScriptValidity -> TxScriptValidity -> Bool
$c>= :: TxScriptValidity -> TxScriptValidity -> Bool
> :: TxScriptValidity -> TxScriptValidity -> Bool
$c> :: TxScriptValidity -> TxScriptValidity -> Bool
<= :: TxScriptValidity -> TxScriptValidity -> Bool
$c<= :: TxScriptValidity -> TxScriptValidity -> Bool
< :: TxScriptValidity -> TxScriptValidity -> Bool
$c< :: TxScriptValidity -> TxScriptValidity -> Bool
compare :: TxScriptValidity -> TxScriptValidity -> Ordering
$ccompare :: TxScriptValidity -> TxScriptValidity -> Ordering
$cp1Ord :: Eq TxScriptValidity
Ord)

instance NFData TxScriptValidity

-- | Returns 'True' if (and only if) the given transaction is marked as having
--   an invalid script.
--
-- This function does not actually verify the validity of scripts; it merely
-- checks for the presence or absence of the 'TxScriptInvalid' marker.
--
txScriptInvalid :: Tx -> Bool
txScriptInvalid :: Tx -> Bool
txScriptInvalid Tx {Maybe TxScriptValidity
scriptValidity :: Maybe TxScriptValidity
$sel:scriptValidity:Tx :: Tx -> Maybe TxScriptValidity
scriptValidity} = case Maybe TxScriptValidity
scriptValidity of
  Just TxScriptValidity
TxScriptInvalid -> Bool
True
  Just TxScriptValidity
TxScriptValid -> Bool
False
  -- Script validation always passes in eras that don't support scripts
  Maybe TxScriptValidity
Nothing -> Bool
False

-- | Reconstruct a transaction info from a transaction.
fromTransactionInfo :: TransactionInfo -> Tx
fromTransactionInfo :: TransactionInfo -> Tx
fromTransactionInfo TransactionInfo
info = Tx :: Hash "Tx"
-> Maybe Coin
-> [(TxIn, Coin)]
-> [(TxIn, Coin)]
-> [TxOut]
-> Maybe TxOut
-> Map RewardAccount Coin
-> Maybe TxMetadata
-> Maybe TxScriptValidity
-> Tx
Tx
    { $sel:txId:Tx :: Hash "Tx"
txId = TransactionInfo -> Hash "Tx"
txInfoId TransactionInfo
info
    , $sel:fee:Tx :: Maybe Coin
fee = TransactionInfo -> Maybe Coin
txInfoFee TransactionInfo
info
    , $sel:resolvedInputs:Tx :: [(TxIn, Coin)]
resolvedInputs = (TxIn, Coin, Maybe TxOut) -> (TxIn, Coin)
forall a b c. (a, b, c) -> (a, b)
drop3rd ((TxIn, Coin, Maybe TxOut) -> (TxIn, Coin))
-> [(TxIn, Coin, Maybe TxOut)] -> [(TxIn, Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransactionInfo -> [(TxIn, Coin, Maybe TxOut)]
txInfoInputs TransactionInfo
info
    , $sel:resolvedCollateralInputs:Tx :: [(TxIn, Coin)]
resolvedCollateralInputs = (TxIn, Coin, Maybe TxOut) -> (TxIn, Coin)
forall a b c. (a, b, c) -> (a, b)
drop3rd ((TxIn, Coin, Maybe TxOut) -> (TxIn, Coin))
-> [(TxIn, Coin, Maybe TxOut)] -> [(TxIn, Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransactionInfo -> [(TxIn, Coin, Maybe TxOut)]
txInfoCollateralInputs TransactionInfo
info
    , $sel:outputs:Tx :: [TxOut]
outputs = TransactionInfo -> [TxOut]
txInfoOutputs TransactionInfo
info
    , $sel:collateralOutput:Tx :: Maybe TxOut
collateralOutput = TransactionInfo -> Maybe TxOut
txInfoCollateralOutput TransactionInfo
info
    , $sel:withdrawals:Tx :: Map RewardAccount Coin
withdrawals = TransactionInfo -> Map RewardAccount Coin
txInfoWithdrawals TransactionInfo
info
    , $sel:metadata:Tx :: Maybe TxMetadata
metadata = TransactionInfo -> Maybe TxMetadata
txInfoMetadata TransactionInfo
info
    , $sel:scriptValidity:Tx :: Maybe TxScriptValidity
scriptValidity = TransactionInfo -> Maybe TxScriptValidity
txInfoScriptValidity TransactionInfo
info
    }
  where
    drop3rd :: (a, b, c) -> (a, b)
    drop3rd :: (a, b, c) -> (a, b)
drop3rd (a
a, b
b, c
_) = (a
a, b
b)

-- | Test whether the given metadata map is empty.
txMetadataIsNull :: TxMetadata -> Bool
txMetadataIsNull :: TxMetadata -> Bool
txMetadataIsNull (TxMetadata Map Word64 TxMetadataValue
md) = Map Word64 TxMetadataValue -> Bool
forall k a. Map k a -> Bool
Map.null Map Word64 TxMetadataValue
md

-- | Drop time-specific information
toTxHistory :: TransactionInfo -> (Tx, TxMeta)
toTxHistory :: TransactionInfo -> (Tx, TxMeta)
toTxHistory TransactionInfo
info =
    (TransactionInfo -> Tx
fromTransactionInfo TransactionInfo
info, TransactionInfo -> TxMeta
txInfoMeta TransactionInfo
info)

-- | Information about when a transaction was submitted to the local node.
-- This is used for scheduling resubmissions.
data LocalTxSubmissionStatus tx = LocalTxSubmissionStatus
    { LocalTxSubmissionStatus tx -> Hash "Tx"
txId :: !(Hash "Tx")
    , LocalTxSubmissionStatus tx -> tx
submittedTx :: !tx
    , LocalTxSubmissionStatus tx -> SlotNo
firstSubmission :: !SlotNo
    -- ^ Time of first successful submission to the local node.
    , LocalTxSubmissionStatus tx -> SlotNo
latestSubmission :: !SlotNo
    -- ^ Time of most recent resubmission attempt.
    } deriving stock ((forall x.
 LocalTxSubmissionStatus tx -> Rep (LocalTxSubmissionStatus tx) x)
-> (forall x.
    Rep (LocalTxSubmissionStatus tx) x -> LocalTxSubmissionStatus tx)
-> Generic (LocalTxSubmissionStatus tx)
forall x.
Rep (LocalTxSubmissionStatus tx) x -> LocalTxSubmissionStatus tx
forall x.
LocalTxSubmissionStatus tx -> Rep (LocalTxSubmissionStatus tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x.
Rep (LocalTxSubmissionStatus tx) x -> LocalTxSubmissionStatus tx
forall tx x.
LocalTxSubmissionStatus tx -> Rep (LocalTxSubmissionStatus tx) x
$cto :: forall tx x.
Rep (LocalTxSubmissionStatus tx) x -> LocalTxSubmissionStatus tx
$cfrom :: forall tx x.
LocalTxSubmissionStatus tx -> Rep (LocalTxSubmissionStatus tx) x
Generic, Int -> LocalTxSubmissionStatus tx -> ShowS
[LocalTxSubmissionStatus tx] -> ShowS
LocalTxSubmissionStatus tx -> String
(Int -> LocalTxSubmissionStatus tx -> ShowS)
-> (LocalTxSubmissionStatus tx -> String)
-> ([LocalTxSubmissionStatus tx] -> ShowS)
-> Show (LocalTxSubmissionStatus tx)
forall tx. Show tx => Int -> LocalTxSubmissionStatus tx -> ShowS
forall tx. Show tx => [LocalTxSubmissionStatus tx] -> ShowS
forall tx. Show tx => LocalTxSubmissionStatus tx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalTxSubmissionStatus tx] -> ShowS
$cshowList :: forall tx. Show tx => [LocalTxSubmissionStatus tx] -> ShowS
show :: LocalTxSubmissionStatus tx -> String
$cshow :: forall tx. Show tx => LocalTxSubmissionStatus tx -> String
showsPrec :: Int -> LocalTxSubmissionStatus tx -> ShowS
$cshowsPrec :: forall tx. Show tx => Int -> LocalTxSubmissionStatus tx -> ShowS
Show, LocalTxSubmissionStatus tx -> LocalTxSubmissionStatus tx -> Bool
(LocalTxSubmissionStatus tx -> LocalTxSubmissionStatus tx -> Bool)
-> (LocalTxSubmissionStatus tx
    -> LocalTxSubmissionStatus tx -> Bool)
-> Eq (LocalTxSubmissionStatus tx)
forall tx.
Eq tx =>
LocalTxSubmissionStatus tx -> LocalTxSubmissionStatus tx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalTxSubmissionStatus tx -> LocalTxSubmissionStatus tx -> Bool
$c/= :: forall tx.
Eq tx =>
LocalTxSubmissionStatus tx -> LocalTxSubmissionStatus tx -> Bool
== :: LocalTxSubmissionStatus tx -> LocalTxSubmissionStatus tx -> Bool
$c== :: forall tx.
Eq tx =>
LocalTxSubmissionStatus tx -> LocalTxSubmissionStatus tx -> Bool
Eq, a -> LocalTxSubmissionStatus b -> LocalTxSubmissionStatus a
(a -> b) -> LocalTxSubmissionStatus a -> LocalTxSubmissionStatus b
(forall a b.
 (a -> b) -> LocalTxSubmissionStatus a -> LocalTxSubmissionStatus b)
-> (forall a b.
    a -> LocalTxSubmissionStatus b -> LocalTxSubmissionStatus a)
-> Functor LocalTxSubmissionStatus
forall a b.
a -> LocalTxSubmissionStatus b -> LocalTxSubmissionStatus a
forall a b.
(a -> b) -> LocalTxSubmissionStatus a -> LocalTxSubmissionStatus b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LocalTxSubmissionStatus b -> LocalTxSubmissionStatus a
$c<$ :: forall a b.
a -> LocalTxSubmissionStatus b -> LocalTxSubmissionStatus a
fmap :: (a -> b) -> LocalTxSubmissionStatus a -> LocalTxSubmissionStatus b
$cfmap :: forall a b.
(a -> b) -> LocalTxSubmissionStatus a -> LocalTxSubmissionStatus b
Functor)

-- | A function capable of assessing the size of a token bundle relative to the
--   upper limit of what can be included in a single transaction output.
--
-- In general, a token bundle size assessment function 'f' should satisfy the
-- following properties:
--
--    * Enlarging a bundle that exceeds the limit should also result in a
--      bundle that exceeds the limit:
--      @
--              f  b1           == TokenBundleSizeExceedsLimit
--          ==> f (b1 `add` b2) == TokenBundleSizeExceedsLimit
--      @
--
--    * Shrinking a bundle that's within the limit should also result in a
--      bundle that's within the limit:
--      @
--              f  b1                  == TokenBundleWithinLimit
--          ==> f (b1 `difference` b2) == TokenBundleWithinLimit
--      @
--
newtype TokenBundleSizeAssessor = TokenBundleSizeAssessor
    { TokenBundleSizeAssessor -> TokenBundle -> TokenBundleSizeAssessment
assessTokenBundleSize :: TokenBundle -> TokenBundleSizeAssessment
    }
    deriving (forall x.
 TokenBundleSizeAssessor -> Rep TokenBundleSizeAssessor x)
-> (forall x.
    Rep TokenBundleSizeAssessor x -> TokenBundleSizeAssessor)
-> Generic TokenBundleSizeAssessor
forall x. Rep TokenBundleSizeAssessor x -> TokenBundleSizeAssessor
forall x. TokenBundleSizeAssessor -> Rep TokenBundleSizeAssessor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenBundleSizeAssessor x -> TokenBundleSizeAssessor
$cfrom :: forall x. TokenBundleSizeAssessor -> Rep TokenBundleSizeAssessor x
Generic

-- | Indicates the size of a token bundle relative to the upper limit of what
--   can be included in a single transaction output, defined by the protocol.
--
data TokenBundleSizeAssessment
    = TokenBundleSizeWithinLimit
    -- ^ Indicates that the size of a token bundle does not exceed the maximum
    -- size that can be included in a transaction output.
    | TokenBundleSizeExceedsLimit
    -- ^ Indicates that the size of a token bundle exceeds the maximum size
    -- that can be included in a transaction output.
    deriving (TokenBundleSizeAssessment -> TokenBundleSizeAssessment -> Bool
(TokenBundleSizeAssessment -> TokenBundleSizeAssessment -> Bool)
-> (TokenBundleSizeAssessment -> TokenBundleSizeAssessment -> Bool)
-> Eq TokenBundleSizeAssessment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenBundleSizeAssessment -> TokenBundleSizeAssessment -> Bool
$c/= :: TokenBundleSizeAssessment -> TokenBundleSizeAssessment -> Bool
== :: TokenBundleSizeAssessment -> TokenBundleSizeAssessment -> Bool
$c== :: TokenBundleSizeAssessment -> TokenBundleSizeAssessment -> Bool
Eq, (forall x.
 TokenBundleSizeAssessment -> Rep TokenBundleSizeAssessment x)
-> (forall x.
    Rep TokenBundleSizeAssessment x -> TokenBundleSizeAssessment)
-> Generic TokenBundleSizeAssessment
forall x.
Rep TokenBundleSizeAssessment x -> TokenBundleSizeAssessment
forall x.
TokenBundleSizeAssessment -> Rep TokenBundleSizeAssessment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep TokenBundleSizeAssessment x -> TokenBundleSizeAssessment
$cfrom :: forall x.
TokenBundleSizeAssessment -> Rep TokenBundleSizeAssessment x
Generic, Int -> TokenBundleSizeAssessment -> ShowS
[TokenBundleSizeAssessment] -> ShowS
TokenBundleSizeAssessment -> String
(Int -> TokenBundleSizeAssessment -> ShowS)
-> (TokenBundleSizeAssessment -> String)
-> ([TokenBundleSizeAssessment] -> ShowS)
-> Show TokenBundleSizeAssessment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenBundleSizeAssessment] -> ShowS
$cshowList :: [TokenBundleSizeAssessment] -> ShowS
show :: TokenBundleSizeAssessment -> String
$cshow :: TokenBundleSizeAssessment -> String
showsPrec :: Int -> TokenBundleSizeAssessment -> ShowS
$cshowsPrec :: Int -> TokenBundleSizeAssessment -> ShowS
Show)

--------------------------------------------------------------------------------
-- Constants
--------------------------------------------------------------------------------

-- | The smallest quantity of lovelace that can appear in a transaction output's
--   token bundle.
--
txOutMinCoin :: Coin
txOutMinCoin :: Coin
txOutMinCoin = Natural -> Coin
Coin Natural
0

-- | The greatest quantity of lovelace that can appear in a transaction output's
--   token bundle.
--
txOutMaxCoin :: Coin
txOutMaxCoin :: Coin
txOutMaxCoin = Natural -> Coin
Coin Natural
45_000_000_000_000_000

-- | The smallest token quantity that can appear in a transaction output's
--   token bundle.
--
txOutMinTokenQuantity :: TokenQuantity
txOutMinTokenQuantity :: TokenQuantity
txOutMinTokenQuantity = Natural -> TokenQuantity
TokenQuantity Natural
1

-- | The greatest token quantity that can appear in a transaction output's
--   token bundle.
--
-- Although the ledger specification allows token quantities of unlimited
-- sizes, in practice we'll only see transaction outputs where the token
-- quantities are bounded by the size of a 'Word64'.
--
txOutMaxTokenQuantity :: TokenQuantity
txOutMaxTokenQuantity :: TokenQuantity
txOutMaxTokenQuantity = Natural -> TokenQuantity
TokenQuantity (Natural -> TokenQuantity) -> Natural -> TokenQuantity
forall a b. (a -> b) -> a -> b
$ Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Natural) -> Word64 -> Natural
forall a b. (a -> b) -> a -> b
$ Bounded Word64 => Word64
forall a. Bounded a => a
maxBound @Word64

-- | The greatest quantity of any given token that can be minted or burned in a
--   transaction.
--
txMintBurnMaxTokenQuantity :: TokenQuantity
txMintBurnMaxTokenQuantity :: TokenQuantity
txMintBurnMaxTokenQuantity = Natural -> TokenQuantity
TokenQuantity (Natural -> TokenQuantity) -> Natural -> TokenQuantity
forall a b. (a -> b) -> a -> b
$ Int64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Natural) -> Int64 -> Natural
forall a b. (a -> b) -> a -> b
$ Bounded Int64 => Int64
forall a. Bounded a => a
maxBound @Int64

--------------------------------------------------------------------------------
-- Constraints
--------------------------------------------------------------------------------

-- | Provides an abstract cost and size model for transactions.
--
-- This allows parts of a transaction to be costed (or sized) individually,
-- without having to compute the cost (or size) of an entire transaction.
--
-- Note that the following functions assume one witness is required per input:
--
-- - 'txInputCost'
-- - 'txInputSize'
--
-- This will lead to slight overestimation in the case of UTxOs that share the
-- same payment key.
--
data TxConstraints = TxConstraints
    { TxConstraints -> Coin
txBaseCost :: Coin
      -- ^ The constant cost of an empty transaction.
    , TxConstraints -> TxSize
txBaseSize :: TxSize
      -- ^ The constant size of an empty transaction.
    , TxConstraints -> Coin
txInputCost :: Coin
      -- ^ The constant cost of a transaction input, assuming one witness is
      -- required per input.
    , TxConstraints -> TxSize
txInputSize :: TxSize
      -- ^ The constant size of a transaction input, assuming one witness is
      -- required per input.
    , TxConstraints -> TokenBundle -> Coin
txOutputCost :: TokenBundle -> Coin
      -- ^ The variable cost of a transaction output.
    , TxConstraints -> TokenBundle -> TxSize
txOutputSize :: TokenBundle -> TxSize
      -- ^ The variable size of a transaction output.
    , TxConstraints -> TxSize
txOutputMaximumSize :: TxSize
      -- ^ The maximum size of a transaction output.
    , TxConstraints -> TokenQuantity
txOutputMaximumTokenQuantity :: TokenQuantity
      -- ^ The maximum token quantity that can appear in a transaction output.
    , TxConstraints -> Address -> TokenMap -> Coin
txOutputMinimumAdaQuantity :: Address -> TokenMap -> Coin
      -- ^ The variable minimum ada quantity of a transaction output.
    , TxConstraints -> Address -> TokenBundle -> Bool
txOutputBelowMinimumAdaQuantity :: Address -> TokenBundle -> Bool
      -- ^ Returns 'True' if the given 'TokenBundle' has a 'Coin' value that is
      -- below the minimum required.
    , TxConstraints -> Coin -> Coin
txRewardWithdrawalCost :: Coin -> Coin
      -- ^ The variable cost of a reward withdrawal.
    , TxConstraints -> Coin -> TxSize
txRewardWithdrawalSize :: Coin -> TxSize
      -- ^ The variable size of a reward withdrawal.
    , TxConstraints -> TxSize
txMaximumSize :: TxSize
      -- ^ The maximum size of a transaction.
    }
    deriving (forall x. TxConstraints -> Rep TxConstraints x)
-> (forall x. Rep TxConstraints x -> TxConstraints)
-> Generic TxConstraints
forall x. Rep TxConstraints x -> TxConstraints
forall x. TxConstraints -> Rep TxConstraints x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxConstraints x -> TxConstraints
$cfrom :: forall x. TxConstraints -> Rep TxConstraints x
Generic

txOutputCoinCost :: TxConstraints -> Coin -> Coin
txOutputCoinCost :: TxConstraints -> Coin -> Coin
txOutputCoinCost TxConstraints
constraints = TxConstraints -> TokenBundle -> Coin
txOutputCost TxConstraints
constraints (TokenBundle -> Coin) -> (Coin -> TokenBundle) -> Coin -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> TokenBundle
TokenBundle.fromCoin

txOutputCoinSize :: TxConstraints -> Coin -> TxSize
txOutputCoinSize :: TxConstraints -> Coin -> TxSize
txOutputCoinSize TxConstraints
constraints = TxConstraints -> TokenBundle -> TxSize
txOutputSize TxConstraints
constraints (TokenBundle -> TxSize) -> (Coin -> TokenBundle) -> Coin -> TxSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> TokenBundle
TokenBundle.fromCoin

txOutputHasValidSize :: TxConstraints -> TokenBundle -> Bool
txOutputHasValidSize :: TxConstraints -> TokenBundle -> Bool
txOutputHasValidSize TxConstraints
constraints TokenBundle
b =
    TxConstraints -> TokenBundle -> TxSize
txOutputSize TxConstraints
constraints TokenBundle
b TxSize -> TxSize -> Bool
forall a. Ord a => a -> a -> Bool
<= TxConstraints -> TxSize
txOutputMaximumSize TxConstraints
constraints

txOutputHasValidTokenQuantities :: TxConstraints -> TokenMap -> Bool
txOutputHasValidTokenQuantities :: TxConstraints -> TokenMap -> Bool
txOutputHasValidTokenQuantities TxConstraints
constraints TokenMap
m =
    TokenMap -> TokenQuantity
TokenMap.maximumQuantity TokenMap
m TokenQuantity -> TokenQuantity -> Bool
forall a. Ord a => a -> a -> Bool
<= TxConstraints -> TokenQuantity
txOutputMaximumTokenQuantity TxConstraints
constraints

-- | The size of a transaction, or part of a transaction, in bytes.
--
newtype TxSize = TxSize { TxSize -> Natural
unTxSize :: Natural }
    deriving stock (TxSize -> TxSize -> Bool
(TxSize -> TxSize -> Bool)
-> (TxSize -> TxSize -> Bool) -> Eq TxSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxSize -> TxSize -> Bool
$c/= :: TxSize -> TxSize -> Bool
== :: TxSize -> TxSize -> Bool
$c== :: TxSize -> TxSize -> Bool
Eq, Eq TxSize
Eq TxSize
-> (TxSize -> TxSize -> Ordering)
-> (TxSize -> TxSize -> Bool)
-> (TxSize -> TxSize -> Bool)
-> (TxSize -> TxSize -> Bool)
-> (TxSize -> TxSize -> Bool)
-> (TxSize -> TxSize -> TxSize)
-> (TxSize -> TxSize -> TxSize)
-> Ord TxSize
TxSize -> TxSize -> Bool
TxSize -> TxSize -> Ordering
TxSize -> TxSize -> TxSize
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 :: TxSize -> TxSize -> TxSize
$cmin :: TxSize -> TxSize -> TxSize
max :: TxSize -> TxSize -> TxSize
$cmax :: TxSize -> TxSize -> TxSize
>= :: TxSize -> TxSize -> Bool
$c>= :: TxSize -> TxSize -> Bool
> :: TxSize -> TxSize -> Bool
$c> :: TxSize -> TxSize -> Bool
<= :: TxSize -> TxSize -> Bool
$c<= :: TxSize -> TxSize -> Bool
< :: TxSize -> TxSize -> Bool
$c< :: TxSize -> TxSize -> Bool
compare :: TxSize -> TxSize -> Ordering
$ccompare :: TxSize -> TxSize -> Ordering
$cp1Ord :: Eq TxSize
Ord, (forall x. TxSize -> Rep TxSize x)
-> (forall x. Rep TxSize x -> TxSize) -> Generic TxSize
forall x. Rep TxSize x -> TxSize
forall x. TxSize -> Rep TxSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxSize x -> TxSize
$cfrom :: forall x. TxSize -> Rep TxSize x
Generic)
    deriving Int -> TxSize -> ShowS
[TxSize] -> ShowS
TxSize -> String
(Int -> TxSize -> ShowS)
-> (TxSize -> String) -> ([TxSize] -> ShowS) -> Show TxSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxSize] -> ShowS
$cshowList :: [TxSize] -> ShowS
show :: TxSize -> String
$cshow :: TxSize -> String
showsPrec :: Int -> TxSize -> ShowS
$cshowsPrec :: Int -> TxSize -> ShowS
Show via (Quiet TxSize)

instance NFData TxSize

instance Semigroup TxSize where
    TxSize Natural
a <> :: TxSize -> TxSize -> TxSize
<> TxSize Natural
b = Natural -> TxSize
TxSize (Natural
a Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
b)

instance Monoid TxSize where
    mempty :: TxSize
mempty = Natural -> TxSize
TxSize Natural
0

-- | Computes the absolute distance between two transaction size quantities.
--
txSizeDistance :: TxSize -> TxSize -> TxSize
txSizeDistance :: TxSize -> TxSize -> TxSize
txSizeDistance (TxSize Natural
a) (TxSize Natural
b)
    | Natural
a Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
b    = Natural -> TxSize
TxSize (Natural
a Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
b)
    | Bool
otherwise = Natural -> TxSize
TxSize (Natural
b Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
a)

--------------------------------------------------------------------------------
-- Queries
--------------------------------------------------------------------------------

txAssetIds :: Tx -> Set AssetId
txAssetIds :: Tx -> Set AssetId
txAssetIds Tx
tx = [Set AssetId] -> Set AssetId
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold
    [ (TxOut -> Set AssetId) -> [TxOut] -> Set AssetId
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap TxOut -> Set AssetId
txOutAssetIds ((([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx)
-> Tx -> [TxOut]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "outputs"
  (([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx)
([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx
#outputs Tx
tx)
    , (TxOut -> Set AssetId) -> Maybe TxOut -> Set AssetId
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap TxOut -> Set AssetId
txOutAssetIds (((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
 -> Tx -> Const (Maybe TxOut) Tx)
-> Tx -> Maybe TxOut
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "collateralOutput"
  ((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
   -> Tx -> Const (Maybe TxOut) Tx)
(Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
-> Tx -> Const (Maybe TxOut) Tx
#collateralOutput Tx
tx)
    ]

txOutAssetIds :: TxOut -> Set AssetId
txOutAssetIds :: TxOut -> Set AssetId
txOutAssetIds (TxOut Address
_ TokenBundle
bundle) = TokenBundle -> Set AssetId
TokenBundle.getAssets TokenBundle
bundle

--------------------------------------------------------------------------------
-- Transformations
--------------------------------------------------------------------------------

txMapAssetIds :: (AssetId -> AssetId) -> Tx -> Tx
txMapAssetIds :: (AssetId -> AssetId) -> Tx -> Tx
txMapAssetIds AssetId -> AssetId
f Tx
tx = Tx
tx
    Tx -> (Tx -> Tx) -> Tx
forall a b. a -> (a -> b) -> b
& (([TxOut] -> Identity [TxOut]) -> Tx -> Identity Tx)
-> ([TxOut] -> [TxOut]) -> Tx -> Tx
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "outputs" (([TxOut] -> Identity [TxOut]) -> Tx -> Identity Tx)
([TxOut] -> Identity [TxOut]) -> Tx -> Identity Tx
#outputs
        ((TxOut -> TxOut) -> [TxOut] -> [TxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AssetId -> AssetId) -> TxOut -> TxOut
txOutMapAssetIds AssetId -> AssetId
f))
    Tx -> (Tx -> Tx) -> Tx
forall a b. a -> (a -> b) -> b
& ((Maybe TxOut -> Identity (Maybe TxOut)) -> Tx -> Identity Tx)
-> (Maybe TxOut -> Maybe TxOut) -> Tx -> Tx
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "collateralOutput"
  ((Maybe TxOut -> Identity (Maybe TxOut)) -> Tx -> Identity Tx)
(Maybe TxOut -> Identity (Maybe TxOut)) -> Tx -> Identity Tx
#collateralOutput
        ((TxOut -> TxOut) -> Maybe TxOut -> Maybe TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AssetId -> AssetId) -> TxOut -> TxOut
txOutMapAssetIds AssetId -> AssetId
f))

txMapTxIds :: (Hash "Tx" -> Hash "Tx") -> Tx -> Tx
txMapTxIds :: (Hash "Tx" -> Hash "Tx") -> Tx -> Tx
txMapTxIds Hash "Tx" -> Hash "Tx"
f Tx
tx = Tx
tx
    Tx -> (Tx -> Tx) -> Tx
forall a b. a -> (a -> b) -> b
& ((Hash "Tx" -> Identity (Hash "Tx")) -> Tx -> Identity Tx)
-> (Hash "Tx" -> Hash "Tx") -> Tx -> Tx
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "txId" ((Hash "Tx" -> Identity (Hash "Tx")) -> Tx -> Identity Tx)
(Hash "Tx" -> Identity (Hash "Tx")) -> Tx -> Identity Tx
#txId
        Hash "Tx" -> Hash "Tx"
f
    Tx -> (Tx -> Tx) -> Tx
forall a b. a -> (a -> b) -> b
& (([(TxIn, Coin)] -> Identity [(TxIn, Coin)]) -> Tx -> Identity Tx)
-> ([(TxIn, Coin)] -> [(TxIn, Coin)]) -> Tx -> Tx
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "resolvedInputs"
  (([(TxIn, Coin)] -> Identity [(TxIn, Coin)]) -> Tx -> Identity Tx)
([(TxIn, Coin)] -> Identity [(TxIn, Coin)]) -> Tx -> Identity Tx
#resolvedInputs
        (((TxIn, Coin) -> (TxIn, Coin)) -> [(TxIn, Coin)] -> [(TxIn, Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TxIn -> TxIn) -> (TxIn, Coin) -> (TxIn, Coin)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (((Hash "Tx" -> Identity (Hash "Tx")) -> TxIn -> Identity TxIn)
-> (Hash "Tx" -> Hash "Tx") -> TxIn -> TxIn
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "inputId"
  ((Hash "Tx" -> Identity (Hash "Tx")) -> TxIn -> Identity TxIn)
(Hash "Tx" -> Identity (Hash "Tx")) -> TxIn -> Identity TxIn
#inputId Hash "Tx" -> Hash "Tx"
f)))
    Tx -> (Tx -> Tx) -> Tx
forall a b. a -> (a -> b) -> b
& (([(TxIn, Coin)] -> Identity [(TxIn, Coin)]) -> Tx -> Identity Tx)
-> ([(TxIn, Coin)] -> [(TxIn, Coin)]) -> Tx -> Tx
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "resolvedCollateralInputs"
  (([(TxIn, Coin)] -> Identity [(TxIn, Coin)]) -> Tx -> Identity Tx)
([(TxIn, Coin)] -> Identity [(TxIn, Coin)]) -> Tx -> Identity Tx
#resolvedCollateralInputs
        (((TxIn, Coin) -> (TxIn, Coin)) -> [(TxIn, Coin)] -> [(TxIn, Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TxIn -> TxIn) -> (TxIn, Coin) -> (TxIn, Coin)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (((Hash "Tx" -> Identity (Hash "Tx")) -> TxIn -> Identity TxIn)
-> (Hash "Tx" -> Hash "Tx") -> TxIn -> TxIn
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "inputId"
  ((Hash "Tx" -> Identity (Hash "Tx")) -> TxIn -> Identity TxIn)
(Hash "Tx" -> Identity (Hash "Tx")) -> TxIn -> Identity TxIn
#inputId Hash "Tx" -> Hash "Tx"
f)))

txRemoveAssetId :: Tx -> AssetId -> Tx
txRemoveAssetId :: Tx -> AssetId -> Tx
txRemoveAssetId Tx
tx AssetId
asset = Tx
tx
    Tx -> (Tx -> Tx) -> Tx
forall a b. a -> (a -> b) -> b
& (([TxOut] -> Identity [TxOut]) -> Tx -> Identity Tx)
-> ([TxOut] -> [TxOut]) -> Tx -> Tx
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "outputs" (([TxOut] -> Identity [TxOut]) -> Tx -> Identity Tx)
([TxOut] -> Identity [TxOut]) -> Tx -> Identity Tx
#outputs
        ((TxOut -> TxOut) -> [TxOut] -> [TxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxOut -> AssetId -> TxOut
`txOutRemoveAssetId` AssetId
asset))
    Tx -> (Tx -> Tx) -> Tx
forall a b. a -> (a -> b) -> b
& ((Maybe TxOut -> Identity (Maybe TxOut)) -> Tx -> Identity Tx)
-> (Maybe TxOut -> Maybe TxOut) -> Tx -> Tx
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "collateralOutput"
  ((Maybe TxOut -> Identity (Maybe TxOut)) -> Tx -> Identity Tx)
(Maybe TxOut -> Identity (Maybe TxOut)) -> Tx -> Identity Tx
#collateralOutput
        ((TxOut -> TxOut) -> Maybe TxOut -> Maybe TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxOut -> AssetId -> TxOut
`txOutRemoveAssetId` AssetId
asset))

txOutMapAssetIds :: (AssetId -> AssetId) -> TxOut -> TxOut
txOutMapAssetIds :: (AssetId -> AssetId) -> TxOut -> TxOut
txOutMapAssetIds AssetId -> AssetId
f (TxOut Address
address TokenBundle
bundle) =
    Address -> TokenBundle -> TxOut
TxOut Address
address ((AssetId -> AssetId) -> TokenBundle -> TokenBundle
TokenBundle.mapAssetIds AssetId -> AssetId
f TokenBundle
bundle)

txOutRemoveAssetId :: TxOut -> AssetId -> TxOut
txOutRemoveAssetId :: TxOut -> AssetId -> TxOut
txOutRemoveAssetId (TxOut Address
address TokenBundle
bundle) AssetId
asset =
    Address -> TokenBundle -> TxOut
TxOut Address
address (TokenBundle -> AssetId -> TokenQuantity -> TokenBundle
TokenBundle.setQuantity TokenBundle
bundle AssetId
asset TokenQuantity
forall a. Monoid a => a
mempty)

{-------------------------------------------------------------------------------
                      Internal functions for unit testing
-------------------------------------------------------------------------------}

-- | Only use this for tests.
unsafeSealedTxFromBytes :: HasCallStack => ByteString -> SealedTx
unsafeSealedTxFromBytes :: ByteString -> SealedTx
unsafeSealedTxFromBytes = (DecoderError -> SealedTx)
-> (SealedTx -> SealedTx)
-> Either DecoderError SealedTx
-> SealedTx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Builder -> SealedTx
forall a. HasCallStack => Builder -> a
internalError (Builder -> SealedTx)
-> (DecoderError -> Builder) -> DecoderError -> SealedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> Builder
forall b a. (FromBuilder b, Show a) => a -> b
errMsg) SealedTx -> SealedTx
forall a. a -> a
id (Either DecoderError SealedTx -> SealedTx)
-> (ByteString -> Either DecoderError SealedTx)
-> ByteString
-> SealedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either DecoderError SealedTx
sealedTxFromBytes
  where
    errMsg :: a -> b
errMsg a
reason = Builder
"unsafeSealedTxFromBytes: "Builder -> Builder -> b
forall b. FromBuilder b => Builder -> Builder -> b
+||a
reasona -> Builder -> Builder
forall a b. (Show a, FromBuilder b) => a -> Builder -> b
||+Builder
""

-- | Construct a 'SealedTx' from a string which need not be a well-formed
-- serialised Cardano transaction.
--
-- Be careful using the 'SealedTx', because any attempt to evaluate its
-- 'cardanoTx' field will crash.
mockSealedTx :: HasCallStack => ByteString -> SealedTx
mockSealedTx :: ByteString -> SealedTx
mockSealedTx = Bool -> InAnyCardanoEra Tx -> ByteString -> SealedTx
SealedTx Bool
False
    (Builder -> InAnyCardanoEra Tx
forall a. HasCallStack => Builder -> a
internalError Builder
"mockSealedTx: attempted to decode gibberish")

{-------------------------------------------------------------------------------
                          Checks
-------------------------------------------------------------------------------}

coinIsValidForTxOut :: Coin -> Bool
coinIsValidForTxOut :: Coin -> Bool
coinIsValidForTxOut Coin
c = Bool -> Bool -> Bool
(&&)
    (Coin
c Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= Coin
txOutMinCoin)
    (Coin
c Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
txOutMaxCoin)

{-------------------------------------------------------------------------------
                          Conversions (Unsafe)
-------------------------------------------------------------------------------}

-- | Converts the given 'Coin' value to a value that can be included in a
--   transaction output.
--
-- Callers of this function must take responsibility for checking that the
-- given value is:
--
--   - not smaller than 'txOutMinCoin'
--   - not greater than 'txOutMaxCoin'
--
-- This function throws a run-time error if the pre-condition is violated.
--
unsafeCoinToTxOutCoinValue :: HasCallStack => Coin -> Word64
unsafeCoinToTxOutCoinValue :: Coin -> Word64
unsafeCoinToTxOutCoinValue Coin
c
    | Coin
c Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
< Coin
txOutMinCoin =
        String -> Word64
forall a. HasCallStack => String -> a
error (String -> Word64) -> String -> Word64
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
            [ String
"unsafeCoinToTxOutCoinValue: coin value"
            , Coin -> String
forall a. Show a => a -> String
show Coin
c
            , String
"too small for transaction output"
            ]
    | Coin
c Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
> Coin
txOutMaxCoin =
          String -> Word64
forall a. HasCallStack => String -> a
error (String -> Word64) -> String -> Word64
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
            [ String
"unsafeCoinToTxOutCoinValue: coin value"
            , Coin -> String
forall a. Show a => a -> String
show Coin
c
            , String
"too large for transaction output"
            ]
    | Bool
otherwise =
        HasCallStack => Coin -> Word64
Coin -> Word64
Coin.unsafeToWord64 Coin
c