diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs index 33ef2f823e5..f0d9f8de602 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs @@ -27,6 +27,7 @@ import Cardano.Wallet.Api.Types , ApiFee (..) , ApiT (..) , ApiTransaction + , ApiMintBurnTransaction , ApiTxId (..) , ApiTxInput (..) , ApiWallet @@ -1025,7 +1026,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do w <- fixtureWallet ctx payload <- mkMintPayload ctx w 5 fixturePassphrase "0" "aaaa" - r1 <- request @(ApiTransaction n) ctx (Link.mintToken w) Default payload + r1 <- request @(ApiMintBurnTransaction n) ctx (Link.mintToken w) Default payload verify r1 [ expectResponseCode HTTP.status202 ] @@ -1041,28 +1042,28 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do w <- fixtureWallet ctx payload <- mkMintPayload ctx w 150 fixturePassphrase "-1" "123" - r1 <- request @(ApiTransaction n) ctx (Link.mintToken w) Default payload - expectResponseCode HTTP.status403 r1 + r1 <- request @(ApiMintBurnTransaction n) ctx (Link.mintToken w) Default payload + expectResponseCode HTTP.status400 r1 it "TRANS_MINT_02b - Cannot mint policy index > 2147483647" $ \ctx -> runResourceT $ do w <- fixtureWallet ctx payload <- mkMintPayload ctx w 150 fixturePassphrase "2147483648" "123" - r1 <- request @(ApiTransaction n) ctx (Link.mintToken w) Default payload - expectResponseCode HTTP.status403 r1 + r1 <- request @(ApiMintBurnTransaction n) ctx (Link.mintToken w) Default payload + expectResponseCode HTTP.status400 r1 it "TRANS_MINT_02c - Cannot mint policy index that is not a number" $ \ctx -> runResourceT $ do w <- fixtureWallet ctx payload <- mkMintPayload ctx w 150 fixturePassphrase "pomidor" "123" - r1 <- request @(ApiTransaction n) ctx (Link.mintToken w) Default payload - expectResponseCode HTTP.status403 r1 + r1 <- request @(ApiMintBurnTransaction n) ctx (Link.mintToken w) Default payload + expectResponseCode HTTP.status400 r1 it "TRANS_MINT_03a - Can mint with empty token name" $ \ctx -> runResourceT $ do w <- fixtureWallet ctx payload <- mkMintPayload ctx w 150 fixturePassphrase "0" "" - r1 <- request @(ApiTransaction n) ctx (Link.mintToken w) Default payload + r1 <- request @(ApiMintBurnTransaction n) ctx (Link.mintToken w) Default payload expectResponseCode HTTP.status202 r1 it "TRANS_MINT_03b - Sufficient error on too long token name" $ \ctx -> runResourceT $ do @@ -1070,28 +1071,28 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do let tokenName = T.pack $ replicate 66 'a' payload <- mkMintPayload ctx w 233 fixturePassphrase "0" tokenName - r1 <- request @(ApiTransaction n) ctx (Link.mintToken w) Default payload + r1 <- request @(ApiMintBurnTransaction n) ctx (Link.mintToken w) Default payload expectResponseCode HTTP.status403 r1 it "TRANS_MINT_04a - Cannot mint 0 tokens" $ \ctx -> runResourceT $ do w <- fixtureWallet ctx payload <- mkMintPayload ctx w 0 fixturePassphrase "0" "aaaa" - r1 <- request @(ApiTransaction n) ctx (Link.mintToken w) Default payload + r1 <- request @(ApiMintBurnTransaction n) ctx (Link.mintToken w) Default payload expectResponseCode HTTP.status403 r1 it "TRANS_MINT_04b - Can mint max allowed value of tokens" $ \ctx -> runResourceT $ do w <- fixtureWallet ctx payload <- mkMintPayload ctx w 9223372036854775807 fixturePassphrase "0" "aaaa" - r1 <- request @(ApiTransaction n) ctx (Link.mintToken w) Default payload + r1 <- request @(ApiMintBurnTransaction n) ctx (Link.mintToken w) Default payload expectResponseCode HTTP.status202 r1 it "TRANS_MINT_04c - Cannot mint tokens exceeding max value" $ \ctx -> runResourceT $ do w <- fixtureWallet ctx payload <- mkMintPayload ctx w 18446744073709551615 fixturePassphrase "0" "aaaa" - r1 <- request @(ApiTransaction n) ctx (Link.mintToken w) Default payload + r1 <- request @(ApiMintBurnTransaction n) ctx (Link.mintToken w) Default payload expectResponseCode HTTP.status403 r1 @@ -1099,7 +1100,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do w <- fixtureWallet ctx mintPayload <- mkMintPayload ctx w 5 fixturePassphrase "0" "aaaa" - r1 <- request @(ApiTransaction n) ctx (Link.mintToken w) Default mintPayload + r1 <- request @(ApiMintBurnTransaction n) ctx (Link.mintToken w) Default mintPayload verify r1 [ expectResponseCode HTTP.status202 ] @@ -1128,7 +1129,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do let burnPayload = Json [json|{ "mint_burn": { "monetary_policy_index": "0", - "token_name": "aaaa", + "asset_name": "aaaa", "operation": { "burn": { "quantity": 5, "unit": "assets" } } @@ -1136,7 +1137,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do "passphrase": #{fixturePassphrase} }|] - r3 <- request @(ApiTransaction n) ctx (Link.mintToken w) Default burnPayload + r3 <- request @(ApiMintBurnTransaction n) ctx (Link.mintToken w) Default burnPayload verify r3 [ expectResponseCode HTTP.status202 @@ -2457,11 +2458,14 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do return $ Json [json|{ "mint_burn": { "monetary_policy_index": #{polId}, - "token_name": #{asName}, + "asset_name": #{asName}, "operation": { - "mint": [ [ #{destination}, - { "quantity": #{amt}, - "unit": "assets" } ] ] + "mint": [ { "receiving_address": #{destination}, + "amount": { "unit": "assets" + , "quantity": #{amt} + } + } + ] } }, "passphrase": #{pass} diff --git a/lib/core/src/Cardano/Wallet/Api.hs b/lib/core/src/Cardano/Wallet/Api.hs index b9fe6782a26..67942a4b64c 100644 --- a/lib/core/src/Cardano/Wallet/Api.hs +++ b/lib/core/src/Cardano/Wallet/Api.hs @@ -163,6 +163,7 @@ import Cardano.Wallet.Api.Types , ApiAddressIdT , ApiAddressInspect , ApiAddressInspectData + , ApiMintBurnTransactionT , ApiAddressT , ApiAsset , ApiByronWallet @@ -1008,7 +1009,7 @@ type MintToken n = "wallets" :> Capture "walletId" (ApiT WalletId) :> "mint" :> ReqBody '[JSON] (MintTokenDataT n) - :> PostAccepted '[JSON] (ApiTransactionT n) + :> PostAccepted '[JSON] (ApiMintBurnTransactionT n) {------------------------------------------------------------------------------- Proxy_ diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 7ac1aa27856..b37a67f5fd7 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -225,6 +225,7 @@ import Cardano.Wallet.Api.Types , ApiStakeKeys (..) , ApiT (..) , ApiTransaction (..) + , ApiMintBurnTransaction (..) , ApiTxId (..) , ApiTxInput (..) , ApiTxMetadata (..) @@ -455,6 +456,7 @@ import Data.Aeson ( (.=) ) import Data.ByteString ( ByteString ) +import Data.ByteArray.Encoding (convertToBase, Base(Base16)) import Data.Coerce ( coerce ) import Data.Either.Extra @@ -3712,7 +3714,7 @@ mintToken -> ArgGenChange s -> ApiT WalletId -> Api.MintTokenData n - -> Handler (ApiTransaction n) + -> Handler (ApiMintBurnTransaction n) mintToken ctx genChange (ApiT wid) body = do let pwd = coerce $ body ^. #passphrase . #getApiT let md = body ^? #metadata . traverse . #getApiT @@ -3725,7 +3727,7 @@ mintToken ctx genChange (ApiT wid) body = do ttl <- liftIO $ W.getTxExpiry ti mTTL - (sel, tx, txMeta, txTime) <- withWorkerCtx ctx wid liftE liftE $ \wrk -> do + (sel, tx, txMeta, txTime, mintBurnData) <- withWorkerCtx ctx wid liftE liftE $ \wrk -> do -- In the HD-wallet, monetary policies are associated with -- address indices under the account type "3" (MultiSigScript). -- Each address index stores the key associated with a single @@ -3758,18 +3760,37 @@ mintToken ctx genChange (ApiT wid) body = do (Just $ MintBurn.getSigningKey mintBurnData) [MintBurn.getMintBurnScript mintBurnData] liftHandler $ W.submitTx @_ @s @k wrk wid (tx, txMeta, sealedTx) - pure (sel, tx, txMeta, txTime) - - liftIO $ mkApiTransaction - (timeInterpreter $ ctx ^. networkLayer) - (txId tx) - (tx ^. #fee) - (NE.toList $ second Just <$> sel ^. #inputsSelected) - (tx ^. #outputs) - (tx ^. #withdrawals) - (txMeta, txTime) - (tx ^. #metadata) - #pendingSince + pure (sel, tx, txMeta, txTime, mintBurnData) + + liftIO $ do + txInfo <- mkApiTransaction + (timeInterpreter $ ctx ^. networkLayer) + (txId tx) + (tx ^. #fee) + (NE.toList $ second Just <$> sel ^. #inputsSelected) + (tx ^. #outputs) + (tx ^. #withdrawals) + (txMeta, txTime) + (tx ^. #metadata) + #pendingSince + + let + asBase16 :: ToText a => a -> W.Encoded 'Base16 + asBase16 = W.Encoded . convertToBase Base16 . T.encodeUtf8 . toText + + respPolicyId = MintBurn.getPolicyId mintBurnData + respAssetName = MintBurn.getAssetName mintBurnData + respAssetNameBase16 = asBase16 respAssetName + respSubject = asBase16 respPolicyId <> respAssetNameBase16 + + pure $ ApiMintBurnTransaction + { transaction = txInfo + , monetaryPolicyIndex = ApiT $ MintBurn.getMonetaryPolicyIndex mintBurnData + , policyId = ApiT respPolicyId + , assetName = ApiT respAssetName + , assetNameBase16 = ApiT respAssetNameBase16 + , subject = ApiT respSubject + } where ti :: TimeInterpreter (ExceptT PastHorizonException IO) ti = timeInterpreter (ctx ^. networkLayer) diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs index 021a64b6500..9fe89514e1f 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/lib/core/src/Cardano/Wallet/Api/Types.hs @@ -95,6 +95,7 @@ module Cardano.Wallet.Api.Types , PostTransactionFeeData (..) , PostExternalTransactionData (..) , ApiTransaction (..) + , ApiMintBurnTransaction (..) , ApiWithdrawalPostData (..) , ApiMaintenanceAction (..) , ApiMaintenanceActionPostData (..) @@ -190,6 +191,7 @@ module Cardano.Wallet.Api.Types , ApiCoinSelectionT , ApiSelectCoinsDataT , ApiTransactionT + , ApiMintBurnTransactionT , PostTransactionDataT , PostTransactionFeeDataT , ApiWalletMigrationPlanPostDataT @@ -398,6 +400,7 @@ import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 +-- import qualified Data.Vector as V import qualified Data.ByteString.Lazy as BL import qualified Data.HashMap.Strict as HM import qualified Data.Map as Map @@ -933,6 +936,16 @@ data ApiTransaction (n :: NetworkDiscriminant) = ApiTransaction } deriving (Eq, Generic, Show) deriving anyclass NFData +data ApiMintBurnTransaction (n :: NetworkDiscriminant) = ApiMintBurnTransaction + { transaction :: !(ApiTransaction n) + , monetaryPolicyIndex :: !(ApiT DerivationIndex) + , policyId :: !(ApiT W.TokenPolicyId) + , assetName :: !(ApiT W.TokenName) + , subject :: !(ApiT (W.Encoded 'Base16)) + } + deriving (Eq, Generic, Show) + deriving anyclass NFData + newtype ApiTxMetadata = ApiTxMetadata { getApiTxMetadata :: Maybe (ApiT TxMetadata) } deriving (Eq, Generic, Show) @@ -2337,6 +2350,18 @@ instance DecodeAddress t => FromJSON (PostTransactionData t) where instance EncodeAddress t => ToJSON (PostTransactionData t) where toJSON = genericToJSON defaultRecordTypeOptions +instance + ( DecodeAddress n + , DecodeStakeAddress n + ) => FromJSON (ApiMintBurnTransaction n) where + parseJSON = genericParseJSON defaultRecordTypeOptions + +instance + ( EncodeAddress n + , EncodeStakeAddress n + ) => ToJSON (ApiMintBurnTransaction n) where + toJSON = genericToJSON defaultRecordTypeOptions + instance FromJSON ApiWithdrawalPostData where parseJSON obj = parseSelfWithdrawal <|> fmap ExternalWithdrawal (parseJSON obj) @@ -2990,6 +3015,7 @@ type family ApiAddressIdT (n :: k) :: Type type family ApiCoinSelectionT (n :: k) :: Type type family ApiSelectCoinsDataT (n :: k) :: Type type family ApiTransactionT (n :: k) :: Type +type family ApiMintBurnTransactionT (n :: k) :: Type type family PostTransactionDataT (n :: k) :: Type type family MintTokenDataT (n :: k) :: Type type family PostTransactionFeeDataT (n :: k) :: Type @@ -3033,6 +3059,9 @@ type instance ApiWalletMigrationPlanPostDataT (n :: NetworkDiscriminant) = type instance ApiWalletMigrationPostDataT (n :: NetworkDiscriminant) (s :: Symbol) = ApiWalletMigrationPostData n s +type instance ApiMintBurnTransactionT (n :: NetworkDiscriminant) = + ApiMintBurnTransaction n + {------------------------------------------------------------------------------- SMASH interfacing types -------------------------------------------------------------------------------} @@ -3095,7 +3124,7 @@ instance EncodeAddress n => ToJSON (MintTokenData n) where data ApiMintBurnData (n :: NetworkDiscriminant) = ApiMintBurnData { monetaryPolicyIndex :: !(Maybe (ApiT DerivationIndex)) - , tokenName :: !(ApiT W.TokenName) + , assetName :: !(ApiT W.TokenName) , operation :: !(ApiMintBurnOperation n) } deriving (Eq, Generic, Show) @@ -3106,32 +3135,31 @@ instance EncodeAddress n => ToJSON (ApiMintBurnData n) where toJSON = genericToJSON defaultRecordTypeOptions data ApiMintBurnOperation (n :: NetworkDiscriminant) - = ApiMint (ApiMintData n) + = ApiMint (NonEmpty (ApiMintData n)) | ApiBurn ApiBurnData - | ApiMintAndBurn (ApiMintData n) ApiBurnData + | ApiMintAndBurn (NonEmpty (ApiMintData n)) ApiBurnData deriving (Eq, Generic, Show) -newtype ApiMintData (n :: NetworkDiscriminant) = ApiMintData - { mint :: [((ApiT Address, Proxy n), Quantity "assets" Natural)] +data ApiMintData (n :: NetworkDiscriminant) = ApiMintData + { receivingAddress :: (ApiT Address, Proxy n) + , amount :: Quantity "assets" Natural } deriving (Eq, Generic, Show) instance DecodeAddress n => FromJSON (ApiMintData n) where - parseJSON = fmap ApiMintData . genericParseJSON defaultRecordTypeOptions + parseJSON = genericParseJSON defaultRecordTypeOptions instance EncodeAddress n => ToJSON (ApiMintData n) where - toJSON (ApiMintData mint) = genericToJSON defaultRecordTypeOptions mint + toJSON = genericToJSON defaultRecordTypeOptions -newtype ApiBurnData = ApiBurnData - { burn :: Quantity "assets" Natural - } +newtype ApiBurnData = ApiBurnData (Quantity "assets" Natural) deriving (Eq, Generic, Show) instance FromJSON ApiBurnData where - parseJSON = fmap ApiBurnData . genericParseJSON defaultRecordTypeOptions + parseJSON = genericParseJSON defaultRecordTypeOptions instance ToJSON ApiBurnData where - toJSON (ApiBurnData burn) = genericToJSON defaultRecordTypeOptions burn + toJSON (burn) = genericToJSON defaultRecordTypeOptions burn instance EncodeAddress n => ToJSON (ApiMintBurnOperation n) where toJSON = \case @@ -3154,3 +3182,9 @@ instance DecodeAddress n => FromJSON (ApiMintBurnOperation n) where (Just mints , Nothing) -> pure $ ApiMint mints (Nothing , Just burn) -> pure $ ApiBurn burn (Just mints , Just burn) -> pure $ ApiMintAndBurn mints burn + +instance FromJSON (ApiT (W.Encoded 'Base16)) where + parseJSON = fmap ApiT . parseJSON + +instance ToJSON (ApiT (W.Encoded 'Base16)) where + toJSON = toJSON . getApiT diff --git a/lib/core/src/Cardano/Wallet/MintBurn.hs b/lib/core/src/Cardano/Wallet/MintBurn.hs index ea767890d84..47f3afbc2df 100644 --- a/lib/core/src/Cardano/Wallet/MintBurn.hs +++ b/lib/core/src/Cardano/Wallet/MintBurn.hs @@ -3,6 +3,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE OverloadedLabels #-} module Cardano.Wallet.MintBurn ( MintBurnData @@ -16,6 +17,9 @@ module Cardano.Wallet.MintBurn , getMintBurnScript , getSigningKey , tmpGetAddrMap + , getPolicyId + , getAssetName + , getMonetaryPolicyIndex ) where @@ -28,6 +32,8 @@ import Data.Proxy import Numeric.Natural ( Natural ) import Prelude +import Data.Generics.Internal.VL.Lens + ( view ) import Cardano.Address.Derivation ( XPrv ) @@ -50,7 +56,7 @@ import Cardano.Wallet.Primitive.Types.Address import Cardano.Wallet.Primitive.Types.TokenMap ( AssetId (AssetId), TokenMap ) import Cardano.Wallet.Primitive.Types.TokenPolicy - ( TokenName (..), tokenPolicyIdFromScript ) + ( TokenName (..), tokenPolicyIdFromScript, TokenPolicyId(..) ) import Cardano.Wallet.Primitive.Types.TokenQuantity ( TokenQuantity (TokenQuantity) ) import Cardano.Wallet.Primitive.Types.Tx @@ -60,7 +66,8 @@ import Data.List.NonEmpty import Data.Quantity ( Quantity, getQuantity ) -import qualified Data.Bifunctor as Bifunctor + +-- import qualified Data.Bifunctor as Bifunctor import qualified Cardano.Wallet.Api.Types as Api import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle @@ -68,14 +75,14 @@ import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap import qualified Data.List.NonEmpty as NE data MintBurnOperation - = Mint [(Address, TokenQuantity)] - | Burn TokenQuantity - | MintAndBurn [(Address, TokenQuantity)] TokenQuantity + = Mint (NonEmpty (Address, TokenQuantity)) + | Burn TokenQuantity + | MintAndBurn (NonEmpty (Address, TokenQuantity)) TokenQuantity deriving (Eq, Show) data MintBurnData dat = MintBurnData { mintBurnOperation :: MintBurnOperation - , mintBurnData:: dat + , mintBurnData :: dat } deriving (Eq, Show) @@ -86,7 +93,8 @@ data RequestData = RequestData deriving (Eq, Show) data EnrichedData key = EnrichedData - { enrichedAssetName :: TokenName + { enrichedOriginalRequest :: RequestData + , enrichedAssetName :: TokenName , enrichedKey :: key 'ScriptK XPrv , enrichedPassphrase :: Passphrase "encryption" } @@ -99,14 +107,14 @@ fromApiMintBurnData apiReq = monetaryPolicyIdx :: DerivationIndex monetaryPolicyIdx = apiReq - & Api.monetaryPolicyIndex + & view #monetaryPolicyIndex & fmap getApiT & fromMaybe (DerivationIndex 0) assetName :: TokenName assetName = apiReq - & Api.tokenName + & view #assetName & getApiT op :: MintBurnOperation @@ -126,12 +134,12 @@ fromApiMintBurnData apiReq = fromApiMintBurnOperation :: ApiMintBurnOperation (n :: NetworkDiscriminant) -> MintBurnOperation fromApiMintBurnOperation = \case - Api.ApiMint (Api.ApiMintData mints) -> - Mint $ (Bifunctor.bimap fromApiAddress fromApiQty) <$> mints + Api.ApiMint mints -> + Mint $ (\(Api.ApiMintData addr amt) -> (fromApiAddress addr, fromApiQty amt)) <$> mints Api.ApiBurn (Api.ApiBurnData burn) -> Burn $ fromApiQty burn - Api.ApiMintAndBurn (Api.ApiMintData mints) (Api.ApiBurnData burn) -> - MintAndBurn (Bifunctor.bimap fromApiAddress fromApiQty <$> mints) (fromApiQty burn) + Api.ApiMintAndBurn mints (Api.ApiBurnData burn) -> + MintAndBurn ((\(Api.ApiMintData addr amt) -> (fromApiAddress addr, fromApiQty amt)) <$> mints) (fromApiQty burn) enrich :: Functor f @@ -145,7 +153,7 @@ enrich f reqData = op = reqData & mintBurnOperation in MintBurnData op - <$> ((\(k, pwd) -> EnrichedData assetName k pwd) <$> f drvIdx) + <$> ((\(k, pwd) -> EnrichedData (mintBurnData reqData) assetName k pwd) <$> f drvIdx) enrichedScript :: WalletKey key @@ -174,9 +182,9 @@ enrichedAssetId enrichedData = getMints :: MintBurnData any -> [(Address, TokenQuantity)] getMints dat = case mintBurnOperation dat of - Mint mints -> mints + Mint mints -> NE.toList mints Burn _ -> [] - MintAndBurn mints _ -> mints + MintAndBurn mints _ -> NE.toList mints getMintBurnScript :: WalletKey key @@ -209,6 +217,22 @@ getTxOuts enrichedData = ) minting +getPolicyId + :: WalletKey key + => MintBurnData (EnrichedData key) + -> TokenPolicyId +getPolicyId = tokenPolicyIdFromScript . enrichedScript . mintBurnData + +getAssetName + :: MintBurnData (EnrichedData key) + -> TokenName +getAssetName = reqAssetName . enrichedOriginalRequest . mintBurnData + +getMonetaryPolicyIndex + :: MintBurnData (EnrichedData key) + -> DerivationIndex +getMonetaryPolicyIndex = reqMonetaryPolicyIndex . enrichedOriginalRequest . mintBurnData + tmpGetAddrMap :: WalletKey key => MintBurnData (EnrichedData key) @@ -218,8 +242,7 @@ tmpGetAddrMap enriched = assetId = enriched & mintBurnData & enrichedAssetId fm xs = case fmap (fmap (TokenMap.singleton assetId)) xs of - [] -> Nothing - t:ts -> Just $ t NE.:| ts + t NE.:| ts -> Just $ t NE.:| ts fb = Just . TokenMap.singleton assetId in diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index 0b72e5f5b30..7fd7fdf25ef 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types.hs @@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} @@ -147,6 +148,9 @@ module Cardano.Wallet.Primitive.Types , InternalState (..) , defaultInternalState + -- * Encodings + , Encoded (..) + ) where import Prelude @@ -178,11 +182,11 @@ import Control.Monad.Trans.Except import Crypto.Hash ( Blake2b_160, Digest, digestFromByteString ) import Data.Aeson - ( FromJSON (..), ToJSON (..), withObject, (.:), (.:?) ) + ( FromJSON (..), ToJSON (..), withObject, (.:), (.:?), withText ) import Data.ByteArray ( ByteArrayAccess ) import Data.ByteArray.Encoding - ( Base (Base16), convertFromBase, convertToBase ) + ( Base (Base16, Base64), convertFromBase, convertToBase ) import Data.ByteString ( ByteString ) import Data.Functor.Identity @@ -250,6 +254,7 @@ import Network.URI import Numeric.Natural ( Natural ) +import qualified Data.Aeson as Aeson import qualified Codec.Binary.Bech32 as Bech32 import qualified Codec.Binary.Bech32.TH as Bech32 import qualified Data.ByteString as BS @@ -1457,3 +1462,33 @@ instance FromJSON PoolMetadataSource where instance ToJSON PoolMetadataSource where toJSON = toJSON . toText + +-- +-- Encodings +-- + +newtype Encoded (base :: Base) = Encoded + { encodedRaw :: ByteString } + deriving (Generic, Show, Eq) + deriving anyclass NFData + +instance Semigroup (Encoded base) where + (Encoded r1) <> (Encoded r2) = Encoded $ r1 <> r2 + +instance Monoid (Encoded base) where + mempty = Encoded mempty + +instance FromJSON (Encoded 'Base16) where + parseJSON = withText "base16 bytestring" $ + either fail (pure . Encoded) . convertFromBase Base16 . T.encodeUtf8 + +instance ToJSON (Encoded 'Base16) where + toJSON = Aeson.String . T.decodeUtf8 . convertToBase Base16 . encodedRaw + +instance FromJSON (Encoded 'Base64) where + parseJSON = withText "base64 bytestring" $ + either fail (pure . Encoded) . convertFromBase Base64 . T.encodeUtf8 + +instance ToJSON (Encoded 'Base64) where + toJSON = Aeson.String . T.decodeUtf8 . convertToBase Base64 . encodedRaw + diff --git a/lib/core/src/Cardano/Wallet/TokenMetadata.hs b/lib/core/src/Cardano/Wallet/TokenMetadata.hs index 40d1e6f2ae9..59225055519 100644 --- a/lib/core/src/Cardano/Wallet/TokenMetadata.hs +++ b/lib/core/src/Cardano/Wallet/TokenMetadata.hs @@ -80,7 +80,7 @@ import Cardano.BM.Data.Tracer import Cardano.Wallet.Logging ( BracketLog (..), LoggedException (..), bracketTracer, produceTimings ) import Cardano.Wallet.Primitive.Types - ( TokenMetadataServer (..) ) + ( TokenMetadataServer (..), Encoded(..) ) import Cardano.Wallet.Primitive.Types.Hash ( Hash (..) ) import Cardano.Wallet.Primitive.Types.TokenMap @@ -125,7 +125,7 @@ import Data.Aeson.Types import Data.Bifunctor ( first ) import Data.ByteArray.Encoding - ( Base (Base16, Base64), convertFromBase, convertToBase ) + ( Base (Base16, Base64), convertToBase ) import Data.ByteString ( ByteString ) import Data.Foldable @@ -575,30 +575,14 @@ applyValidator validate = either fail pure . validate instance FromJSON Signature where parseJSON = withObject "Signature" $ \o -> Signature - <$> fmap (raw @'Base16) (o .: "signature") - <*> fmap (raw @'Base16) (o .: "publicKey") + <$> fmap (encodedRaw @'Base16) (o .: "signature") + <*> fmap (encodedRaw @'Base16) (o .: "publicKey") instance FromJSON AssetURL where parseJSON = parseJSON >=> applyValidator validateMetadataURL instance FromJSON AssetLogo where - parseJSON = fmap (AssetLogo . raw @'Base64) . parseJSON + parseJSON = fmap (AssetLogo . encodedRaw @'Base64) . parseJSON instance FromJSON AssetDecimals where parseJSON = fmap AssetDecimals . parseJSON - --- --- Helpers --- - -newtype Encoded (base :: Base) = Encoded - { raw :: ByteString } - deriving (Generic, Show, Eq) - -instance FromJSON (Encoded 'Base16) where - parseJSON = withText "base16 bytestring" $ - either fail (pure . Encoded) . convertFromBase Base16 . T.encodeUtf8 - -instance FromJSON (Encoded 'Base64) where - parseJSON = withText "base64 bytestring" $ - either fail (pure . Encoded) . convertFromBase Base64 . T.encodeUtf8 diff --git a/lib/core/test/unit/Cardano/Wallet/Api/Malformed.hs b/lib/core/test/unit/Cardano/Wallet/Api/Malformed.hs index 6b566e5f380..6a714da87aa 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/Malformed.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/Malformed.hs @@ -1766,37 +1766,145 @@ instance Malformed (BodyParam (MintTokenData ('Testnet pm))) where malformed = jsonValid ++ jsonInvalid where jsonInvalid = first BodyParam <$> - [ ("1020344", "Error in $: parsing Cardano.Wallet.Api.Types.PostTransactionData(PostTransactionData) failed, expected Object, but encountered Number") - , ("\"1020344\"", "Error in $: parsing Cardano.Wallet.Api.Types.PostTransactionData(PostTransactionData) failed, expected Object, but encountered String") - , ("{\"payments : [], \"random\"}", msgJsonInvalid) + [ ("1020344", "Error in $: parsing Cardano.Wallet.Api.Types.MintTokenData(MintTokenData) failed, expected Object, but encountered Number") + , ("\"1020344\"", "Error in $: parsing Cardano.Wallet.Api.Types.MintTokenData(MintTokenData) failed, expected Object, but encountered String") + , ("{\"mint_burn: {}, \"random\"}", msgJsonInvalid) ] - jsonValid = first (BodyParam . Aeson.encode) <$> paymentCases ++ - [ -- passphrase + jsonValid = first (BodyParam . Aeson.encode) <$> + [ ( [aesonQQ| - { "payments": [ - { - "address": #{addrPlaceholder}, - "amount": { - "quantity": 42000000, - "unit": "lovelace" - } - } - ] + { "mint_burn": { "monetary_policy_index": "not a monetary policy index" + , "asset_name": "deadbeef" + , "operation": { "mint": [ { "receiving_address": #{addrPlaceholder} + , "amount": { "unit": "assets" + , "quantity": 3 + } + } + ] + } + } + , "passphrase": "" + }|] + , "Error in $['mint_burn']['monetary_policy_index']: A derivation index must be a natural number between 0 and 2147483647 with an optional 'H' suffix (e.g. '1815H' or '44'). Indexes without suffixes are called 'Soft' Indexes with suffixes are called 'Hardened'." + ) + , ( [aesonQQ| + { "mint_burn": { "monetary_policy_index": "0" + , "asset_name": "deadbeef" + , "operation": { "mint": [ { "receiving_address": #{addrPlaceholder} + , "amount": { "unit": "assets" + , "quantity": 3 + } + } + ] + } + } + , "passphrase": #{nameTooLong} }|] - , "Error in $: parsing Cardano.Wallet.Api.Types.PostTransactionData(PostTransactionData) failed, key 'passphrase' not found" + , "Error in $.passphrase: passphrase is too long: expected at most 255 characters" ) , ( [aesonQQ| - { "payments": [ - { - "address": #{addrPlaceholder}, - "amount": { - "quantity": 42000000, - "unit": "lovelace" - } - } - ], - "passphrase": #{nameTooLong} - }|] - , "Error in $.passphrase: passphrase is too long: expected at most 255 characters" + { "mint_burn": { "monetary_policy_index": "0" + , "asset_name": "not hexadecimal" + , "operation": { "mint": [ { "receiving_address": #{addrPlaceholder} + , "amount": { "unit": "assets" + , "quantity": 3 + } + } + ] + } + } + , "passphrase": #{nameTooLong} + }|] + , "Error in $['mint_burn']['asset_name']: 'base16: input: invalid length'" + ) + , ( [aesonQQ| + { "mint_burn": { "monetary_policy_index": "0" + , "asset_name": 3 + , "operation": { "mint": [ { "receiving_address": #{addrPlaceholder} + , "amount": { "unit": "assets" + , "quantity": 3 + } + } + ] + } + } + , "passphrase": #{nameTooLong} + }|] + , "Error in $['mint_burn']['asset_name']: parsing AssetName failed, expected String, but encountered Number" + ) + , ( [aesonQQ| + { "mint_burn": { "monetary_policy_index": "0" + , "asset_name": "deadbeef" + , "operation": {} + } + , "passphrase": #{nameTooLong} + }|] + , "Error in $['mint_burn'].operation: Must include a mint or burn operation" + ) + , ( [aesonQQ| + { "mint_burn": { "monetary_policy_index": "0" + , "asset_name": "deadbeef" + , "operation": { "mint": [] } + } + , "passphrase": #{nameTooLong} + }|] + , "Error in $['mint_burn'].operation.mint: parsing NonEmpty failed, unexpected empty list" + ) + , ( [aesonQQ| + { "mint_burn": { "monetary_policy_index": "0" + , "asset_name": "deadbeef" + , "operation": { "mint": [ { "receiving_address": #{addrPlaceholder} + , "amount": { "unit": "not an asset unit" + , "quantity": 3 + } + } + ] + } + } + , "passphrase": #{nameTooLong} + }|] + , "Error in $['mint_burn'].operation.mint[0].amount: failed to parse quantified value. Expected value in 'assets' (e.g. { 'unit': 'assets', 'quantity': ... }) but got something else." + ) + , ( [aesonQQ| + { "mint_burn": { "monetary_policy_index": "0" + , "asset_name": "deadbeef" + , "operation": { "mint": [ { "receiving_address": [] + , "amount": { "unit": "assets" + , "quantity": 3 + } + } + ] + } + } + , "passphrase": #{nameTooLong} + }|] + , "Error in $['mint_burn'].operation.mint[0]['receiving_address']: parsing Text failed, expected String, but encountered Array" + ) + , ( [aesonQQ| + { "mint_burn": { "monetary_policy_index": "0" + , "asset_name": "deadbeef" + , "operation": { "burn": { "unit": "assets" + , "quantity": -1 + } + } + } + , "passphrase": #{nameTooLong} + }|] + , "Error in $['mint_burn'].operation.burn.quantity: parsing Natural failed, unexpected negative number -1" + ) + , ( [aesonQQ| + { "mint_burn": { "monetary_policy_index": "0" + , "asset_name": "deadbeef" + , "operation": { "mint": [ { "receiving_address": #{addrPlaceholder} + , "amount": { "unit": "assets" + , "quantity": -1 + } + } + ] + } + } + , "passphrase": #{nameTooLong} + }|] + , "Error in $['mint_burn'].operation.mint[0].amount.quantity: parsing Natural failed, unexpected negative number -1" ) ] diff --git a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs index a873c7a8e3d..f569f92eb5c 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs @@ -107,6 +107,7 @@ import Cardano.Wallet.Api.Types , ApiSharedWalletPatchData (..) , ApiSharedWalletPostData (..) , ApiSharedWalletPostDataFromAccountPubX (..) + , ApiMintBurnTransaction (..) , ApiSharedWalletPostDataFromMnemonics (..) , ApiSlotId (..) , ApiSlotReference (..) @@ -240,11 +241,14 @@ import Cardano.Wallet.Primitive.Types.TokenMap.Gen ( genAssetIdSmallRange, genTokenMapSmallRange, shrinkTokenMapSmallRange ) import Cardano.Wallet.Primitive.Types.TokenPolicy ( AssetDecimals (..) + , TokenName(..) , AssetLogo (..) , AssetMetadata (..) + , TokenPolicyId(..) , AssetURL (..) , TokenFingerprint , mkTokenFingerprint + , unTokenName ) import Cardano.Wallet.Primitive.Types.TokenPolicy.Gen ( genTokenNameSmallRange ) @@ -300,7 +304,7 @@ import Data.Quantity import Data.Text ( Text ) import Data.Text.Class - ( FromText (..), TextDecodingError (..) ) + ( ToText(..), FromText (..), TextDecodingError (..) ) import Data.Time.Clock ( NominalDiffTime ) import Data.Time.Clock.POSIX @@ -381,6 +385,9 @@ import Text.Regex.PCRE ( compBlank, execBlank, makeRegexOpts, matchTest ) import Web.HttpApiData ( FromHttpApiData (..) ) +import Data.ByteArray.Encoding + ( Base (Base16), convertToBase ) +import Cardano.Wallet.Primitive.Types (Encoded(..)) import qualified Cardano.Wallet.Api.Types as Api import qualified Data.Aeson as Aeson @@ -1890,7 +1897,7 @@ instance Arbitrary (ApiMintBurnData t) where <*> arbitrary instance Arbitrary (ApiMintData t) where - arbitrary = ApiMintData <$> arbitrary + arbitrary = ApiMintData <$> arbitrary <*> arbitrary instance Arbitrary ApiBurnData where arbitrary = ApiBurnData <$> arbitrary @@ -1902,6 +1909,33 @@ instance Arbitrary (ApiMintBurnOperation t) where , ApiMintAndBurn <$> arbitrary <*> arbitrary ] +instance Arbitrary (ApiMintBurnTransaction t) where + arbitrary = do + tx <- arbitrary + mpi <- arbitrary + policyId <- arbitrary + assetName <- arbitrary + let + asBase16 :: ToText a => a -> Encoded 'Base16 + asBase16 = Encoded . convertToBase Base16 . T.encodeUtf8 . toText + + assetNameEnc = Encoded $ unTokenName assetName + subject = asBase16 policyId <> assetNameEnc + + pure $ ApiMintBurnTransaction tx mpi (ApiT policyId) (ApiT assetName) (ApiT assetNameEnc) (ApiT subject) + +instance ToSchema (ApiMintBurnTransaction t) where + declareNamedSchema _ = declareSchemaForDefinition "ApiMintBurnTransaction" + +instance Arbitrary TokenPolicyId where + arbitrary = UnsafeTokenPolicyId <$> arbitrary + +instance Arbitrary (Hash "TokenPolicy") where + arbitrary = Hash . BS.pack <$> vector 28 + +instance Arbitrary TokenName where + arbitrary = UnsafeTokenName . BS.pack <$> arbitrary + instance Arbitrary (Quantity "assets" Natural) where shrink (Quantity 0) = [] shrink _ = [Quantity 0] diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs index 357becc6f1d..21712fb54af 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs @@ -577,7 +577,13 @@ genSelectionCriteria genUTxOIndex = do -- burnInputs <- pure mempty -- mintInputs <- pure mempty pure $ SelectionCriteria - { outputsToCover, utxoAvailable, extraCoinSource, selectionLimit, mintInputs, burnInputs } + { outputsToCover + , utxoAvailable + , extraCoinSource + , selectionLimit + , mintInputs + , burnInputs + } where allSpentOrBurntTokens :: NonEmpty TxOut -> TokenMap -> [(AssetId, TokenQuantity)] @@ -586,8 +592,6 @@ genSelectionCriteria genUTxOIndex = do (TokenBundle _ requestedTokens) = F.foldMap (view #tokens) outputsToCover in TokenMap.toFlatList $ burntTokens <> requestedTokens - -- TokenMap.toFlatList $ requestedTokens - -- TokenMap.toFlatList $ burntTokens availableTokensToBurn :: UTxOIndex -> NonEmpty TxOut -> [(AssetId, TokenQuantity)] availableTokensToBurn index outputsToCover =