Skip to content

Commit

Permalink
WIP
Browse files Browse the repository at this point in the history
  • Loading branch information
@sevanspowell
sevanspowell committed Jun 10, 2021
1 parent 7d9a5ff commit b4d26c5
Show file tree
Hide file tree
Showing 10 changed files with 367 additions and 119 deletions.
42 changes: 23 additions & 19 deletions lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs
View file
Expand Up @@ -27,6 +27,7 @@ import Cardano.Wallet.Api.Types
, ApiFee (..)
, ApiT (..)
, ApiTransaction
, ApiMintBurnTransaction
, ApiTxId (..)
, ApiTxInput (..)
, ApiWallet
Expand Down Expand Up @@ -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
]
Expand All @@ -1041,65 +1042,65 @@ 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
w <- fixtureWallet ctx

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


it "TRANS_MINT_BURN_01 - Mint then burn tokens" $ \ctx -> runResourceT $ 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
]
Expand Down Expand Up @@ -1128,15 +1129,15 @@ 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" }
}
},
"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
Expand Down Expand Up @@ -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}
Expand Down
3 changes: 2 additions & 1 deletion lib/core/src/Cardano/Wallet/Api.hs
View file
Expand Up @@ -163,6 +163,7 @@ import Cardano.Wallet.Api.Types
, ApiAddressIdT
, ApiAddressInspect
, ApiAddressInspectData
, ApiMintBurnTransactionT
, ApiAddressT
, ApiAsset
, ApiByronWallet
Expand Down Expand Up @@ -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_
Expand Down
49 changes: 35 additions & 14 deletions lib/core/src/Cardano/Wallet/Api/Server.hs
View file
Expand Up @@ -225,6 +225,7 @@ import Cardano.Wallet.Api.Types
, ApiStakeKeys (..)
, ApiT (..)
, ApiTransaction (..)
, ApiMintBurnTransaction (..)
, ApiTxId (..)
, ApiTxInput (..)
, ApiTxMetadata (..)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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)
58 changes: 46 additions & 12 deletions lib/core/src/Cardano/Wallet/Api/Types.hs
View file
Expand Up @@ -95,6 +95,7 @@ module Cardano.Wallet.Api.Types
, PostTransactionFeeData (..)
, PostExternalTransactionData (..)
, ApiTransaction (..)
, ApiMintBurnTransaction (..)
, ApiWithdrawalPostData (..)
, ApiMaintenanceAction (..)
, ApiMaintenanceActionPostData (..)
Expand Down Expand Up @@ -190,6 +191,7 @@ module Cardano.Wallet.Api.Types
, ApiCoinSelectionT
, ApiSelectCoinsDataT
, ApiTransactionT
, ApiMintBurnTransactionT
, PostTransactionDataT
, PostTransactionFeeDataT
, ApiWalletMigrationPlanPostDataT
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
-------------------------------------------------------------------------------}
Expand Down Expand Up @@ -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)

Expand All @@ -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
Expand All @@ -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

0 comments on commit b4d26c5

Please sign in to comment.