Skip to content

Commit

Permalink
Merge #3251
Browse files Browse the repository at this point in the history 
3251: Add collateral return outputs to the API and DB r=jonathanknowles a=jonathanknowles

## Tasks Implemented

ADP-1715 (_Update API to support collateral return outputs_)
ADP-1716 (_Update DB schema to support collateral return outputs_)
ADP-1717 (_Update primitive types to support collateral return outputs_)

## Summary

This PR tackles the "edges" of support for collateral return outputs:
- adjusting API types;
- adjusting primitive types;
- adjusting the DB schema;
- adjusting the DB persistence layer.

The approach used for every commit (except where indicated) in this PR is to:
- first make an adjustment;
- then make the minimal possible number of changes to:
    - get the code to compile;
    - get the tests to pass.
    
This PR does **_not_** update our UTxO transition function to account for collateral outputs. Therefore, when reading blocks with transactions containing collateral outputs that affect a wallet, these outputs will currently be ignored. Updating the UTxO transition function will be handled by ADP-1718.

Co-authored-by: Jonathan Knowles <[email protected]>
  • Loading branch information
@iohk-bors @jonathanknowles
iohk-bors[bot] and jonathanknowles authored Apr 27, 2022
2 parents eb07530 + f7b1137 commit d2d430a
Show file tree
Hide file tree
Showing 22 changed files with 18,628 additions and 16,618 deletions.
7 changes: 5 additions & 2 deletions lib/core/bench/db-bench.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -574,11 +574,14 @@ mkTxHistory numTx numInputs numOutputs numAssets range =
( Tx
{ txId = mkTxId resolvedInputs outputs mempty Nothing
, fee = Nothing
, resolvedCollateral =
, resolvedInputs
, resolvedCollateralInputs =
-- TODO: (ADP-957)
[]
, resolvedInputs
, outputs
, collateralOutput =
-- TODO: [ADP-1670]
Nothing
, withdrawals = mempty
, metadata = Nothing
, scriptValidity = Nothing
Expand Down
78 changes: 48 additions & 30 deletions lib/core/src/Cardano/Wallet/Api/Server.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -209,6 +209,7 @@ import Cardano.Wallet.Api.Types
, ApiActiveSharedWallet (..)
, ApiAddress (..)
, ApiAnyCertificate (..)
, ApiAsArray (..)
, ApiAsset (..)
, ApiAssetMintBurn (..)
, ApiBalanceTransactionPostData
Expand Down Expand Up @@ -2036,10 +2037,11 @@ postTransactionOld ctx genChange (ApiT wid) body = do
MkApiTransactionParams
{ txId = tx ^. #txId
, txFee = tx ^. #fee
-- TODO: ADP-957:
, txCollateral = []
, txInputs = NE.toList $ second Just <$> sel ^. #inputs
-- TODO: ADP-957:
, txCollateralInputs = []
, txOutputs = tx ^. #outputs
, txCollateralOutput = tx ^. #collateralOutput
, txWithdrawals = tx ^. #withdrawals
, txMeta
, txMetadata = tx ^. #metadata
Expand Down Expand Up @@ -2112,9 +2114,10 @@ mkApiTransactionFromInfo ti deposit info = do
MkApiTransactionParams
{ txId = info ^. #txInfoId
, txFee = info ^. #txInfoFee
, txCollateral = info ^. #txInfoCollateral <&> drop2nd
, txInputs = info ^. #txInfoInputs <&> drop2nd
, txCollateralInputs = info ^. #txInfoCollateralInputs <&> drop2nd
, txOutputs = info ^. #txInfoOutputs
, txCollateralOutput = info ^. #txInfoCollateralOutput
, txWithdrawals = info ^. #txInfoWithdrawals
, txMeta = info ^. #txInfoMeta
, txMetadata = info ^. #txInfoMetadata
Expand Down Expand Up @@ -2483,40 +2486,49 @@ decodeTransaction
-> ApiSerialisedTransaction
-> Handler (ApiDecodedTransaction n)
decodeTransaction ctx (ApiT wid) (ApiSerialisedTransaction (ApiT sealed)) = do
let (Tx txid feeM colls inps outs wdrlMap meta vldt
, toMint
, toBurn
, allCerts
) = decodeTx tl sealed
let (decodedTx, toMint, toBurn, allCerts) = decodeTx tl sealed
let (Tx { txId
, fee
, resolvedInputs
, resolvedCollateralInputs
, outputs
, withdrawals
, metadata
, scriptValidity
}) = decodedTx
(txinsOutsPaths, collsOutsPaths, outsPath, acct, acctPath, pp, policyXPubM)
<- withWorkerCtx ctx wid liftE liftE $ \wrk -> do
(acct, _, acctPath) <-
liftHandler $ W.readRewardAccount @_ @s @k @n wrk wid
txinsOutsPaths <-
liftHandler $ W.lookupTxIns @_ @s @k wrk wid (fst <$> inps)
collsOutsPaths <-
liftHandler $ W.lookupTxIns @_ @s @k wrk wid (fst <$> colls)
outsPath <-
liftHandler $ W.lookupTxOuts @_ @s @k wrk wid outs
inputPaths <-
liftHandler $ W.lookupTxIns @_ @s @k wrk wid $
fst <$> resolvedInputs
collateralInputPaths <-
liftHandler $ W.lookupTxIns @_ @s @k wrk wid $
fst <$> resolvedCollateralInputs
outputPaths <-
liftHandler $ W.lookupTxOuts @_ @s @k wrk wid outputs
pp <- liftIO $ NW.currentProtocolParameters (wrk ^. networkLayer)
policyXPubM <- fmap (fmap fst . eitherToMaybe)
<$> liftIO . runExceptT $ W.readPolicyPublicKey @_ @s @k @n wrk wid
pure
( txinsOutsPaths
, collsOutsPaths
, outsPath
( inputPaths
, collateralInputPaths
, outputPaths
, acct
, acctPath
, pp
, policyXPubM
)
pure $ ApiDecodedTransaction
{ id = ApiT txid
, fee = maybe (Quantity 0) (Quantity . fromIntegral . unCoin) feeM
{ id = ApiT txId
, fee = maybe (Quantity 0) (Quantity . fromIntegral . unCoin) fee
, inputs = map toInp txinsOutsPaths
, outputs = map toOut outsPath
, collateral = map toInp collsOutsPaths
, withdrawals = map (toWrdl acct) $ Map.assocs wdrlMap
-- TODO: [ADP-1670]
, collateralOutputs = ApiAsArray Nothing
, withdrawals = map (toWrdl acct) $ Map.assocs withdrawals
, mint = toApiAssetMintBurn policyXPubM toMint
, burn = toApiAssetMintBurn policyXPubM toBurn
, certificates = map (toApiAnyCert acct acctPath) allCerts
Expand All @@ -2528,8 +2540,8 @@ decodeTransaction ctx (ApiT wid) (ApiSerialisedTransaction (ApiT sealed)) = do
(Quantity . fromIntegral . unCoin . W.stakeKeyDeposit $ pp)
<$ filter ourRewardAccountDeregistration
(toApiAnyCert acct acctPath <$> allCerts)
, metadata = ApiTxMetadata $ ApiT <$> meta
, scriptValidity = ApiT <$> vldt
, metadata = ApiTxMetadata $ ApiT <$> metadata
, scriptValidity = ApiT <$> scriptValidity
}
where
tl = ctx ^. W.transactionLayer @k
Expand Down Expand Up @@ -2844,10 +2856,11 @@ joinStakePool ctx knownPools getPoolStatus apiPoolId (ApiT wid) body = do
MkApiTransactionParams
{ txId = tx ^. #txId
, txFee = tx ^. #fee
-- Joining a stake pool does not require collateral:
, txCollateral = []
, txInputs = NE.toList $ second Just <$> sel ^. #inputs
-- Joining a stake pool does not require collateral:
, txCollateralInputs = []
, txOutputs = tx ^. #outputs
, txCollateralOutput = tx ^. #collateralOutput
, txWithdrawals = tx ^. #withdrawals
, txMeta
, txMetadata = Nothing
Expand Down Expand Up @@ -2960,10 +2973,11 @@ quitStakePool ctx (ApiT wid) body = do
MkApiTransactionParams
{ txId = tx ^. #txId
, txFee = tx ^. #fee
-- Quitting a stake pool does not require collateral:
, txCollateral = []
, txInputs = NE.toList $ second Just <$> sel ^. #inputs
-- Quitting a stake pool does not require collateral:
, txCollateralInputs = []
, txOutputs = tx ^. #outputs
, txCollateralOutput = tx ^. #collateralOutput
, txWithdrawals = tx ^. #withdrawals
, txMeta
, txMetadata = Nothing
Expand Down Expand Up @@ -3215,11 +3229,12 @@ migrateWallet ctx withdrawalType (ApiT wid) postData = do
MkApiTransactionParams
{ txId = tx ^. #txId
, txFee = tx ^. #fee
-- Migrations never require collateral:
, txCollateral = []
, txInputs =
NE.toList $ second Just <$> selection ^. #inputs
-- Migrations never require collateral:
, txCollateralInputs = []
, txOutputs = tx ^. #outputs
, txCollateralOutput = tx ^. #collateralOutput
, txWithdrawals = tx ^. #withdrawals
, txMeta
, txMetadata = Nothing
Expand Down Expand Up @@ -3672,9 +3687,10 @@ mkApiCoinSelection deps refunds mcerts metadata unsignedTx =
data MkApiTransactionParams = MkApiTransactionParams
{ txId :: Hash "Tx"
, txFee :: Maybe Coin
, txCollateral :: [(TxIn, Maybe TxOut)]
, txInputs :: [(TxIn, Maybe TxOut)]
, txCollateralInputs :: [(TxIn, Maybe TxOut)]
, txOutputs :: [TxOut]
, txCollateralOutput :: Maybe TxOut
, txWithdrawals :: Map RewardAccount Coin
, txMeta :: W.TxMeta
, txMetadata :: Maybe W.TxMetadata
Expand Down Expand Up @@ -3724,9 +3740,11 @@ mkApiTransaction timeInterpreter setTimeReference tx = do
]
, collateral =
[ ApiTxCollateral (fmap toAddressAmountNoAssets o) (ApiT i)
| (i, o) <- tx ^. #txCollateral
| (i, o) <- tx ^. #txCollateralInputs
]
, outputs = toAddressAmount @n <$> tx ^. #txOutputs
, collateralOutputs = ApiAsArray $
toAddressAmount @n <$> tx ^. #txCollateralOutput
, withdrawals = mkApiWithdrawal @n <$> Map.toList (tx ^. #txWithdrawals)
, mint = mempty -- TODO: ADP-xxx
, status = ApiT (tx ^. (#txMeta . #status))
Expand Down
77 changes: 61 additions & 16 deletions lib/core/src/Cardano/Wallet/Api/Types.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -241,6 +241,7 @@ module Cardano.Wallet.Api.Types
, HealthStatusSMASH (..)
, HealthCheckSMASH (..)
, ApiHealthCheck (..)
, ApiAsArray (..)

-- * Re-exports
, Base (Base16, Base64)
Expand Down Expand Up @@ -414,6 +415,8 @@ import Data.List.NonEmpty
( NonEmpty (..) )
import Data.Map.Strict
( Map )
import Data.Maybe
( maybeToList )
import Data.Proxy
( Proxy (..) )
import Data.Quantity
Expand Down Expand Up @@ -449,7 +452,7 @@ import Fmt
import GHC.Generics
( Generic, Rep )
import GHC.TypeLits
( Nat, Symbol )
( KnownSymbol, Nat, Symbol, symbolVal )
import Numeric.Natural
( Natural )
import Quiet
Expand Down Expand Up @@ -670,7 +673,7 @@ data ApiSelectCoinsData (n :: NetworkDiscriminant)
deriving (Eq, Generic, Show, Typeable)

data ApiSelectCoinsPayments (n :: NetworkDiscriminant) = ApiSelectCoinsPayments
{ payments :: NonEmpty (AddressAmount (ApiT Address, Proxy n))
{ payments :: NonEmpty (ApiTxOutput n)
, withdrawal :: !(Maybe ApiWithdrawalPostData)
, metadata :: !(Maybe (ApiT TxMetadata))
} deriving (Eq, Generic, Show, Typeable)
Expand Down Expand Up @@ -997,7 +1000,7 @@ data ApiSignTransactionPostData = ApiSignTransactionPostData

-- | Legacy transaction API.
data PostTransactionOldData (n :: NetworkDiscriminant) = PostTransactionOldData
{ payments :: !(NonEmpty (AddressAmount (ApiT Address, Proxy n)))
{ payments :: !(NonEmpty (ApiTxOutput n))
, passphrase :: !(ApiT (Passphrase "lenient"))
, withdrawal :: !(Maybe ApiWithdrawalPostData)
, metadata :: !(Maybe (ApiT TxMetadata))
Expand All @@ -1006,7 +1009,7 @@ data PostTransactionOldData (n :: NetworkDiscriminant) = PostTransactionOldData

-- | Legacy transaction API.
data PostTransactionFeeOldData (n :: NetworkDiscriminant) = PostTransactionFeeOldData
{ payments :: (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
{ payments :: !(NonEmpty (ApiTxOutput n))
, withdrawal :: !(Maybe ApiWithdrawalPostData)
, metadata :: !(Maybe (ApiT TxMetadata))
, timeToLive :: !(Maybe (Quantity "second" NominalDiffTime))
Expand Down Expand Up @@ -1122,14 +1125,17 @@ toApiNetworkParameters (NetworkParameters gp sp pp) txConstraints toEpochInfo =
where
toApiCoin = Quantity . fromIntegral . unCoin


newtype ApiTxId = ApiTxId
{ id :: ApiT (Hash "Tx")
}
deriving (Eq, Generic)
deriving anyclass NFData
deriving Show via (Quiet ApiTxId)

-- | A helper type to reduce the amount of repetition.
--
type ApiTxOutput n = AddressAmount (ApiT Address, Proxy n)

data ApiTransaction (n :: NetworkDiscriminant) = ApiTransaction
{ id :: !(ApiT (Hash "Tx"))
, amount :: !(Quantity "lovelace" Natural)
Expand All @@ -1142,15 +1148,18 @@ data ApiTransaction (n :: NetworkDiscriminant) = ApiTransaction
, depth :: !(Maybe (Quantity "block" Natural))
, direction :: !(ApiT Direction)
, inputs :: ![ApiTxInput n]
, outputs :: ![AddressAmount (ApiT Address, Proxy n)]
, outputs :: ![ApiTxOutput n]
, collateral :: ![ApiTxCollateral n]
, collateralOutputs ::
!(ApiAsArray "collateral_outputs" (Maybe (ApiTxOutput n)))
, withdrawals :: ![ApiWithdrawal n]
, mint :: !(ApiT W.TokenMap)
, status :: !(ApiT TxStatus)
, metadata :: !ApiTxMetadata
, scriptValidity :: !(Maybe (ApiT TxScriptValidity))
} deriving (Eq, Generic, Show, Typeable)
deriving anyclass NFData
}
deriving (Eq, Generic, Show, Typeable)
deriving anyclass NFData

data ApiWalletInput (n :: NetworkDiscriminant) = ApiWalletInput
{ id :: !(ApiT (Hash "Tx"))
Expand Down Expand Up @@ -1188,7 +1197,7 @@ data ApiWalletOutput (n :: NetworkDiscriminant) = ApiWalletOutput
deriving anyclass NFData

data ApiTxOutputGeneral (n :: NetworkDiscriminant) =
ExternalOutput (AddressAmount (ApiT Address, Proxy n))
ExternalOutput (ApiTxOutput n)
| WalletOutput (ApiWalletOutput n)
deriving (Eq, Generic, Show, Typeable)
deriving anyclass NFData
Expand Down Expand Up @@ -1270,6 +1279,8 @@ data ApiDecodedTransaction (n :: NetworkDiscriminant) = ApiDecodedTransaction
, inputs :: ![ApiTxInputGeneral n]
, outputs :: ![ApiTxOutputGeneral n]
, collateral :: ![ApiTxInputGeneral n]
, collateralOutputs ::
!(ApiAsArray "collateral_outputs" (Maybe (ApiTxOutputGeneral n)))
, withdrawals :: ![ApiWithdrawalGeneral n]
, mint :: !ApiAssetMintBurn
, burn :: !ApiAssetMintBurn
Expand All @@ -1278,8 +1289,9 @@ data ApiDecodedTransaction (n :: NetworkDiscriminant) = ApiDecodedTransaction
, depositsReturned :: ![Quantity "lovelace" Natural]
, metadata :: !ApiTxMetadata
, scriptValidity :: !(Maybe (ApiT TxScriptValidity))
} deriving (Eq, Generic, Show, Typeable)
deriving anyclass NFData
}
deriving (Eq, Generic, Show, Typeable)
deriving anyclass NFData

newtype ApiTxMetadata = ApiTxMetadata
{ getApiTxMetadata :: Maybe (ApiT TxMetadata)
Expand Down Expand Up @@ -1308,7 +1320,7 @@ data ApiWithdrawalPostData
deriving anyclass NFData

data ApiTxInput (n :: NetworkDiscriminant) = ApiTxInput
{ source :: !(Maybe (AddressAmount (ApiT Address, Proxy n)))
{ source :: !(Maybe (ApiTxOutput n))
, input :: !(ApiT TxIn)
} deriving (Eq, Generic, Show, Typeable)
deriving anyclass NFData
Expand Down Expand Up @@ -3254,13 +3266,16 @@ instance
parseJSON obj = do
derPathM <-
(withObject "ApiTxOutputGeneral" $
\o -> o .:? "derivation_path" :: Aeson.Parser (Maybe (NonEmpty (ApiT DerivationIndex)))) obj
\o -> o .:? "derivation_path"
:: Aeson.Parser (Maybe (NonEmpty (ApiT DerivationIndex)))) obj
case derPathM of
Nothing -> do
xs <- parseJSON obj :: Aeson.Parser (AddressAmount (ApiT Address, Proxy n))
xs <- parseJSON obj
:: Aeson.Parser (ApiTxOutput n)
pure $ ExternalOutput xs
Just _ -> do
xs <- parseJSON obj :: Aeson.Parser (ApiWalletOutput n)
xs <- parseJSON obj
:: Aeson.Parser (ApiWalletOutput n)
pure $ WalletOutput xs
instance
( EncodeAddress n
Expand All @@ -3278,7 +3293,8 @@ instance
parseJSON obj = do
derPathM <-
(withObject "ApiTxInputGeneral" $
\o -> o .:? "derivation_path" :: Aeson.Parser (Maybe (NonEmpty (ApiT DerivationIndex)))) obj
\o -> o .:? "derivation_path"
:: Aeson.Parser (Maybe (NonEmpty (ApiT DerivationIndex)))) obj
case derPathM of
Nothing -> do
xs <- parseJSON obj :: Aeson.Parser (ApiT TxIn)
Expand Down Expand Up @@ -4124,3 +4140,32 @@ instance FromJSON (ApiT TxScriptValidity) where
instance ToJSON (ApiT TxScriptValidity) where
toJSON = genericToJSON Aeson.defaultOptions
{ constructorTagModifier = camelTo2 '_' . drop 8 } . getApiT

--------------------------------------------------------------------------------
-- Utility types
--------------------------------------------------------------------------------

-- | A wrapper that allows any type to be serialized as a JSON array.
--
-- The number of items permitted in the array is dependent on the wrapped type.
--
newtype ApiAsArray (s :: Symbol) a = ApiAsArray a
deriving (Eq, Generic, Show, Typeable)
deriving newtype (Monoid, Semigroup)
deriving anyclass NFData

instance (KnownSymbol s, FromJSON a) => FromJSON (ApiAsArray s (Maybe a)) where
parseJSON json = parseJSON @[a] json >>= \case
[a] ->
pure $ ApiAsArray $ Just a
[] ->
pure $ ApiAsArray Nothing
_ ->
fail $ mconcat
[ "Expected at most one item for "
, show $ symbolVal $ Proxy @s
, "."
]

instance ToJSON a => ToJSON (ApiAsArray s (Maybe a)) where
toJSON (ApiAsArray m) = toJSON (maybeToList m)
Loading

0 comments on commit d2d430a

Please sign in to comment.