{-# LANGUAGE BlockArguments     #-}
{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE MonoLocalBinds     #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RankNTypes         #-}
{-# LANGUAGE TypeApplications   #-}
-- | Turn 'UnbalancedTx' values into transactions using the
--   wallet API.
module Plutus.Contract.Wallet(
      balanceTx
    , handleTx
    , yieldUnbalancedTx
    , getUnspentOutput
    , WAPI.signTxAndSubmit
    -- * Exporting transactions
    , ExportTx(..)
    , ExportTxInput(..)
    , ExportTxRedeemer(..)
    , export
    ) where

import Cardano.Api qualified as C
import Cardano.Node.Emulator.Params (Params (emulatorPParams, pNetworkId))
import Cardano.Node.Emulator.Validation (CardanoLedgerError, makeTransactionBody)
import Control.Applicative ((<|>))
import Control.Monad ((>=>))
import Control.Monad.Error.Lens (throwing)
import Control.Monad.Freer (Eff, Member)
import Control.Monad.Freer.Error (Error, throwError)
import Data.Aeson (FromJSON (parseJSON), Object, ToJSON (toJSON), Value (String), object, withObject, (.:), (.=))
import Data.Aeson.Extras qualified as JSON
import Data.Aeson.Types (Parser, parseFail)
import Data.Bifunctor (Bifunctor (bimap), first)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.OpenApi qualified as OpenApi
import Data.Set qualified as Set
import Data.Typeable (Typeable)
import Data.Void (Void)
import GHC.Generics (Generic)
import Ledger (DCert, Redeemer, StakingCredential, toPlutusAddress, txRedeemers)
import Ledger qualified (ScriptPurpose (..))
import Ledger qualified as P
import Ledger.Ada qualified as Ada
import Ledger.Constraints (UnbalancedTx (UnbalancedCardanoTx, UnbalancedEmulatorTx), mustPayToAddress)
import Ledger.Tx (CardanoTx, TxId (TxId), TxIn (..), TxOutRef, getCardanoTxInputs, txInRef)
import Ledger.Tx.CardanoAPI (fromPlutusIndex)
import Ledger.Value (currencyMPSHash)
import Plutus.Contract.CardanoAPI qualified as CardanoAPI
import Plutus.Contract.Error (AsContractError (_OtherContractError))
import Plutus.Contract.Request qualified as Contract
import Plutus.Contract.Types (Contract)
import Plutus.V1.Ledger.Api qualified as Plutus
import Plutus.V1.Ledger.Scripts (MintingPolicyHash)
import PlutusTx qualified
import Wallet.API qualified as WAPI
import Wallet.Effects (WalletEffect, balanceTx, yieldUnbalancedTx)
import Wallet.Emulator.Error (WalletAPIError)

{- Note [Submitting transactions from Plutus contracts]

'UnbalancedTx' is the type of transactions that meet some set of constraints
(produced by 'Ledger.Constraints.OffChain.mkTx'), but can't be submitted to
the ledger yet because they may not be balanced and they lack signatures and
fee payments. To turn an 'UnbalancedTx' value into a valid transaction that can
be submitted to the network, the contract backend needs to

* Balance it.
  If the total value of 'txInputs' + the 'txMint' field is
  greater than the total value of 'txOutputs', then one or more public key
  outputs need to be added. How many and what addresses they are is up
  to the wallet (probably configurable).
  If the total balance 'txInputs' + the 'txMint' field is less than
  the total value of 'txOutputs', then one or more public key inputs need
  to be added (and potentially some outputs for the change).

* Compute fees.
  Once the final size of the transaction is known, the fees for the transaction
  can be computed. The transaction fee needs to be paid for with additional
  inputs so I assume that this step and the previous step will be combined.

  Also note that even if the 'UnbalancedTx' that we get from the contract
  endpoint happens to be balanced already, we still need to add fees to it. So
  we can't skip the balancing & fee computation step.

  Balancing and coin selection will eventually be performed by the wallet
  backend.

* Sign it.
  The signing process needs to provide signatures for all public key
  inputs in the balanced transaction.

-}

-- | Balance an unabalanced transaction, sign it, and submit
--   it to the chain in the context of a wallet.
handleTx ::
    ( Member WalletEffect effs
    , Member (Error WalletAPIError) effs
    )
    => UnbalancedTx -> Eff effs CardanoTx
handleTx :: UnbalancedTx -> Eff effs CardanoTx
handleTx = UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
forall (effs :: [* -> *]).
Member WalletEffect effs =>
UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
balanceTx (UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx))
-> (Either WalletAPIError CardanoTx -> Eff effs CardanoTx)
-> UnbalancedTx
-> Eff effs CardanoTx
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (WalletAPIError -> Eff effs CardanoTx)
-> (CardanoTx -> Eff effs CardanoTx)
-> Either WalletAPIError CardanoTx
-> Eff effs CardanoTx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either WalletAPIError -> Eff effs CardanoTx
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError CardanoTx -> Eff effs CardanoTx
forall (effs :: [* -> *]).
Member WalletEffect effs =>
CardanoTx -> Eff effs CardanoTx
WAPI.signTxAndSubmit

-- | Get an unspent output belonging to the wallet.
getUnspentOutput :: AsContractError e => Contract w s e TxOutRef
getUnspentOutput :: Contract w s e TxOutRef
getUnspentOutput = do
    CardanoAddress
addr <- Contract w s e CardanoAddress
forall w (s :: Row *) e.
AsContractError e =>
Contract w s e CardanoAddress
Contract.ownAddress
    let constraints :: TxConstraints Void Void
constraints = Address -> Value -> TxConstraints Void Void
forall i o. Address -> Value -> TxConstraints i o
mustPayToAddress (CardanoAddress -> Address
forall era. AddressInEra era -> Address
toPlutusAddress CardanoAddress
addr) (Integer -> Value
Ada.lovelaceValueOf Integer
1)
    UnbalancedTx
utx <- ScriptLookups Void
-> TxConstraints (RedeemerType Void) (DatumType Void)
-> Contract w s e UnbalancedTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e UnbalancedTx
Contract.mkTxConstraints @Void ScriptLookups Void
forall a. Monoid a => a
mempty TxConstraints Void Void
TxConstraints (RedeemerType Void) (DatumType Void)
constraints
    CardanoTx
tx <- UnbalancedTx -> Contract w s e UnbalancedTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e UnbalancedTx
Contract.adjustUnbalancedTx UnbalancedTx
utx Contract w s e UnbalancedTx
-> (UnbalancedTx -> Contract w s e CardanoTx)
-> Contract w s e CardanoTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s e CardanoTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e CardanoTx
Contract.balanceTx
    case CardanoTx -> [TxIn]
getCardanoTxInputs CardanoTx
tx of
        TxIn
inp : [TxIn]
_ -> TxOutRef -> Contract w s e TxOutRef
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOutRef -> Contract w s e TxOutRef)
-> TxOutRef -> Contract w s e TxOutRef
forall a b. (a -> b) -> a -> b
$ TxIn -> TxOutRef
txInRef TxIn
inp
        []      -> AReview e Text -> Text -> Contract w s e TxOutRef
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsContractError r => Prism' r Text
_OtherContractError Text
"Balanced transaction has no inputs"

data ExportTxRedeemerPurpose = Spending | Minting | Rewarding | Certifying

instance ToJSON ExportTxRedeemerPurpose where
    toJSON :: ExportTxRedeemerPurpose -> Value
toJSON = \case
        ExportTxRedeemerPurpose
Spending   -> Text -> Value
String Text
"spending"
        ExportTxRedeemerPurpose
Minting    -> Text -> Value
String Text
"minting"
        ExportTxRedeemerPurpose
Rewarding  -> Text -> Value
String Text
"rewarding"
        ExportTxRedeemerPurpose
Certifying -> Text -> Value
String Text
"certifying"

data ExportTxRedeemer =
    SpendingRedeemer{ ExportTxRedeemer -> Redeemer
redeemer:: Plutus.Redeemer, ExportTxRedeemer -> TxOutRef
redeemerOutRef :: TxOutRef }
    | MintingRedeemer { redeemer:: Plutus.Redeemer, ExportTxRedeemer -> MintingPolicyHash
redeemerPolicyId :: MintingPolicyHash }
    | RewardingRedeemer { redeemer:: Plutus.Redeemer, ExportTxRedeemer -> StakingCredential
redeemerStakingCredential :: StakingCredential}
    | CertifyingRedeemer { redeemer:: Plutus.Redeemer, ExportTxRedeemer -> DCert
redeemerDCert :: DCert }
    deriving stock (ExportTxRedeemer -> ExportTxRedeemer -> Bool
(ExportTxRedeemer -> ExportTxRedeemer -> Bool)
-> (ExportTxRedeemer -> ExportTxRedeemer -> Bool)
-> Eq ExportTxRedeemer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportTxRedeemer -> ExportTxRedeemer -> Bool
$c/= :: ExportTxRedeemer -> ExportTxRedeemer -> Bool
== :: ExportTxRedeemer -> ExportTxRedeemer -> Bool
$c== :: ExportTxRedeemer -> ExportTxRedeemer -> Bool
Eq, Int -> ExportTxRedeemer -> ShowS
[ExportTxRedeemer] -> ShowS
ExportTxRedeemer -> String
(Int -> ExportTxRedeemer -> ShowS)
-> (ExportTxRedeemer -> String)
-> ([ExportTxRedeemer] -> ShowS)
-> Show ExportTxRedeemer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportTxRedeemer] -> ShowS
$cshowList :: [ExportTxRedeemer] -> ShowS
show :: ExportTxRedeemer -> String
$cshow :: ExportTxRedeemer -> String
showsPrec :: Int -> ExportTxRedeemer -> ShowS
$cshowsPrec :: Int -> ExportTxRedeemer -> ShowS
Show, (forall x. ExportTxRedeemer -> Rep ExportTxRedeemer x)
-> (forall x. Rep ExportTxRedeemer x -> ExportTxRedeemer)
-> Generic ExportTxRedeemer
forall x. Rep ExportTxRedeemer x -> ExportTxRedeemer
forall x. ExportTxRedeemer -> Rep ExportTxRedeemer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportTxRedeemer x -> ExportTxRedeemer
$cfrom :: forall x. ExportTxRedeemer -> Rep ExportTxRedeemer x
Generic, Typeable)
    deriving anyclass (Typeable ExportTxRedeemer
Typeable ExportTxRedeemer
-> (Proxy ExportTxRedeemer
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ExportTxRedeemer
Proxy ExportTxRedeemer -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy ExportTxRedeemer -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy ExportTxRedeemer -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable ExportTxRedeemer
OpenApi.ToSchema)

instance FromJSON ExportTxRedeemer where
    parseJSON :: Value -> Parser ExportTxRedeemer
parseJSON Value
v = Value -> Parser ExportTxRedeemer
parseSpendingRedeemer Value
v Parser ExportTxRedeemer
-> Parser ExportTxRedeemer -> Parser ExportTxRedeemer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser ExportTxRedeemer
parseMintingRedeemer Value
v Parser ExportTxRedeemer
-> Parser ExportTxRedeemer -> Parser ExportTxRedeemer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser ExportTxRedeemer
parseRewardingRedeemer Value
v Parser ExportTxRedeemer
-> Parser ExportTxRedeemer -> Parser ExportTxRedeemer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser ExportTxRedeemer
parseCertifyingRedeemer Value
v

parseSpendingRedeemer :: Value -> Parser ExportTxRedeemer
parseSpendingRedeemer :: Value -> Parser ExportTxRedeemer
parseSpendingRedeemer =
    String
-> (Object -> Parser ExportTxRedeemer)
-> Value
-> Parser ExportTxRedeemer
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Redeemer" ((Object -> Parser ExportTxRedeemer)
 -> Value -> Parser ExportTxRedeemer)
-> (Object -> Parser ExportTxRedeemer)
-> Value
-> Parser ExportTxRedeemer
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Object
inputObj <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"input" :: Parser Object
        let txOutRefParse :: Parser TxOutRef
txOutRefParse = TxId -> Integer -> TxOutRef
Plutus.TxOutRef (TxId -> Integer -> TxOutRef)
-> Parser TxId -> Parser (Integer -> TxOutRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BuiltinByteString -> TxId
TxId (BuiltinByteString -> TxId)
-> Parser BuiltinByteString -> Parser TxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
inputObj Object -> Key -> Parser BuiltinByteString
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"))
                                            Parser (Integer -> TxOutRef) -> Parser Integer -> Parser TxOutRef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
inputObj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"
        Redeemer -> TxOutRef -> ExportTxRedeemer
SpendingRedeemer (Redeemer -> TxOutRef -> ExportTxRedeemer)
-> Parser Redeemer -> Parser (TxOutRef -> ExportTxRedeemer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Redeemer
parseRedeemerData Object
o Parser (TxOutRef -> ExportTxRedeemer)
-> Parser TxOutRef -> Parser ExportTxRedeemer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxOutRef
txOutRefParse

parseMintingRedeemer :: Value -> Parser ExportTxRedeemer
parseMintingRedeemer :: Value -> Parser ExportTxRedeemer
parseMintingRedeemer =
    String
-> (Object -> Parser ExportTxRedeemer)
-> Value
-> Parser ExportTxRedeemer
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Redeemer" ((Object -> Parser ExportTxRedeemer)
 -> Value -> Parser ExportTxRedeemer)
-> (Object -> Parser ExportTxRedeemer)
-> Value
-> Parser ExportTxRedeemer
forall a b. (a -> b) -> a -> b
$ \Object
o -> Redeemer -> MintingPolicyHash -> ExportTxRedeemer
MintingRedeemer
        (Redeemer -> MintingPolicyHash -> ExportTxRedeemer)
-> Parser Redeemer
-> Parser (MintingPolicyHash -> ExportTxRedeemer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser Redeemer
parseRedeemerData Object
o
        Parser (MintingPolicyHash -> ExportTxRedeemer)
-> Parser MintingPolicyHash -> Parser ExportTxRedeemer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser MintingPolicyHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"policy_id"

-- TODO
parseRewardingRedeemer :: Value -> Parser ExportTxRedeemer
parseRewardingRedeemer :: Value -> Parser ExportTxRedeemer
parseRewardingRedeemer = String -> Value -> Parser ExportTxRedeemer
forall a. HasCallStack => String -> a
error String
"Unimplemented rewarding redeemer parsing."

-- TODO
parseCertifyingRedeemer :: Value -> Parser ExportTxRedeemer
parseCertifyingRedeemer :: Value -> Parser ExportTxRedeemer
parseCertifyingRedeemer = String -> Value -> Parser ExportTxRedeemer
forall a. HasCallStack => String -> a
error String
"Unimplemented certifying redeemer parsing."

parseRedeemerData :: Object -> Parser Plutus.Redeemer
parseRedeemerData :: Object -> Parser Redeemer
parseRedeemerData Object
o =
    (JSONViaSerialise Data -> Redeemer)
-> Parser (JSONViaSerialise Data) -> Parser Redeemer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(JSON.JSONViaSerialise Data
d) -> BuiltinData -> Redeemer
Plutus.Redeemer (BuiltinData -> Redeemer) -> BuiltinData -> Redeemer
forall a b. (a -> b) -> a -> b
$ Data -> BuiltinData
PlutusTx.dataToBuiltinData Data
d)
         (Object
o Object -> Key -> Parser (JSONViaSerialise Data)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data")

instance ToJSON ExportTxRedeemer where
    toJSON :: ExportTxRedeemer -> Value
toJSON SpendingRedeemer{redeemer :: ExportTxRedeemer -> Redeemer
redeemer=Plutus.Redeemer BuiltinData
dt, redeemerOutRef :: ExportTxRedeemer -> TxOutRef
redeemerOutRef=Plutus.TxOutRef{TxId
txOutRefId :: TxOutRef -> TxId
txOutRefId :: TxId
Plutus.txOutRefId, Integer
txOutRefIdx :: TxOutRef -> Integer
txOutRefIdx :: Integer
Plutus.txOutRefIdx}} =
        [Pair] -> Value
object [Key
"purpose" Key -> ExportTxRedeemerPurpose -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ExportTxRedeemerPurpose
Spending, Key
"data" Key -> JSONViaSerialise Data -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Data -> JSONViaSerialise Data
forall a. a -> JSONViaSerialise a
JSON.JSONViaSerialise (BuiltinData -> Data
PlutusTx.builtinDataToData BuiltinData
dt), Key
"input" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"id" Key -> BuiltinByteString -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxId -> BuiltinByteString
Plutus.getTxId TxId
txOutRefId, Key
"index" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Integer
txOutRefIdx]]
    toJSON MintingRedeemer{redeemer :: ExportTxRedeemer -> Redeemer
redeemer=Plutus.Redeemer BuiltinData
dt, MintingPolicyHash
redeemerPolicyId :: MintingPolicyHash
redeemerPolicyId :: ExportTxRedeemer -> MintingPolicyHash
redeemerPolicyId} =
        [Pair] -> Value
object [Key
"purpose" Key -> ExportTxRedeemerPurpose -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ExportTxRedeemerPurpose
Minting, Key
"data" Key -> JSONViaSerialise Data -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Data -> JSONViaSerialise Data
forall a. a -> JSONViaSerialise a
JSON.JSONViaSerialise (BuiltinData -> Data
PlutusTx.builtinDataToData BuiltinData
dt), Key
"policy_id" Key -> MintingPolicyHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MintingPolicyHash
redeemerPolicyId]
    -- TODO
    toJSON RewardingRedeemer{} = String -> Value
forall a. HasCallStack => String -> a
error String
"Unimplemented rewarding redeemer encoding."
    toJSON CertifyingRedeemer{} = String -> Value
forall a. HasCallStack => String -> a
error String
"Unimplemented certifying redeemer encoding."

-- | Partial transaction that can be balanced by the wallet backend.
data ExportTx =
        ExportTx
            { ExportTx -> Tx BabbageEra
partialTx :: C.Tx C.BabbageEra -- ^ The transaction itself
            , ExportTx -> [ExportTxInput]
lookups   :: [ExportTxInput] -- ^ The tx outputs for all inputs spent by the partial tx
            , ExportTx -> [ExportTxRedeemer]
redeemers :: [ExportTxRedeemer]
            }
    deriving stock (ExportTx -> ExportTx -> Bool
(ExportTx -> ExportTx -> Bool)
-> (ExportTx -> ExportTx -> Bool) -> Eq ExportTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportTx -> ExportTx -> Bool
$c/= :: ExportTx -> ExportTx -> Bool
== :: ExportTx -> ExportTx -> Bool
$c== :: ExportTx -> ExportTx -> Bool
Eq, Int -> ExportTx -> ShowS
[ExportTx] -> ShowS
ExportTx -> String
(Int -> ExportTx -> ShowS)
-> (ExportTx -> String) -> ([ExportTx] -> ShowS) -> Show ExportTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportTx] -> ShowS
$cshowList :: [ExportTx] -> ShowS
show :: ExportTx -> String
$cshow :: ExportTx -> String
showsPrec :: Int -> ExportTx -> ShowS
$cshowsPrec :: Int -> ExportTx -> ShowS
Show, (forall x. ExportTx -> Rep ExportTx x)
-> (forall x. Rep ExportTx x -> ExportTx) -> Generic ExportTx
forall x. Rep ExportTx x -> ExportTx
forall x. ExportTx -> Rep ExportTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportTx x -> ExportTx
$cfrom :: forall x. ExportTx -> Rep ExportTx x
Generic, Typeable)
    deriving anyclass (Typeable ExportTx
Typeable ExportTx
-> (Proxy ExportTx -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ExportTx
Proxy ExportTx -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy ExportTx -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy ExportTx -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable ExportTx
OpenApi.ToSchema)

instance FromJSON ExportTx where
  parseJSON :: Value -> Parser ExportTx
parseJSON = String -> (Object -> Parser ExportTx) -> Value -> Parser ExportTx
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExportTx" ((Object -> Parser ExportTx) -> Value -> Parser ExportTx)
-> (Object -> Parser ExportTx) -> Value -> Parser ExportTx
forall a b. (a -> b) -> a -> b
$ \Object
v -> Tx BabbageEra -> [ExportTxInput] -> [ExportTxRedeemer] -> ExportTx
ExportTx
      (Tx BabbageEra
 -> [ExportTxInput] -> [ExportTxRedeemer] -> ExportTx)
-> Parser (Tx BabbageEra)
-> Parser ([ExportTxInput] -> [ExportTxRedeemer] -> ExportTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser (Tx BabbageEra)
parsePartialTx Object
v
      Parser ([ExportTxInput] -> [ExportTxRedeemer] -> ExportTx)
-> Parser [ExportTxInput]
-> Parser ([ExportTxRedeemer] -> ExportTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [ExportTxInput]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"inputs"
      Parser ([ExportTxRedeemer] -> ExportTx)
-> Parser [ExportTxRedeemer] -> Parser ExportTx
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [ExportTxRedeemer]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"redeemers"
    where
      parsePartialTx :: Object -> Parser (Tx BabbageEra)
parsePartialTx Object
v =
        Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"transaction" Parser Text
-> (Text -> Parser (Tx BabbageEra)) -> Parser (Tx BabbageEra)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
t ->
          (String -> Parser (Tx BabbageEra))
-> (Tx BabbageEra -> Parser (Tx BabbageEra))
-> Either String (Tx BabbageEra)
-> Parser (Tx BabbageEra)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser (Tx BabbageEra)
forall a. String -> Parser a
parseFail Tx BabbageEra -> Parser (Tx BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (Tx BabbageEra) -> Parser (Tx BabbageEra))
-> Either String (Tx BabbageEra) -> Parser (Tx BabbageEra)
forall a b. (a -> b) -> a -> b
$ Text -> Either String ByteString
JSON.tryDecode Text
t
                              Either String ByteString
-> (ByteString -> Either String (Tx BabbageEra))
-> Either String (Tx BabbageEra)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((DecoderError -> String)
-> Either DecoderError (Tx BabbageEra)
-> Either String (Tx BabbageEra)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DecoderError -> String
forall a. Show a => a -> String
show (Either DecoderError (Tx BabbageEra)
 -> Either String (Tx BabbageEra))
-> (ByteString -> Either DecoderError (Tx BabbageEra))
-> ByteString
-> Either String (Tx BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType (Tx BabbageEra)
-> ByteString -> Either DecoderError (Tx BabbageEra)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
C.deserialiseFromCBOR (AsType BabbageEra -> AsType (Tx BabbageEra)
forall era. AsType era -> AsType (Tx era)
C.AsTx AsType BabbageEra
C.AsBabbageEra))

-- IMPORTANT: The JSON produced here needs to match the schema expected by
-- https://input-output-hk.github.io/cardano-wallet/api/edge/#operation/balanceTransaction
instance ToJSON ExportTx where
    toJSON :: ExportTx -> Value
toJSON ExportTx{Tx BabbageEra
partialTx :: Tx BabbageEra
partialTx :: ExportTx -> Tx BabbageEra
partialTx, [ExportTxInput]
lookups :: [ExportTxInput]
lookups :: ExportTx -> [ExportTxInput]
lookups, [ExportTxRedeemer]
redeemers :: [ExportTxRedeemer]
redeemers :: ExportTx -> [ExportTxRedeemer]
redeemers} =
        [Pair] -> Value
object
            [ Key
"transaction" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
JSON.encodeByteString (Tx BabbageEra -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
C.serialiseToCBOR Tx BabbageEra
partialTx)
            , Key
"inputs"      Key -> [ExportTxInput] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [ExportTxInput]
lookups
            , Key
"redeemers"   Key -> [ExportTxRedeemer] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [ExportTxRedeemer]
redeemers
            ]

data ExportTxInput =
    ExportTxInput
        { ExportTxInput -> TxId
etxiId               :: C.TxId
        , ExportTxInput -> TxIx
etxiTxIx             :: C.TxIx
        , ExportTxInput -> CardanoAddress
etxiAddress          :: C.AddressInEra C.BabbageEra
        , ExportTxInput -> Lovelace
etxiLovelaceQuantity :: C.Lovelace
        , ExportTxInput -> Maybe (Hash ScriptData)
etxiDatumHash        :: Maybe (C.Hash C.ScriptData)
        , ExportTxInput -> [(PolicyId, AssetName, Quantity)]
etxiAssets           :: [(C.PolicyId, C.AssetName, C.Quantity)]
        }
    deriving stock (ExportTxInput -> ExportTxInput -> Bool
(ExportTxInput -> ExportTxInput -> Bool)
-> (ExportTxInput -> ExportTxInput -> Bool) -> Eq ExportTxInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportTxInput -> ExportTxInput -> Bool
$c/= :: ExportTxInput -> ExportTxInput -> Bool
== :: ExportTxInput -> ExportTxInput -> Bool
$c== :: ExportTxInput -> ExportTxInput -> Bool
Eq, Int -> ExportTxInput -> ShowS
[ExportTxInput] -> ShowS
ExportTxInput -> String
(Int -> ExportTxInput -> ShowS)
-> (ExportTxInput -> String)
-> ([ExportTxInput] -> ShowS)
-> Show ExportTxInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportTxInput] -> ShowS
$cshowList :: [ExportTxInput] -> ShowS
show :: ExportTxInput -> String
$cshow :: ExportTxInput -> String
showsPrec :: Int -> ExportTxInput -> ShowS
$cshowsPrec :: Int -> ExportTxInput -> ShowS
Show, (forall x. ExportTxInput -> Rep ExportTxInput x)
-> (forall x. Rep ExportTxInput x -> ExportTxInput)
-> Generic ExportTxInput
forall x. Rep ExportTxInput x -> ExportTxInput
forall x. ExportTxInput -> Rep ExportTxInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportTxInput x -> ExportTxInput
$cfrom :: forall x. ExportTxInput -> Rep ExportTxInput x
Generic)
    deriving anyclass (Typeable ExportTxInput
Typeable ExportTxInput
-> (Proxy ExportTxInput
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ExportTxInput
Proxy ExportTxInput -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy ExportTxInput -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy ExportTxInput -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable ExportTxInput
OpenApi.ToSchema)

instance FromJSON ExportTxInput where
    parseJSON :: Value -> Parser ExportTxInput
parseJSON = String
-> (Object -> Parser ExportTxInput)
-> Value
-> Parser ExportTxInput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExportTxInput" ((Object -> Parser ExportTxInput) -> Value -> Parser ExportTxInput)
-> (Object -> Parser ExportTxInput)
-> Value
-> Parser ExportTxInput
forall a b. (a -> b) -> a -> b
$ \Object
o -> TxId
-> TxIx
-> CardanoAddress
-> Lovelace
-> Maybe (Hash ScriptData)
-> [(PolicyId, AssetName, Quantity)]
-> ExportTxInput
ExportTxInput
        (TxId
 -> TxIx
 -> CardanoAddress
 -> Lovelace
 -> Maybe (Hash ScriptData)
 -> [(PolicyId, AssetName, Quantity)]
 -> ExportTxInput)
-> Parser TxId
-> Parser
     (TxIx
      -> CardanoAddress
      -> Lovelace
      -> Maybe (Hash ScriptData)
      -> [(PolicyId, AssetName, Quantity)]
      -> ExportTxInput)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser TxId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        Parser
  (TxIx
   -> CardanoAddress
   -> Lovelace
   -> Maybe (Hash ScriptData)
   -> [(PolicyId, AssetName, Quantity)]
   -> ExportTxInput)
-> Parser TxIx
-> Parser
     (CardanoAddress
      -> Lovelace
      -> Maybe (Hash ScriptData)
      -> [(PolicyId, AssetName, Quantity)]
      -> ExportTxInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser TxIx
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"
        Parser
  (CardanoAddress
   -> Lovelace
   -> Maybe (Hash ScriptData)
   -> [(PolicyId, AssetName, Quantity)]
   -> ExportTxInput)
-> Parser CardanoAddress
-> Parser
     (Lovelace
      -> Maybe (Hash ScriptData)
      -> [(PolicyId, AssetName, Quantity)]
      -> ExportTxInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser CardanoAddress
parseAddress Object
o
        Parser
  (Lovelace
   -> Maybe (Hash ScriptData)
   -> [(PolicyId, AssetName, Quantity)]
   -> ExportTxInput)
-> Parser Lovelace
-> Parser
     (Maybe (Hash ScriptData)
      -> [(PolicyId, AssetName, Quantity)] -> ExportTxInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amount" Parser Object -> (Object -> Parser Lovelace) -> Parser Lovelace
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Object
amountField -> Object
amountField Object -> Key -> Parser Lovelace
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"quantity")
        Parser
  (Maybe (Hash ScriptData)
   -> [(PolicyId, AssetName, Quantity)] -> ExportTxInput)
-> Parser (Maybe (Hash ScriptData))
-> Parser ([(PolicyId, AssetName, Quantity)] -> ExportTxInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Hash ScriptData))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"datum"
        Parser ([(PolicyId, AssetName, Quantity)] -> ExportTxInput)
-> Parser [(PolicyId, AssetName, Quantity)] -> Parser ExportTxInput
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [Object]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"assets" Parser [Object]
-> ([Object] -> Parser [(PolicyId, AssetName, Quantity)])
-> Parser [(PolicyId, AssetName, Quantity)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Parser (PolicyId, AssetName, Quantity))
-> [Object] -> Parser [(PolicyId, AssetName, Quantity)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Object -> Parser (PolicyId, AssetName, Quantity)
parseAsset)
      where
          parseAddress :: Object -> Parser CardanoAddress
parseAddress Object
o = do
              Text
addressField <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
              let deserialisedAddr :: Maybe CardanoAddress
deserialisedAddr = AsType CardanoAddress -> Text -> Maybe CardanoAddress
forall addr.
SerialiseAddress addr =>
AsType addr -> Text -> Maybe addr
C.deserialiseAddress (AsType BabbageEra -> AsType CardanoAddress
forall era. AsType era -> AsType (AddressInEra era)
C.AsAddressInEra AsType BabbageEra
C.AsBabbageEra) Text
addressField
              Parser CardanoAddress
-> (CardanoAddress -> Parser CardanoAddress)
-> Maybe CardanoAddress
-> Parser CardanoAddress
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser CardanoAddress
forall a. String -> Parser a
parseFail String
"Failed to deserialise address field") CardanoAddress -> Parser CardanoAddress
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CardanoAddress
deserialisedAddr
          parseAsset :: Object -> Parser (C.PolicyId, C.AssetName, C.Quantity)
          parseAsset :: Object -> Parser (PolicyId, AssetName, Quantity)
parseAsset Object
o = do
              PolicyId
policyId <- Object
o Object -> Key -> Parser PolicyId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"policy_id"
              AssetName
assetName <- Object
o Object -> Key -> Parser AssetName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"asset_name"
              Quantity
qty <- Object
o Object -> Key -> Parser Quantity
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"quantity"
              (PolicyId, AssetName, Quantity)
-> Parser (PolicyId, AssetName, Quantity)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PolicyId
policyId, AssetName
assetName, Quantity
qty)

instance ToJSON ExportTxInput where
    toJSON :: ExportTxInput -> Value
toJSON ExportTxInput{TxId
etxiId :: TxId
etxiId :: ExportTxInput -> TxId
etxiId, TxIx
etxiTxIx :: TxIx
etxiTxIx :: ExportTxInput -> TxIx
etxiTxIx, Lovelace
etxiLovelaceQuantity :: Lovelace
etxiLovelaceQuantity :: ExportTxInput -> Lovelace
etxiLovelaceQuantity, Maybe (Hash ScriptData)
etxiDatumHash :: Maybe (Hash ScriptData)
etxiDatumHash :: ExportTxInput -> Maybe (Hash ScriptData)
etxiDatumHash, [(PolicyId, AssetName, Quantity)]
etxiAssets :: [(PolicyId, AssetName, Quantity)]
etxiAssets :: ExportTxInput -> [(PolicyId, AssetName, Quantity)]
etxiAssets, CardanoAddress
etxiAddress :: CardanoAddress
etxiAddress :: ExportTxInput -> CardanoAddress
etxiAddress} =
        [Pair] -> Value
object
            [ Key
"id" Key -> TxId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxId
etxiId
            , Key
"index" Key -> TxIx -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TxIx
etxiTxIx
            , Key
"address" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CardanoAddress -> Text
forall addr. SerialiseAddress addr => addr -> Text
C.serialiseAddress CardanoAddress
etxiAddress
            , Key
"amount" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"quantity" Key -> Lovelace -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Lovelace
etxiLovelaceQuantity, Key
"unit" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (String
"lovelace" :: String)]
            , Key
"datum" Key -> Maybe (Hash ScriptData) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Hash ScriptData)
etxiDatumHash
            , Key
"assets" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ((PolicyId, AssetName, Quantity) -> Value)
-> [(PolicyId, AssetName, Quantity)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(PolicyId
p, AssetName
a, Quantity
q) -> [Pair] -> Value
object [Key
"policy_id" Key -> PolicyId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PolicyId
p, Key
"asset_name" Key -> AssetName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AssetName
a, Key
"quantity" Key -> Quantity -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Quantity
q]) [(PolicyId, AssetName, Quantity)]
etxiAssets
            ]

export
    :: Params
    -> UnbalancedTx
    -> Either CardanoLedgerError ExportTx
export :: Params -> UnbalancedTx -> Either CardanoLedgerError ExportTx
export Params
params (UnbalancedEmulatorTx Tx
tx Set PaymentPubKeyHash
sigs Map TxOutRef TxOut
utxos) =
    let requiredSigners :: [PaymentPubKeyHash]
requiredSigners = Set PaymentPubKeyHash -> [PaymentPubKeyHash]
forall a. Set a -> [a]
Set.toList Set PaymentPubKeyHash
sigs
     in Tx BabbageEra -> [ExportTxInput] -> [ExportTxRedeemer] -> ExportTx
ExportTx
        (Tx BabbageEra
 -> [ExportTxInput] -> [ExportTxRedeemer] -> ExportTx)
-> Either CardanoLedgerError (Tx BabbageEra)
-> Either
     CardanoLedgerError
     ([ExportTxInput] -> [ExportTxRedeemer] -> ExportTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ToCardanoError -> CardanoLedgerError)
-> (TxBody BabbageEra -> Tx BabbageEra)
-> Either ToCardanoError (TxBody BabbageEra)
-> Either CardanoLedgerError (Tx BabbageEra)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ToCardanoError -> CardanoLedgerError
forall a b. b -> Either a b
Right ([KeyWitness BabbageEra] -> TxBody BabbageEra -> Tx BabbageEra
forall era. [KeyWitness era] -> TxBody era -> Tx era
C.makeSignedTransaction []) (NetworkId
-> PParams (BabbageEra StandardCrypto)
-> [PaymentPubKeyHash]
-> Tx
-> Either ToCardanoError (TxBody BabbageEra)
CardanoAPI.toCardanoTxBody (Params -> NetworkId
pNetworkId Params
params) (Params -> PParams (BabbageEra StandardCrypto)
emulatorPParams Params
params) [PaymentPubKeyHash]
requiredSigners Tx
tx)
        Either
  CardanoLedgerError
  ([ExportTxInput] -> [ExportTxRedeemer] -> ExportTx)
-> Either CardanoLedgerError [ExportTxInput]
-> Either CardanoLedgerError ([ExportTxRedeemer] -> ExportTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ToCardanoError -> CardanoLedgerError)
-> Either ToCardanoError [ExportTxInput]
-> Either CardanoLedgerError [ExportTxInput]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ToCardanoError -> CardanoLedgerError
forall a b. b -> Either a b
Right (Map TxOutRef TxOut -> Either ToCardanoError [ExportTxInput]
mkInputs Map TxOutRef TxOut
utxos)
        Either CardanoLedgerError ([ExportTxRedeemer] -> ExportTx)
-> Either CardanoLedgerError [ExportTxRedeemer]
-> Either CardanoLedgerError ExportTx
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ExportTxRedeemer] -> Either CardanoLedgerError [ExportTxRedeemer]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx -> [ExportTxRedeemer]
mkRedeemers Tx
tx)
export Params
params (UnbalancedCardanoTx CardanoBuildTx
tx Map TxOutRef TxOut
utxos) =
    let fromCardanoTx :: CardanoBuildTx -> Either CardanoLedgerError (TxBody BabbageEra)
fromCardanoTx CardanoBuildTx
ctx = do
            UTxO (BabbageEra StandardCrypto)
utxo <- UtxoIndex
-> Either CardanoLedgerError (UTxO (BabbageEra StandardCrypto))
fromPlutusIndex (UtxoIndex
 -> Either CardanoLedgerError (UTxO (BabbageEra StandardCrypto)))
-> UtxoIndex
-> Either CardanoLedgerError (UTxO (BabbageEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$ Map TxOutRef TxOut -> UtxoIndex
P.UtxoIndex Map TxOutRef TxOut
utxos
            Params
-> UTxO (BabbageEra StandardCrypto)
-> CardanoBuildTx
-> Either CardanoLedgerError (TxBody BabbageEra)
makeTransactionBody Params
params UTxO (BabbageEra StandardCrypto)
utxo CardanoBuildTx
ctx
     in Tx BabbageEra -> [ExportTxInput] -> [ExportTxRedeemer] -> ExportTx
ExportTx
        (Tx BabbageEra
 -> [ExportTxInput] -> [ExportTxRedeemer] -> ExportTx)
-> Either CardanoLedgerError (Tx BabbageEra)
-> Either
     CardanoLedgerError
     ([ExportTxInput] -> [ExportTxRedeemer] -> ExportTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxBody BabbageEra -> Tx BabbageEra)
-> Either CardanoLedgerError (TxBody BabbageEra)
-> Either CardanoLedgerError (Tx BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([KeyWitness BabbageEra] -> TxBody BabbageEra -> Tx BabbageEra
forall era. [KeyWitness era] -> TxBody era -> Tx era
C.makeSignedTransaction []) (CardanoBuildTx -> Either CardanoLedgerError (TxBody BabbageEra)
fromCardanoTx CardanoBuildTx
tx)
        Either
  CardanoLedgerError
  ([ExportTxInput] -> [ExportTxRedeemer] -> ExportTx)
-> Either CardanoLedgerError [ExportTxInput]
-> Either CardanoLedgerError ([ExportTxRedeemer] -> ExportTx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ToCardanoError -> CardanoLedgerError)
-> Either ToCardanoError [ExportTxInput]
-> Either CardanoLedgerError [ExportTxInput]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ToCardanoError -> CardanoLedgerError
forall a b. b -> Either a b
Right (Map TxOutRef TxOut -> Either ToCardanoError [ExportTxInput]
mkInputs Map TxOutRef TxOut
utxos)
        Either CardanoLedgerError ([ExportTxRedeemer] -> ExportTx)
-> Either CardanoLedgerError [ExportTxRedeemer]
-> Either CardanoLedgerError ExportTx
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ExportTxRedeemer] -> Either CardanoLedgerError [ExportTxRedeemer]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

mkInputs :: Map Plutus.TxOutRef P.TxOut -> Either CardanoAPI.ToCardanoError [ExportTxInput]
mkInputs :: Map TxOutRef TxOut -> Either ToCardanoError [ExportTxInput]
mkInputs = ((TxOutRef, TxOut) -> Either ToCardanoError ExportTxInput)
-> [(TxOutRef, TxOut)] -> Either ToCardanoError [ExportTxInput]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((TxOutRef -> TxOut -> Either ToCardanoError ExportTxInput)
-> (TxOutRef, TxOut) -> Either ToCardanoError ExportTxInput
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxOutRef -> TxOut -> Either ToCardanoError ExportTxInput
toExportTxInput) ([(TxOutRef, TxOut)] -> Either ToCardanoError [ExportTxInput])
-> (Map TxOutRef TxOut -> [(TxOutRef, TxOut)])
-> Map TxOutRef TxOut
-> Either ToCardanoError [ExportTxInput]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxOutRef TxOut -> [(TxOutRef, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList

toExportTxInput :: Plutus.TxOutRef -> P.TxOut -> Either CardanoAPI.ToCardanoError ExportTxInput
toExportTxInput :: TxOutRef -> TxOut -> Either ToCardanoError ExportTxInput
toExportTxInput Plutus.TxOutRef{TxId
txOutRefId :: TxId
txOutRefId :: TxOutRef -> TxId
Plutus.txOutRefId, Integer
txOutRefIdx :: Integer
txOutRefIdx :: TxOutRef -> Integer
Plutus.txOutRefIdx} TxOut
txOut = do
    Value
cardanoValue <- Value -> Either ToCardanoError Value
CardanoAPI.toCardanoValue (TxOut -> Value
P.txOutValue TxOut
txOut)
    let otherQuantities :: [(PolicyId, AssetName, Quantity)]
otherQuantities = ((AssetId, Quantity) -> Maybe (PolicyId, AssetName, Quantity))
-> [(AssetId, Quantity)] -> [(PolicyId, AssetName, Quantity)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case { (C.AssetId PolicyId
policyId AssetName
assetName, Quantity
quantity) -> (PolicyId, AssetName, Quantity)
-> Maybe (PolicyId, AssetName, Quantity)
forall a. a -> Maybe a
Just (PolicyId
policyId, AssetName
assetName, Quantity
quantity); (AssetId, Quantity)
_ -> Maybe (PolicyId, AssetName, Quantity)
forall a. Maybe a
Nothing }) ([(AssetId, Quantity)] -> [(PolicyId, AssetName, Quantity)])
-> [(AssetId, Quantity)] -> [(PolicyId, AssetName, Quantity)]
forall a b. (a -> b) -> a -> b
$ Value -> [(AssetId, Quantity)]
C.valueToList Value
cardanoValue
    TxId
-> TxIx
-> CardanoAddress
-> Lovelace
-> Maybe (Hash ScriptData)
-> [(PolicyId, AssetName, Quantity)]
-> ExportTxInput
ExportTxInput
        (TxId
 -> TxIx
 -> CardanoAddress
 -> Lovelace
 -> Maybe (Hash ScriptData)
 -> [(PolicyId, AssetName, Quantity)]
 -> ExportTxInput)
-> Either ToCardanoError TxId
-> Either
     ToCardanoError
     (TxIx
      -> CardanoAddress
      -> Lovelace
      -> Maybe (Hash ScriptData)
      -> [(PolicyId, AssetName, Quantity)]
      -> ExportTxInput)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxId -> Either ToCardanoError TxId
CardanoAPI.toCardanoTxId TxId
txOutRefId
        Either
  ToCardanoError
  (TxIx
   -> CardanoAddress
   -> Lovelace
   -> Maybe (Hash ScriptData)
   -> [(PolicyId, AssetName, Quantity)]
   -> ExportTxInput)
-> Either ToCardanoError TxIx
-> Either
     ToCardanoError
     (CardanoAddress
      -> Lovelace
      -> Maybe (Hash ScriptData)
      -> [(PolicyId, AssetName, Quantity)]
      -> ExportTxInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxIx -> Either ToCardanoError TxIx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word -> TxIx
C.TxIx (Word -> TxIx) -> Word -> TxIx
forall a b. (a -> b) -> a -> b
$ Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
txOutRefIdx)
        Either
  ToCardanoError
  (CardanoAddress
   -> Lovelace
   -> Maybe (Hash ScriptData)
   -> [(PolicyId, AssetName, Quantity)]
   -> ExportTxInput)
-> Either ToCardanoError CardanoAddress
-> Either
     ToCardanoError
     (Lovelace
      -> Maybe (Hash ScriptData)
      -> [(PolicyId, AssetName, Quantity)]
      -> ExportTxInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CardanoAddress -> Either ToCardanoError CardanoAddress
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut -> CardanoAddress
P.txOutAddress TxOut
txOut)
        Either
  ToCardanoError
  (Lovelace
   -> Maybe (Hash ScriptData)
   -> [(PolicyId, AssetName, Quantity)]
   -> ExportTxInput)
-> Either ToCardanoError Lovelace
-> Either
     ToCardanoError
     (Maybe (Hash ScriptData)
      -> [(PolicyId, AssetName, Quantity)] -> ExportTxInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lovelace -> Either ToCardanoError Lovelace
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Lovelace
C.selectLovelace Value
cardanoValue)
        Either
  ToCardanoError
  (Maybe (Hash ScriptData)
   -> [(PolicyId, AssetName, Quantity)] -> ExportTxInput)
-> Either ToCardanoError (Maybe (Hash ScriptData))
-> Either
     ToCardanoError ([(PolicyId, AssetName, Quantity)] -> ExportTxInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Either ToCardanoError (Hash ScriptData))
-> Either ToCardanoError (Maybe (Hash ScriptData))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (DatumHash -> Either ToCardanoError (Hash ScriptData)
CardanoAPI.toCardanoScriptDataHash (DatumHash -> Either ToCardanoError (Hash ScriptData))
-> Maybe DatumHash
-> Maybe (Either ToCardanoError (Hash ScriptData))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxOut -> Maybe DatumHash
P.txOutDatumHash TxOut
txOut)
        Either
  ToCardanoError ([(PolicyId, AssetName, Quantity)] -> ExportTxInput)
-> Either ToCardanoError [(PolicyId, AssetName, Quantity)]
-> Either ToCardanoError ExportTxInput
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(PolicyId, AssetName, Quantity)]
-> Either ToCardanoError [(PolicyId, AssetName, Quantity)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(PolicyId, AssetName, Quantity)]
otherQuantities

-- TODO: Here there's hidden error of script DCert missing its redeemer - this just counts as no DCert. Don't know if bad.
-- TODO: Refactor with getGardanoTxRedeemers once we are ceady to move to Cardano Txs
mkRedeemers :: P.Tx -> [ExportTxRedeemer]
mkRedeemers :: Tx -> [ExportTxRedeemer]
mkRedeemers = ((ScriptPurpose, Redeemer) -> ExportTxRedeemer)
-> [(ScriptPurpose, Redeemer)] -> [ExportTxRedeemer]
forall a b. (a -> b) -> [a] -> [b]
map ((ScriptPurpose -> Redeemer -> ExportTxRedeemer)
-> (ScriptPurpose, Redeemer) -> ExportTxRedeemer
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ScriptPurpose -> Redeemer -> ExportTxRedeemer
scriptPurposeToExportRedeemer) ([(ScriptPurpose, Redeemer)] -> [ExportTxRedeemer])
-> (Tx -> [(ScriptPurpose, Redeemer)]) -> Tx -> [ExportTxRedeemer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ScriptPurpose Redeemer -> [(ScriptPurpose, Redeemer)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Map ScriptPurpose Redeemer -> [(ScriptPurpose, Redeemer)])
-> (Tx -> Map ScriptPurpose Redeemer)
-> Tx
-> [(ScriptPurpose, Redeemer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> Map ScriptPurpose Redeemer
txRedeemers

scriptPurposeToExportRedeemer :: Ledger.ScriptPurpose -> Redeemer -> ExportTxRedeemer
scriptPurposeToExportRedeemer :: ScriptPurpose -> Redeemer -> ExportTxRedeemer
scriptPurposeToExportRedeemer (Ledger.Spending TxOutRef
ref)     Redeemer
rd = SpendingRedeemer :: Redeemer -> TxOutRef -> ExportTxRedeemer
SpendingRedeemer {redeemerOutRef :: TxOutRef
redeemerOutRef = TxOutRef
ref, redeemer :: Redeemer
redeemer=Redeemer
rd}
scriptPurposeToExportRedeemer (Ledger.Minting CurrencySymbol
cs)       Redeemer
rd = MintingRedeemer :: Redeemer -> MintingPolicyHash -> ExportTxRedeemer
MintingRedeemer {redeemerPolicyId :: MintingPolicyHash
redeemerPolicyId = CurrencySymbol -> MintingPolicyHash
currencyMPSHash CurrencySymbol
cs, redeemer :: Redeemer
redeemer=Redeemer
rd}
scriptPurposeToExportRedeemer (Ledger.Rewarding StakingCredential
cred)   Redeemer
rd = RewardingRedeemer :: Redeemer -> StakingCredential -> ExportTxRedeemer
RewardingRedeemer {redeemerStakingCredential :: StakingCredential
redeemerStakingCredential = StakingCredential
cred, redeemer :: Redeemer
redeemer=Redeemer
rd}
scriptPurposeToExportRedeemer (Ledger.Certifying DCert
dcert) Redeemer
rd = CertifyingRedeemer :: Redeemer -> DCert -> ExportTxRedeemer
CertifyingRedeemer {redeemerDCert :: DCert
redeemerDCert = DCert
dcert, redeemer :: Redeemer
redeemer=Redeemer
rd}