Skip to content

Commit 0555d52

Browse files
committed
Add a runner for Blockfrost test suite
1 parent cfa8af9 commit 0555d52

File tree

12 files changed

+303
-74
lines changed

12 files changed

+303
-74
lines changed

package.json

+1
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
"scripts": {
1313
"test": "npm run unit-test && npm run integration-test && npm run plutip-test && npm run staking-test",
1414
"integration-test": "spago run --main Test.Ctl.Integration",
15+
"blockfrost-test": "source ./test/blockfrost.env && spago run --main Test.Ctl.Blockfrost.Contract",
1516
"unit-test": "spago run --main Test.Ctl.Unit",
1617
"plutip-test": "spago run --main Test.Ctl.Plutip",
1718
"staking-test": "spago run --main Test.Ctl.Plutip.Staking",

src/Contract/Config.purs

+10-3
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,6 @@ module Contract.Config
1616
, mainnetNuFiConfig
1717
, module Contract.Address
1818
, module Ctl.Internal.Contract.Monad
19-
, module Ctl.Internal.Contract.QueryBackend
2019
, module Data.Log.Level
2120
, module Data.Log.Message
2221
, module Ctl.Internal.Deserialization.Keys
@@ -31,10 +30,18 @@ import Ctl.Internal.Contract.Hooks (Hooks, emptyHooks) as X
3130
import Ctl.Internal.Contract.Hooks (emptyHooks)
3231
import Ctl.Internal.Contract.Monad (ContractParams)
3332
import Ctl.Internal.Contract.QueryBackend
34-
( QueryBackendParams(CtlBackendParams, BlockfrostBackendParams)
33+
( BlockfrostBackendParams
34+
, CtlBackend
35+
, CtlBackendParams
36+
, QueryBackend(BlockfrostBackend, CtlBackend)
37+
, QueryBackendParams(BlockfrostBackendParams, CtlBackendParams)
38+
, defaultConfirmTxDelay
39+
, getBlockfrostBackend
40+
, getCtlBackend
3541
, mkBlockfrostBackendParams
3642
, mkCtlBackendParams
37-
)
43+
) as X
44+
import Ctl.Internal.Contract.QueryBackend (mkCtlBackendParams)
3845
import Ctl.Internal.Deserialization.Keys (privateKeyFromBytes)
3946
import Ctl.Internal.ServerConfig
4047
( Host

src/Contract/Test/Blockfrost.purs

+185
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,185 @@
1+
-- | Running Plutip test plans with Blockfrost
2+
module Contract.Test.Blockfrost
3+
( BlockfrostKeySetup
4+
, runPlutipTestsWithBlockfrost
5+
, executePlutipTestsWithBlockfrost
6+
) where
7+
8+
import Prelude
9+
10+
import Contract.Config
11+
( BlockfrostBackendParams
12+
, ContractParams
13+
, CtlBackendParams
14+
, PrivatePaymentKeySource(PrivatePaymentKeyFile)
15+
, PrivateStakeKeySource(PrivateStakeKeyFile)
16+
, QueryBackendParams(BlockfrostBackendParams)
17+
, ServerConfig
18+
, WalletSpec(UseKeys)
19+
)
20+
import Contract.Test.Mote (TestPlanM, interpretWithConfig)
21+
import Contract.Test.Plutip (PlutipTest, runPlutipTestsWithKeyDir)
22+
import Control.Monad.Error.Class (liftMaybe)
23+
import Ctl.Internal.Test.E2E.Runner (readBoolean)
24+
import Data.Maybe (Maybe(Just, Nothing), isNothing, maybe)
25+
import Data.Number as Number
26+
import Data.Time.Duration (Seconds(Seconds))
27+
import Data.UInt as UInt
28+
import Effect (Effect)
29+
import Effect.Aff (Aff)
30+
import Effect.Class (liftEffect)
31+
import Effect.Console as Console
32+
import Effect.Exception (error, throw)
33+
import Node.Process (lookupEnv)
34+
import Test.Spec.Runner (Config)
35+
36+
-- | All parameters that are needed to run Plutip-style tests using
37+
-- | Blockfrost API.
38+
-- |
39+
-- | Includes:
40+
-- |
41+
-- | - Private payment and (optionally) stake keys
42+
-- | - A directory to store temporary private keys that will be used in tests.
43+
-- | In case of a suddent test interruption, funds will not be lost since
44+
-- | the private keys will be saved to files.
45+
type BlockfrostKeySetup =
46+
{ privateKeySources ::
47+
{ payment :: PrivatePaymentKeySource
48+
, stake :: Maybe PrivateStakeKeySource
49+
}
50+
, testKeysDirectory :: String
51+
}
52+
53+
-- | A function that interprets a Plutip test plan into an `Aff`, given a
54+
-- | pre-funded address and a Blockfrost API endpoint.
55+
-- |
56+
-- | Accepts:
57+
-- |
58+
-- | 1. Runtime parameters for `Contract`
59+
-- | 2. Parameters for Blockfrost backend
60+
-- | 3. Optional parameters for CTL backend if it should be used
61+
-- | 4. Key setup parameters - keys are used to provide funds to the test suite.
62+
-- | Create the keys using [this guide](https://developers.cardano.org/docs/stake-pool-course/handbook/keys-addresses/)
63+
-- | and fund them using the test ADA faucet: https://docs.cardano.org/cardano-testnet/tools/faucet
64+
-- | 5. A test suite to run.
65+
-- |
66+
-- | Note that this function does not start a Plutip cluster. Instead, it
67+
-- | substitutes it with Blockfrost.
68+
-- |
69+
-- | **If you are using a paid Blockfrost plan**, be careful with what you run with
70+
-- | this function.
71+
-- |
72+
-- | Avoid moving the funds around too much using `withWallets`
73+
-- | in the tests to save on both time and costs.
74+
runPlutipTestsWithBlockfrost
75+
:: ContractParams
76+
-> BlockfrostBackendParams
77+
-> Maybe CtlBackendParams
78+
-> BlockfrostKeySetup
79+
-> TestPlanM PlutipTest Unit
80+
-> TestPlanM (Aff Unit) Unit
81+
runPlutipTestsWithBlockfrost
82+
contractParams
83+
backendParams
84+
mbCtlBackendParams
85+
{ privateKeySources, testKeysDirectory }
86+
suite =
87+
runPlutipTestsWithKeyDir
88+
config
89+
testKeysDirectory
90+
suite
91+
where
92+
config =
93+
contractParams
94+
{ backendParams = BlockfrostBackendParams backendParams mbCtlBackendParams
95+
, walletSpec = Just $ UseKeys privateKeySources.payment
96+
privateKeySources.stake
97+
}
98+
99+
-- | Reads environment variables containing Blockfrost test suite configuration
100+
-- | and runs a given test suite using `runPlutipTestsWithBlockfrost`.
101+
executePlutipTestsWithBlockfrost
102+
:: Config
103+
-> ContractParams
104+
-> Maybe CtlBackendParams
105+
-> TestPlanM PlutipTest Unit
106+
-> Aff Unit
107+
executePlutipTestsWithBlockfrost
108+
testConfig
109+
contractParams
110+
mbCtlBackendParams
111+
suite = do
112+
blockfrostApiKey <- liftEffect $
113+
lookupEnv "BLOCKFROST_API_KEY" <#> notEmptyString
114+
when (isNothing blockfrostApiKey) do
115+
liftEffect $ Console.warn $
116+
"Warning: BLOCKFROST_API_KEY is not set. " <>
117+
"If you are using a public instance, the tests will fail"
118+
privatePaymentKeyFile <-
119+
getEnvVariable "PRIVATE_PAYMENT_KEY_FILE"
120+
"Please specify a payment key file"
121+
mbPrivateStakeKeyFile <- liftEffect $
122+
lookupEnv "PRIVATE_STAKE_KEY_FILE" <#> notEmptyString
123+
confirmTxDelay <- liftEffect $
124+
lookupEnv "TX_CONFIRMATION_DELAY_SECONDS" >>= parseConfirmationDelay
125+
when (confirmTxDelay < Just (Seconds 20.0)) do
126+
liftEffect $ Console.warn $
127+
"Warning: It is recommended to set TX_CONFIRMATION_DELAY_SECONDS to at "
128+
<> "least 20 seconds to let the changes propagate after transaction "
129+
<> "submission."
130+
testKeysDirectory <- getEnvVariable "BACKUP_KEYS_DIR"
131+
"Please specify a directory to store temporary private keys in"
132+
blockfrostConfig <- liftEffect $ readBlockfrostServerConfig
133+
let
134+
backendParams =
135+
{ blockfrostConfig
136+
, blockfrostApiKey
137+
, confirmTxDelay
138+
}
139+
interpretWithConfig testConfig $
140+
runPlutipTestsWithBlockfrost contractParams backendParams mbCtlBackendParams
141+
{ privateKeySources:
142+
{ payment: PrivatePaymentKeyFile privatePaymentKeyFile
143+
, stake: PrivateStakeKeyFile <$> mbPrivateStakeKeyFile
144+
}
145+
, testKeysDirectory
146+
}
147+
suite
148+
where
149+
getEnvVariable :: String -> String -> Aff String
150+
getEnvVariable variable text = liftEffect do
151+
res <- notEmptyString <$> lookupEnv variable >>= case _ of
152+
Nothing -> throw $ text <> " (" <> variable <> ")"
153+
Just result -> pure result
154+
pure res
155+
156+
-- Treat env variables set to "" as empty
157+
notEmptyString :: Maybe String -> Maybe String
158+
notEmptyString =
159+
case _ of
160+
Just "" -> Nothing
161+
other -> other
162+
163+
parseConfirmationDelay :: Maybe String -> Effect (Maybe Seconds)
164+
parseConfirmationDelay =
165+
notEmptyString >>> maybe (pure Nothing) \str ->
166+
case Number.fromString str of
167+
Nothing -> liftEffect $ throw
168+
"TX_CONFIRMATION_DELAY_SECONDS must be set to a valid number"
169+
Just number -> pure $ Just $ Seconds number
170+
171+
readBlockfrostServerConfig :: Effect ServerConfig
172+
readBlockfrostServerConfig = do
173+
port <- lookupEnv "BLOCKFROST_PORT" >>= \mbPort ->
174+
liftMaybe (error "Unable to read BLOCKFROST_PORT environment variable")
175+
(mbPort >>= UInt.fromString)
176+
host <- lookupEnv "BLOCKFROST_HOST" >>=
177+
liftMaybe (error "Unable to read BLOCKFROST_HOST")
178+
secure <- lookupEnv "BLOCKFROST_SECURE" >>= \mbSecure ->
179+
liftMaybe
180+
( error
181+
"Unable to read BLOCKFROST_SECURE ('true' - use HTTPS, 'false' - use HTTP)"
182+
)
183+
(mbSecure >>= readBoolean)
184+
path <- lookupEnv "BLOCKFROST_PATH"
185+
pure { port, host, secure, path }

src/Contract/Test/Plutip.purs

+1-1
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ import Ctl.Internal.Plutip.Server
1313
( PlutipTest
1414
, noWallet
1515
, runPlutipContract
16-
, testContractsInEnv
16+
, runPlutipTestsWithKeyDir
1717
, withPlutipContractEnv
1818
, withWallets
1919
) as X

src/Internal/Contract/Monad.purs

+4-3
Original file line numberDiff line numberDiff line change
@@ -341,12 +341,13 @@ withContractEnv params action = do
341341
-- ContractParams
342342
--------------------------------------------------------------------------------
343343

344-
-- | Options to construct a `ContractEnv` indirectly.
344+
-- | Options to construct an environment for a `Contract` to run.
345+
-- |
346+
-- | See `Contract.Config` for pre-defined values for testnet and mainnet.
345347
-- |
346348
-- | Use `runContract` to run a `Contract` within an implicity constructed
347349
-- | `ContractEnv` environment, or use `withContractEnv` if your application
348-
-- | contains multiple contracts that can be run in parallel, reusing the same
349-
-- | environment (see `withContractEnv`)
350+
-- | contains multiple contracts that can reuse the same environment.
350351
type ContractParams =
351352
{ backendParams :: QueryBackendParams
352353
, networkId :: NetworkId

src/Internal/Plutip/Server.purs

+8-5
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ module Ctl.Internal.Plutip.Server
99
, testPlutipContracts
1010
, withWallets
1111
, noWallet
12-
, testContractsInEnv
12+
, runPlutipTestsWithKeyDir
1313
, PlutipTest
1414
) where
1515

@@ -189,17 +189,20 @@ withPlutipContractEnv plutipCfg distr cont = do
189189
$ liftEither >=> \{ env, wallets, printLogs } ->
190190
whenError printLogs (cont env wallets)
191191

192-
-- | Run `PlutipTest`s with an existing `ContractEnv`, not necessarily one
193-
-- | created through `Plutip`.
192+
-- | Run `PlutipTest`s given `ContractParams` value, not necessarily containing
193+
-- | references to runtime services started with Plutip.
194+
-- | This function can be used to interpret `TestPlanM PlutipTest` in any
195+
-- | environment.
196+
-- |
194197
-- | Tests are funded by the wallet in the supplied environment.
195198
-- | The `FilePath` parameter should point to a directory to store generated
196199
-- | wallets, in the case where funds failed to be returned to the main wallet.
197-
testContractsInEnv
200+
runPlutipTestsWithKeyDir
198201
:: ContractParams
199202
-> FilePath
200203
-> TestPlanM PlutipTest Unit
201204
-> TestPlanM (Aff Unit) Unit
202-
testContractsInEnv params backup = mapTest \(PlutipTest runPlutipTest) ->
205+
runPlutipTestsWithKeyDir params backup = mapTest \(PlutipTest runPlutipTest) ->
203206
runPlutipTest \distr mkTest -> withContractEnv params \env -> do
204207
let
205208
distrArray :: Array (Array UtxoAmount)

src/Internal/Test/E2E/Runner.purs

+1
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
module Ctl.Internal.Test.E2E.Runner
33
( runE2ECommand
44
, runE2ETests
5+
, readBoolean
56
) where
67

78
import Prelude

src/Internal/Wallet/KeyFile.purs

+14-3
Original file line numberDiff line numberDiff line change
@@ -33,24 +33,35 @@ import Ctl.Internal.Wallet.Key
3333
( PrivatePaymentKey(PrivatePaymentKey)
3434
, PrivateStakeKey(PrivateStakeKey)
3535
)
36+
import Data.Either (either)
3637
import Data.Maybe (Maybe(Nothing))
3738
import Data.Newtype (wrap)
38-
import Effect.Aff (Aff)
39+
import Effect.Aff (Aff, try)
3940
import Effect.Class (liftEffect)
40-
import Effect.Exception (error)
41+
import Effect.Exception (error, throw)
4142
import Node.Encoding as Encoding
4243
import Node.FS.Sync (readTextFile, writeTextFile)
4344
import Node.Path (FilePath)
4445

4546
keyFromFile :: FilePath -> TextEnvelopeType -> Aff ByteArray
46-
keyFromFile filePath ty = do
47+
keyFromFile filePath ty = errorHandler do
4748
fileContents <- liftEffect $ readTextFile Encoding.UTF8 filePath
4849
let errorMsg = error "Error while decoding key"
4950
liftMaybe errorMsg do
5051
TextEnvelope envelope <- decodeTextEnvelope fileContents
5152
-- Check TextEnvelope type match to desirable
5253
unless (envelope.type_ == ty) Nothing
5354
pure envelope.bytes
55+
where
56+
errorHandler action = do
57+
try action >>= either
58+
( \err -> do
59+
liftEffect $ throw $
60+
"Unable to load key from file: " <> show filePath
61+
<> ", error: "
62+
<> show err
63+
)
64+
pure
5465

5566
privatePaymentKeyFromTextEnvelope :: TextEnvelope -> Maybe PrivatePaymentKey
5667
privatePaymentKeyFromTextEnvelope (TextEnvelope envelope) = do

test-data/keys/.gitkeep

Whitespace-only changes.

test/Blockfrost.purs

-1
Original file line numberDiff line numberDiff line change
@@ -218,4 +218,3 @@ fixture4 = UnconfirmedTx
218218
{ hash: TransactionHash $ hexToByteArrayUnsafe
219219
"deadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeefdeadbeef"
220220
}
221-

0 commit comments

Comments
 (0)