Add TxMetadata to API

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -180,6 +180,7 @@ import Cardano.Wallet.Api.Types
     , ApiTransaction (..)
     , ApiTxId (..)
     , ApiTxInput (..)
+    , ApiTxMetadata (..)
     , ApiUtxoStatistics (..)
     , ApiWallet (..)
     , ApiWalletDelegation (..)
@@ -1224,7 +1225,7 @@ postTransaction
 postTransaction ctx genChange (ApiT wid) body = do
     let pwd = coerce $ getApiT $ body ^. #passphrase
     let outs = coerceCoin <$> (body ^. #payments)
-    let md = Nothing -- fixme: implement in #2073
+    let md = getApiT <$> body ^. #metadata
 
     let selfRewardCredentials (rootK, pwdP) =
             (getRawKey $ deriveRewardAccount @k pwdP rootK, pwdP)
@@ -1264,6 +1265,7 @@ postTransaction ctx genChange (ApiT wid) body = do
         (tx ^. #outputs)
         (tx ^. #withdrawals)
         (meta, time)
+        (tx ^. #metadata)
         #pendingSince
   where
     ti :: TimeInterpreter IO
@@ -1327,9 +1329,8 @@ mkApiTransactionFromInfo
     => TimeInterpreter m
     -> TransactionInfo
     -> m (ApiTransaction n)
-mkApiTransactionFromInfo ti (TransactionInfo txid ins outs ws meta depth txtime _txmeta) = do
-    -- fixme: include _txmeta in API transaction #2074
-    apiTx <- mkApiTransaction ti txid (drop2nd <$> ins) outs ws (meta, txtime) $
+mkApiTransactionFromInfo ti (TransactionInfo txid ins outs ws meta depth txtime txmeta) = do
+    apiTx <- mkApiTransaction ti txid (drop2nd <$> ins) outs ws (meta, txtime) txmeta $
         case meta ^. #status of
             Pending  -> #pendingSince
             InLedger -> #insertedAt
@@ -1355,7 +1356,10 @@ postTransactionFee
     -> PostTransactionFeeData n
     -> Handler ApiFee
 postTransactionFee ctx (ApiT wid) body = do
-    let outs = coerceCoin <$> (body ^. #payments)
+    let outs = coerceCoin <$> body ^. #payments
+    -- fixme: #2075 include metadata in fee calculation
+    let _md = getApiT <$> body ^. #metadata
+
     withWorkerCtx ctx wid liftE liftE $ \wrk -> do
         wdrl <- case body ^. #withdrawal of
             Nothing ->
@@ -1419,6 +1423,7 @@ joinStakePool ctx knownPools getPoolStatus apiPoolId (ApiT wid) body = do
         (tx ^. #outputs)
         (tx ^. #withdrawals)
         (txMeta, txTime)
+        Nothing
         #pendingSince
   where
     -- Not forecasting into the future. Should be safe.
@@ -1467,6 +1472,7 @@ quitStakePool ctx (ApiT wid) body = do
         (tx ^. #outputs)
         (tx ^. #withdrawals)
         (txMeta, txTime)
+        Nothing
         #pendingSince
   where
     -- Not forecasting into the future. Should be safe.
@@ -1539,6 +1545,7 @@ migrateWallet ctx (ApiT wid) migrateData = do
             (NE.toList (W.unsignedOutputs cs))
             (tx ^. #withdrawals)
             (meta, time)
+            Nothing
             #pendingSince
   where
     pwd = coerce $ getApiT $ migrateData ^. #passphrase
@@ -1787,9 +1794,10 @@ mkApiTransaction
     -> [TxOut]
     -> Map ChimericAccount Coin
     -> (W.TxMeta, UTCTime)
+    -> Maybe W.TxMetadata
     -> Lens' (ApiTransaction n) (Maybe ApiTimeReference)
     -> m (ApiTransaction n)
-mkApiTransaction ti txid ins outs ws (meta, timestamp) setTimeReference = do
+mkApiTransaction ti txid ins outs ws (meta, timestamp) txMeta setTimeReference = do
     timeRef <- timeReference
     return $ tx & setTimeReference .~ Just timeRef
   where
@@ -1805,6 +1813,7 @@ mkApiTransaction ti txid ins outs ws (meta, timestamp) setTimeReference = do
         , outputs = toAddressAmount <$> outs
         , withdrawals = mkApiWithdrawal @n <$> Map.toList ws
         , status = ApiT (meta ^. #status)
+        , metadata = apiTxMetadata txMeta
         }
 
     timeReference :: m ApiTimeReference
@@ -1828,6 +1837,9 @@ mkApiTransaction ti txid ins outs ws (meta, timestamp) setTimeReference = do
     toAddressAmount (TxOut addr c) =
         AddressAmount (ApiT addr, Proxy @n) (mkApiCoin c)
 
+    apiTxMetadata :: Maybe W.TxMetadata -> ApiTxMetadata
+    apiTxMetadata = ApiTxMetadata . fmap ApiT
+
 mkApiCoin
     :: Coin
     -> Quantity "lovelace" Natural

lib/core/src/Cardano/Wallet/Api/Types.hs

@@ -64,6 +64,7 @@ module Cardano.Wallet.Api.Types
     , ApiFee (..)
     , ApiTxId (..)
     , ApiTxInput (..)
+    , ApiTxMetadata (..)
     , AddressAmount (..)
     , ApiErrorCode (..)
     , ApiNetworkInformation (..)
@@ -127,6 +128,8 @@ import Prelude
 
 import Cardano.Address.Derivation
     ( XPrv, XPub, xpubToBytes )
+import Cardano.Api.MetaData
+    ( jsonFromMetadata, jsonToMetadata )
 import Cardano.Mnemonic
     ( MkSomeMnemonic (..)
     , MkSomeMnemonicError (..)
@@ -173,13 +176,15 @@ import Cardano.Wallet.Primitive.Types
     , StakePoolMetadata
     , StartTime (..)
     , TxIn (..)
+    , TxMetadata
     , TxStatus (..)
     , WalletBalance (..)
     , WalletId (..)
     , WalletName (..)
     , decodePoolIdBech32
     , encodePoolIdBech32
     , isValidCoin
+    , txMetadataIsNull
     , unsafeEpochNo
     )
 import Control.Applicative
@@ -492,11 +497,13 @@ data PostTransactionData (n :: NetworkDiscriminant) = PostTransactionData
     { payments :: !(NonEmpty (AddressAmount (ApiT Address, Proxy n)))
     , passphrase :: !(ApiT (Passphrase "lenient"))
     , withdrawal :: !(Maybe ApiWithdrawalPostData)
+    , metadata :: !(Maybe (ApiT TxMetadata))
     } deriving (Eq, Generic, Show)
 
 data PostTransactionFeeData (n :: NetworkDiscriminant) = PostTransactionFeeData
     { payments :: (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
     , withdrawal :: !(Maybe ApiWithdrawalPostData)
+    , metadata :: !(Maybe (ApiT TxMetadata))
     } deriving (Eq, Generic, Show)
 
 newtype PostExternalTransactionData = PostExternalTransactionData
@@ -557,6 +564,11 @@ data ApiTransaction (n :: NetworkDiscriminant) = ApiTransaction
     , outputs :: ![AddressAmount (ApiT Address, Proxy n)]
     , withdrawals :: ![ApiWithdrawal n]
     , status :: !(ApiT TxStatus)
+    , metadata :: !ApiTxMetadata
+    } deriving (Eq, Generic, Show)
+
+newtype ApiTxMetadata = ApiTxMetadata
+    { getApiTxMetadata :: Maybe (ApiT TxMetadata)
     } deriving (Eq, Generic, Show)
 
 data ApiWithdrawal n = ApiWithdrawal
@@ -1228,6 +1240,20 @@ instance
   where
     toJSON = genericToJSON defaultRecordTypeOptions
 
+instance FromJSON (ApiT TxMetadata) where
+    parseJSON = fmap ApiT . eitherToParser . jsonToMetadata
+instance ToJSON (ApiT TxMetadata) where
+    toJSON = jsonFromMetadata . getApiT
+
+instance FromJSON ApiTxMetadata where
+    parseJSON Aeson.Null = pure $ ApiTxMetadata Nothing
+    parseJSON v = ApiTxMetadata . Just <$> parseJSON v
+instance ToJSON ApiTxMetadata where
+    toJSON (ApiTxMetadata x) = case x of
+        Nothing -> Aeson.Null
+        Just (ApiT md) | txMetadataIsNull md -> Aeson.Null
+        Just md -> toJSON md
+
 instance (DecodeAddress n , PassphraseMaxLength s , PassphraseMinLength s) => FromJSON (ApiWalletMigrationPostData n s)
   where
     parseJSON = genericParseJSON defaultRecordTypeOptions

lib/core/src/Cardano/Wallet/Primitive/Types.hs

@@ -52,6 +52,7 @@ module Cardano.Wallet.Primitive.Types
     , inputs
     , fromTransactionInfo
     , toTxHistory
+    , txMetadataIsNull
 
     -- * Address
     , Address (..)
@@ -280,6 +281,7 @@ import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.Lazy.Builder as Builder
+import qualified Shelley.Spec.Ledger.MetaData as MD
 
 {-------------------------------------------------------------------------------
                              Wallet Metadata
@@ -1018,6 +1020,10 @@ fromTransactionInfo info = Tx
     , metadata = txInfoMetadata info
     }
 
+-- | Test whether the given metadata map is empty.
+txMetadataIsNull :: TxMetadata -> Bool
+txMetadataIsNull (TxMetadata (MD.MetaData md)) = Map.null md
+
 -- | Drop time-specific information
 toTxHistory :: TransactionInfo -> (Tx, TxMeta)
 toTxHistory info =