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

import Cardano.Api qualified as C
import Cardano.Node.Emulator.Internal.Node.Params (Params)
import Cardano.Node.Emulator.Internal.Node.Validation (CardanoLedgerError, makeTransactionBody)
import Control.Applicative ((<|>))
import Control.Monad ((>=>))
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 (first)
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Ledger (DCert, StakingCredential)
import Ledger qualified as P
import Ledger.Tx (CardanoTx, TxOutRef)
import Ledger.Tx.CardanoAPI (fromPlutusIndex)
import Ledger.Tx.Constraints (UnbalancedTx (UnbalancedCardanoTx))
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

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)

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
Plutus.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)

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 -> AddressInEra BabbageEra
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)

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
-> AddressInEra BabbageEra
-> Lovelace
-> Maybe (Hash ScriptData)
-> [(PolicyId, AssetName, Quantity)]
-> ExportTxInput
ExportTxInput
        (TxId
 -> TxIx
 -> AddressInEra BabbageEra
 -> Lovelace
 -> Maybe (Hash ScriptData)
 -> [(PolicyId, AssetName, Quantity)]
 -> ExportTxInput)
-> Parser TxId
-> Parser
     (TxIx
      -> AddressInEra BabbageEra
      -> 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
   -> AddressInEra BabbageEra
   -> Lovelace
   -> Maybe (Hash ScriptData)
   -> [(PolicyId, AssetName, Quantity)]
   -> ExportTxInput)
-> Parser TxIx
-> Parser
     (AddressInEra BabbageEra
      -> 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
  (AddressInEra BabbageEra
   -> Lovelace
   -> Maybe (Hash ScriptData)
   -> [(PolicyId, AssetName, Quantity)]
   -> ExportTxInput)
-> Parser (AddressInEra BabbageEra)
-> Parser
     (Lovelace
      -> Maybe (Hash ScriptData)
      -> [(PolicyId, AssetName, Quantity)]
      -> ExportTxInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser (AddressInEra BabbageEra)
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 (AddressInEra BabbageEra)
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 (AddressInEra BabbageEra)
deserialisedAddr = AsType (AddressInEra BabbageEra)
-> Text -> Maybe (AddressInEra BabbageEra)
forall addr.
SerialiseAddress addr =>
AsType addr -> Text -> Maybe addr
C.deserialiseAddress (AsType BabbageEra -> AsType (AddressInEra BabbageEra)
forall era. AsType era -> AsType (AddressInEra era)
C.AsAddressInEra AsType BabbageEra
C.AsBabbageEra) Text
addressField
              Parser (AddressInEra BabbageEra)
-> (AddressInEra BabbageEra -> Parser (AddressInEra BabbageEra))
-> Maybe (AddressInEra BabbageEra)
-> Parser (AddressInEra BabbageEra)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser (AddressInEra BabbageEra)
forall a. String -> Parser a
parseFail String
"Failed to deserialise address field") AddressInEra BabbageEra -> Parser (AddressInEra BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (AddressInEra BabbageEra)
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, AddressInEra BabbageEra
etxiAddress :: AddressInEra BabbageEra
etxiAddress :: ExportTxInput -> AddressInEra BabbageEra
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
.= AddressInEra BabbageEra -> Text
forall addr. SerialiseAddress addr => addr -> Text
C.serialiseAddress AddressInEra BabbageEra
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 (UnbalancedCardanoTx CardanoBuildTx
tx UtxoIndex
utxos) =
    let fromCardanoTx :: CardanoBuildTx -> Either CardanoLedgerError (TxBody BabbageEra)
fromCardanoTx CardanoBuildTx
ctx =
            let utxo :: UTxO (BabbageEra StandardCrypto)
utxo = UtxoIndex -> UTxO (BabbageEra StandardCrypto)
fromPlutusIndex UtxoIndex
utxos
            in Params
-> UTxO (BabbageEra StandardCrypto)
-> CardanoBuildTx
-> Either CardanoLedgerError (TxBody BabbageEra)
makeTransactionBody Params
params UTxO (BabbageEra StandardCrypto)
utxo CardanoBuildTx
ctx
    in do
        TxBody BabbageEra
tx' <- CardanoBuildTx -> Either CardanoLedgerError (TxBody BabbageEra)
fromCardanoTx CardanoBuildTx
tx
        ExportTx -> Either CardanoLedgerError ExportTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExportTx -> Either CardanoLedgerError ExportTx)
-> ExportTx -> Either CardanoLedgerError ExportTx
forall a b. (a -> b) -> a -> b
$ Tx BabbageEra -> [ExportTxInput] -> [ExportTxRedeemer] -> ExportTx
ExportTx ([KeyWitness BabbageEra] -> TxBody BabbageEra -> Tx BabbageEra
forall era. [KeyWitness era] -> TxBody era -> Tx era
C.makeSignedTransaction [] TxBody BabbageEra
tx') (UtxoIndex -> [ExportTxInput]
mkInputs UtxoIndex
utxos) []

mkInputs :: P.UtxoIndex -> [ExportTxInput]
mkInputs :: UtxoIndex -> [ExportTxInput]
mkInputs = ((TxIn, TxOut CtxUTxO BabbageEra) -> ExportTxInput)
-> [(TxIn, TxOut CtxUTxO BabbageEra)] -> [ExportTxInput]
forall a b. (a -> b) -> [a] -> [b]
map ((TxIn -> TxOut CtxUTxO BabbageEra -> ExportTxInput)
-> (TxIn, TxOut CtxUTxO BabbageEra) -> ExportTxInput
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxIn -> TxOut CtxUTxO BabbageEra -> ExportTxInput
toExportTxInput) ([(TxIn, TxOut CtxUTxO BabbageEra)] -> [ExportTxInput])
-> (UtxoIndex -> [(TxIn, TxOut CtxUTxO BabbageEra)])
-> UtxoIndex
-> [ExportTxInput]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn (TxOut CtxUTxO BabbageEra)
-> [(TxIn, TxOut CtxUTxO BabbageEra)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxIn (TxOut CtxUTxO BabbageEra)
 -> [(TxIn, TxOut CtxUTxO BabbageEra)])
-> (UtxoIndex -> Map TxIn (TxOut CtxUTxO BabbageEra))
-> UtxoIndex
-> [(TxIn, TxOut CtxUTxO BabbageEra)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex -> Map TxIn (TxOut CtxUTxO BabbageEra)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
C.unUTxO

toExportTxInput :: C.TxIn -> C.TxOut C.CtxUTxO C.BabbageEra -> ExportTxInput
toExportTxInput :: TxIn -> TxOut CtxUTxO BabbageEra -> ExportTxInput
toExportTxInput (C.TxIn TxId
txId TxIx
txIx) (C.TxOut AddressInEra BabbageEra
aie TxOutValue BabbageEra
tov TxOutDatum CtxUTxO BabbageEra
tod ReferenceScript BabbageEra
_) =
    let value :: Value
value = TxOutValue BabbageEra -> Value
forall era. TxOutValue era -> Value
C.txOutValueToValue TxOutValue BabbageEra
tov
        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
value
    in TxId
-> TxIx
-> AddressInEra BabbageEra
-> Lovelace
-> Maybe (Hash ScriptData)
-> [(PolicyId, AssetName, Quantity)]
-> ExportTxInput
ExportTxInput TxId
txId TxIx
txIx AddressInEra BabbageEra
aie (Value -> Lovelace
C.selectLovelace Value
value) (TxOutDatum CtxUTxO BabbageEra -> Maybe (Hash ScriptData)
P.cardanoTxOutDatumHash TxOutDatum CtxUTxO BabbageEra
tod) [(PolicyId, AssetName, Quantity)]
otherQuantities