{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Cardano.Wallet.LocalClient.ExportTx(
balanceTx
, handleTx
, yieldUnbalancedTx
, WAPI.signTxAndSubmit
, ExportTx(..)
, ExportTxInput(..)
, ExportTxRedeemer(..)
, export
) where
import Cardano.Api qualified as C
import Cardano.Node.Emulator.Params (Params)
import Cardano.Node.Emulator.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 (Map)
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, TxId (TxId), TxOutRef)
import Ledger.Tx.CardanoAPI (fromPlutusIndex)
import Ledger.Tx.Constraints (UnbalancedTx (UnbalancedCardanoTx))
import Plutus.Contract.CardanoAPI qualified as CardanoAPI
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)
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
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"
parseRewardingRedeemer :: Value -> Parser ExportTxRedeemer
parseRewardingRedeemer :: Value -> Parser ExportTxRedeemer
parseRewardingRedeemer = String -> Value -> Parser ExportTxRedeemer
forall a. HasCallStack => String -> a
error String
"Unimplemented rewarding redeemer parsing."
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]
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."
data ExportTx =
ExportTx
{ ExportTx -> Tx BabbageEra
partialTx :: C.Tx C.BabbageEra
, ExportTx -> [ExportTxInput]
lookups :: [ExportTxInput]
, 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))
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 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
let cardanoValue :: Value
cardanoValue = 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
-> AddressInEra BabbageEra
-> Lovelace
-> Maybe (Hash ScriptData)
-> [(PolicyId, AssetName, Quantity)]
-> ExportTxInput
ExportTxInput
(TxId
-> TxIx
-> AddressInEra BabbageEra
-> Lovelace
-> Maybe (Hash ScriptData)
-> [(PolicyId, AssetName, Quantity)]
-> ExportTxInput)
-> Either ToCardanoError TxId
-> Either
ToCardanoError
(TxIx
-> AddressInEra BabbageEra
-> 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
-> AddressInEra BabbageEra
-> Lovelace
-> Maybe (Hash ScriptData)
-> [(PolicyId, AssetName, Quantity)]
-> ExportTxInput)
-> Either ToCardanoError TxIx
-> Either
ToCardanoError
(AddressInEra BabbageEra
-> 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
(AddressInEra BabbageEra
-> Lovelace
-> Maybe (Hash ScriptData)
-> [(PolicyId, AssetName, Quantity)]
-> ExportTxInput)
-> Either ToCardanoError (AddressInEra BabbageEra)
-> Either
ToCardanoError
(Lovelace
-> Maybe (Hash ScriptData)
-> [(PolicyId, AssetName, Quantity)]
-> ExportTxInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AddressInEra BabbageEra
-> Either ToCardanoError (AddressInEra BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut -> AddressInEra BabbageEra
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