Skip to content

Commit

Permalink
integration test - part 2
Browse files Browse the repository at this point in the history
  • Loading branch information
paweljakubas committed Aug 29, 2023
1 parent fdd411a commit 5830774
Show file tree
Hide file tree
Showing 4 changed files with 76 additions and 44 deletions.
29 changes: 13 additions & 16 deletions lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs
Original file line number Diff line number Diff line change
Expand Up @@ -721,7 +721,6 @@ import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Handler.WarpTLS as Warp



-- | Allow configuring which port the wallet server listen to in an integration
-- setup. Crashes if the variable is not a number.
walletListenFromEnv :: Show e
Expand Down Expand Up @@ -2509,10 +2508,11 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
Just action ->
transactionCtx0 { txDelegationAction = Just action }

(transactionCtx2, policyXPubM) <-
(policyXPub, _) <-
liftHandler $ W.readPolicyPublicKey wrk

transactionCtx2 <-
if isJust mintBurnData then do
(policyXPub, _) <-
liftHandler $ W.readPolicyPublicKey wrk
let isMinting (ApiMintBurnDataFromScript _ _ (ApiMint _)) = True
isMinting _ = False
let getMinting = \case
Expand Down Expand Up @@ -2553,21 +2553,18 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
map getBurning $
filter (not . isMinting) $
NE.toList $ fromJust mintBurnData
pure ( transactionCtx1
pure transactionCtx1
{ txAssetsToMint = mintingData
, txAssetsToBurn = burningData
}
, Just policyXPub)
else
pure (transactionCtx1, Nothing)

let referenceScriptM = case policyXPubM of
Just policyXPub ->
replaceCosigner
ShelleyKeyS
(Map.singleton (Cosigner 0) policyXPub)
<$> mintBurnReferenceScriptTemplate
Nothing -> Nothing
pure transactionCtx1

let referenceScriptM =
replaceCosigner
ShelleyKeyS
(Map.singleton (Cosigner 0) policyXPub)
<$> mintBurnReferenceScriptTemplate

let transactionCtx3 = transactionCtx2
{ txReferenceScript = referenceScriptM
Expand All @@ -2585,7 +2582,7 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
let mintingOuts = case mintBurnData of
Just mintBurns ->
coalesceTokensPerAddr $
map (toMintTxOut (fromJust policyXPubM)) $
map (toMintTxOut policyXPub) $
filter mintWithAddress $
NE.toList mintBurns
Nothing -> []
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -21,8 +21,6 @@ module Test.Integration.Scenario.API.Shared.Transactions

import Prelude

import Cardano.Address.Script
( KeyHash (..), Script (..) )
import Cardano.Mnemonic
( MkSomeMnemonic (..) )
import Cardano.Wallet.Address.Derivation
Expand Down Expand Up @@ -78,7 +76,11 @@ import Cardano.Wallet.Primitive.Types.Tx
import Cardano.Wallet.Primitive.Types.Tx.TxMeta
( Direction (..), TxStatus (..) )
import Cardano.Wallet.Transaction
( AnyExplicitScript (..), ScriptReference (..), WitnessCount (..) )
( AnyExplicitScript (..)
, ScriptReference (..)
, WitnessCount (..)
, changeRoleInAnyExplicitScript
)
import Control.Monad
( forM_ )
import Control.Monad.IO.Unlift
Expand Down Expand Up @@ -926,7 +928,7 @@ spec = describe "SHARED_TRANSACTIONS" $ do
-- it only is aware of its policy verification key
let noVerKeyWitnessHex = mkApiWitnessCount WitnessCount
{ verificationKey = 0
, scripts = [changeRole CA.Unknown paymentScript]
, scripts = [changeRoleInAnyExplicitScript CA.Unknown paymentScript]
, bootstrap = 0
}
let witsExp1hex =
Expand Down Expand Up @@ -964,7 +966,7 @@ spec = describe "SHARED_TRANSACTIONS" $ do
-- it only is aware of its policy verification key
let oneVerKeyWitnessHex = mkApiWitnessCount WitnessCount
{ verificationKey = 1
, scripts = [changeRole CA.Unknown paymentScript]
, scripts = [changeRoleInAnyExplicitScript CA.Unknown paymentScript]
, bootstrap = 0
}
let witsExp2hex =
Expand Down Expand Up @@ -3301,22 +3303,3 @@ spec = describe "SHARED_TRANSACTIONS" $ do
(#balance . #available . #getQuantity)
(`shouldBe` amt)
]

changeRole :: CA.KeyRole -> AnyExplicitScript -> AnyExplicitScript
changeRole role = \case
NativeExplicitScript script scriptRole ->
let changeRole' = \case
RequireSignatureOf (KeyHash _ p) ->
RequireSignatureOf $ KeyHash role p
RequireAllOf xs ->
RequireAllOf (map changeRole' xs)
RequireAnyOf xs ->
RequireAnyOf (map changeRole' xs)
RequireSomeOf m xs ->
RequireSomeOf m (map changeRole' xs)
ActiveFromSlot s ->
ActiveFromSlot s
ActiveUntilSlot s ->
ActiveUntilSlot s
in NativeExplicitScript (changeRole' script) scriptRole
PlutusExplicitScript _ _ -> error "wrong usage"
Original file line number Diff line number Diff line change
Expand Up @@ -125,6 +125,7 @@ import Cardano.Wallet.Transaction
, ScriptReference (..)
, ValidityIntervalExplicit (..)
, WitnessCount (..)
, changeRoleInAnyExplicitScript
)
import Cardano.Wallet.Unsafe
( unsafeFromHex, unsafeMkMnemonic )
Expand Down Expand Up @@ -228,6 +229,7 @@ import Test.Integration.Framework.TestData
import UnliftIO.Exception
( fromEither )

import qualified Cardano.Address.Script as CA
import qualified Cardano.Api as Cardano
import qualified Cardano.Ledger.Keys as Ledger
import qualified Cardano.Wallet.Address.Derivation.Shelley as Shelley
Expand Down Expand Up @@ -1150,17 +1152,17 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do

it "TRANS_NEW_ASSETS_CREATE_02 - using reference script" $ \ctx -> runResourceT $ do

let initialAmt = 3 * minUTxOValue (_mainEra ctx)
let initialAmt = 1_000_000_000
wa <- fixtureWalletWith @n ctx [initialAmt]
wb <- emptyWallet ctx
let amt = (minUTxOValue (_mainEra ctx) :: Natural)
let amt = 10_000_000 :: Natural

let policyWithHash = Link.getPolicyKey @'Shelley wa (Just True)
(_, policyKeyHashPayload) <-
unsafeRequest @ApiPolicyKey ctx policyWithHash Empty
let (Just policyKeyHash) =
keyHashFromBytes (Policy, getApiPolicyKey policyKeyHashPayload)
let _scriptUsed = RequireAllOf
let scriptUsed = RequireAllOf
[ RequireSignatureOf policyKeyHash
]

Expand Down Expand Up @@ -1191,6 +1193,33 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do
(Link.createUnsignedTransaction @'Shelley wa) Default payload
verify rTx expectedCreateTx

let (ApiSerialisedTransaction apiTx _) = getFromResponse #transaction rTx

signedTx <- signTx ctx wa apiTx [ expectResponseCode HTTP.status202 ]

submittedTx <- submitTxWithWid ctx wa signedTx
verify submittedTx
[ expectSuccess
, expectResponseCode HTTP.status202
]

let (ApiT txId) = getFromResponse #id submittedTx
let refInp = ReferenceInput $ TxIn txId 0
let referenceScript = NativeExplicitScript scriptUsed (ViaReferenceInput refInp)
let witnessCountWithNativeScript = mkApiWitnessCount WitnessCount
{ verificationKey = 1
, scripts = [changeRoleInAnyExplicitScript CA.Unknown referenceScript]
, bootstrap = 0
}

let decodePayload = Json (toJSON signedTx)
rTx1 <- request @(ApiDecodedTransaction n) ctx
(Link.decodeTransaction @'Shelley wa) Default decodePayload
verify rTx1
[ expectResponseCode HTTP.status202
, expectField (#witnessCount) (`shouldBe` witnessCountWithNativeScript)
]

it "TRANS_NEW_VALIDITY_INTERVAL_01a - \
\Validity interval with second" $
\ctx -> runResourceT $ do
Expand Down
25 changes: 24 additions & 1 deletion lib/wallet/src/Cardano/Wallet/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,7 @@ module Cardano.Wallet.Transaction
, TokenMapWithScripts (..)
, emptyTokenMapWithScripts
, AnyExplicitScript (..)
, changeRoleInAnyExplicitScript
, AnyScript (..)
, PlutusScriptInfo (..)
, PlutusVersion (..)
Expand All @@ -57,7 +58,7 @@ import Prelude
import Cardano.Address.Derivation
( XPrv, XPub )
import Cardano.Address.Script
( KeyHash (..), KeyRole (..), Script, ScriptHash, ScriptTemplate )
( KeyHash (..), KeyRole (..), Script (..), ScriptHash, ScriptTemplate )
import Cardano.Api
( AnyCardanoEra )
import Cardano.Api.Extra
Expand Down Expand Up @@ -348,6 +349,28 @@ data AnyExplicitScript =
deriving (Eq, Generic, Show)
deriving anyclass NFData

changeRoleInAnyExplicitScript
:: KeyRole
-> AnyExplicitScript
-> AnyExplicitScript
changeRoleInAnyExplicitScript newrole = \case
NativeExplicitScript script scriptRole ->
let changeRole' = \case
RequireSignatureOf (KeyHash _ p) ->
RequireSignatureOf $ KeyHash newrole p
RequireAllOf xs ->
RequireAllOf (map changeRole' xs)
RequireAnyOf xs ->
RequireAnyOf (map changeRole' xs)
RequireSomeOf m xs ->
RequireSomeOf m (map changeRole' xs)
ActiveFromSlot s ->
ActiveFromSlot s
ActiveUntilSlot s ->
ActiveUntilSlot s
in NativeExplicitScript (changeRole' script) scriptRole
PlutusExplicitScript _ _ -> error "wrong usage"

data WitnessCount = WitnessCount
{ verificationKey :: Word8
, scripts :: [AnyExplicitScript]
Expand Down

0 comments on commit 5830774

Please sign in to comment.