-
Notifications
You must be signed in to change notification settings - Fork 211
/
Main.hs
268 lines (254 loc) · 10.5 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main where
import Prelude
import Cardano.BM.Data.Severity
( Severity (..) )
import Cardano.BM.Trace
( Trace, logInfo )
import Cardano.CLI
( LogOutput (..), Port (..), withLogging )
import Cardano.Launcher
( ProcessHasExited (..) )
import Cardano.Pool.Jormungandr.Metadata
( envVarMetadataRegistry )
import Cardano.Startup
( withUtf8Encoding )
import Cardano.Wallet.Api.Server
( Listen (..) )
import Cardano.Wallet.Api.Types
( DecodeAddress (..), EncodeAddress (..), EncodeStakeAddress (..) )
import Cardano.Wallet.Jormungandr
( serveWallet, setupTracers, tracerSeverities )
import Cardano.Wallet.Jormungandr.Compatibility
( Jormungandr )
import Cardano.Wallet.Jormungandr.Faucet
( initFaucet )
import Cardano.Wallet.Jormungandr.Launch
( withConfig )
import Cardano.Wallet.Jormungandr.Network
( JormungandrBackend (..) )
import Cardano.Wallet.Network.Ports
( unsafePortNumber )
import Cardano.Wallet.Primitive.AddressDerivation
( DelegationAddress (..)
, NetworkDiscriminant (..)
, NetworkDiscriminantVal (..)
, PaymentAddress
)
import Cardano.Wallet.Primitive.AddressDerivation.Byron
( ByronKey )
import Cardano.Wallet.Primitive.AddressDerivation.Jormungandr
( JormungandrKey )
import Cardano.Wallet.Primitive.Fee
( FeePolicy (..) )
import Cardano.Wallet.Primitive.SyncProgress
( SyncTolerance (..) )
import Cardano.Wallet.Primitive.Types
( NetworkParameters (..), ProtocolParameters (..), TxParameters (..) )
import Control.Concurrent.Async
( race )
import Control.Concurrent.MVar
( newEmptyMVar, putMVar, takeMVar )
import Control.Exception
( throwIO )
import Data.Proxy
( Proxy (..) )
import Data.Quantity
( Quantity (..) )
import Data.Text
( Text )
import Data.Tuple.Extra
( thd3 )
import Network.HTTP.Client
( defaultManagerSettings
, managerResponseTimeout
, newManager
, responseTimeoutMicro
)
import Numeric.Natural
( Natural )
import System.Environment
( setEnv )
import System.FilePath
( (</>) )
import System.IO.Temp
( withSystemTempDirectory )
import Test.Hspec
( Spec, SpecWith, after, beforeWith, describe, hspec, parallel )
import Test.Hspec.Extra
( aroundAll )
import Test.Integration.Framework.DSL
( Context (..), KnownCommand (..), TxDescription (..), tearDown )
import Test.Utils.Paths
( getTestData )
import Test.Utils.StaticServer
( withStaticServer )
import Type.Reflection
( Typeable )
import qualified Cardano.Pool.Jormungandr.MetricsSpec as MetricsSpec
import qualified Cardano.Wallet.Jormungandr.NetworkSpec as NetworkLayer
import qualified Data.Text as T
import qualified Test.Integration.Jormungandr.Scenario.API.Network as NetworkJormungandr
import qualified Test.Integration.Jormungandr.Scenario.API.StakePools as StakePoolsApiJormungandr
import qualified Test.Integration.Jormungandr.Scenario.API.Transactions as TransactionsApiJormungandr
import qualified Test.Integration.Jormungandr.Scenario.CLI.Launcher as LauncherCLI
import qualified Test.Integration.Jormungandr.Scenario.CLI.Port as PortCLIJormungandr
import qualified Test.Integration.Jormungandr.Scenario.CLI.Server as ServerCLI
import qualified Test.Integration.Jormungandr.Scenario.CLI.StakePools as StakePoolsCliJormungandr
import qualified Test.Integration.Jormungandr.Scenario.CLI.Transactions as TransactionsCliJormungandr
import qualified Test.Integration.Scenario.API.Byron.Migrations as ByronMigrations
import qualified Test.Integration.Scenario.API.Byron.Transactions as ByronTransactions
import qualified Test.Integration.Scenario.API.Byron.Wallets as ByronWallets
import qualified Test.Integration.Scenario.API.Network as Network
import qualified Test.Integration.Scenario.API.Shelley.Addresses as Addresses
import qualified Test.Integration.Scenario.API.Shelley.HWWallets as HWWallets
import qualified Test.Integration.Scenario.API.Shelley.Transactions as Transactions
import qualified Test.Integration.Scenario.API.Shelley.Wallets as Wallets
import qualified Test.Integration.Scenario.CLI.Miscellaneous as MiscellaneousCLI
import qualified Test.Integration.Scenario.CLI.Network as NetworkCLI
import qualified Test.Integration.Scenario.CLI.Port as PortCLI
import qualified Test.Integration.Scenario.CLI.Shelley.Addresses as AddressesCLI
import qualified Test.Integration.Scenario.CLI.Shelley.HWWallets as HWWalletsCLI
import qualified Test.Integration.Scenario.CLI.Shelley.Transactions as TransactionsCLI
import qualified Test.Integration.Scenario.CLI.Shelley.Wallets as WalletsCLI
-- | Define the actual executable name for the bridge CLI
instance KnownCommand Jormungandr where
commandName = "cardano-wallet-jormungandr"
main :: forall t n. (t ~ Jormungandr, n ~ 'Testnet 0) => IO ()
main = withUtf8Encoding $ withLogging [LogToStdout Info] $ \(_, tr) -> do
hspec $ do
describe "No backend required" $ do
describe "Cardano.Wallet.NetworkSpec" $ parallel NetworkLayer.spec
describe "Miscellaneous CLI tests" $ parallel (MiscellaneousCLI.spec @t)
describe "Launcher CLI tests" $ parallel (LauncherCLI.spec @t)
describe "Stake Pool Metrics" MetricsSpec.spec
describe "API Specifications" $ specWithServer @n tr $ do
withCtxOnly $ Addresses.spec @n
withCtxOnly $ Transactions.spec @n
withCtxOnly $ Wallets.spec @n
withCtxOnly $ ByronWallets.spec @n
withCtxOnly $ ByronTransactions.spec @n
withCtxOnly $ ByronMigrations.spec @n
withCtxOnly $ HWWallets.spec @n
withCtxOnly $ TransactionsApiJormungandr.spec @n @t
withCtxOnly $ TransactionsCliJormungandr.spec @n @t
withCtxOnly Network.spec
withCtxOnly NetworkJormungandr.spec
StakePoolsApiJormungandr.spec @n
describe "CLI Specifications" $ specWithServer @n tr $ do
withCtxOnly $ AddressesCLI.spec @n @t
withCtxOnly $ TransactionsCLI.spec @n @t
withCtxOnly $ WalletsCLI.spec @n @t
withCtxOnly $ HWWalletsCLI.spec @n @t
withCtxOnly $ PortCLI.spec @t
withCtxOnly $ PortCLIJormungandr.spec @t
withCtxOnly $ NetworkCLI.spec @t
withCtxOnly $ StakePoolsCliJormungandr.spec @t
ServerCLI.spec @t
where
withCtxOnly
:: SpecWith (Context Jormungandr)
-> SpecWith (Port "node", FeePolicy, Context Jormungandr)
withCtxOnly =
beforeWith (pure . thd3)
specWithServer
:: forall (n :: NetworkDiscriminant).
( NetworkDiscriminantVal n
, DecodeAddress n
, EncodeAddress n
, EncodeStakeAddress n
, DelegationAddress n JormungandrKey
, PaymentAddress n ByronKey
, Typeable n
)
=> Trace IO Text
-> SpecWith (Port "node", FeePolicy, Context Jormungandr)
-> Spec
specWithServer tr = aroundAll withContext . after (tearDown . thd3)
where
withContext action = do
ctx <- newEmptyMVar
let setupContext wAddr nPort np = do
let baseUrl = "http://" <> T.pack (show wAddr) <> "/"
logInfo tr baseUrl
let sixtySeconds = 60*1000*1000 -- 60s in microseconds
manager <- (baseUrl,) <$> newManager (defaultManagerSettings
{ managerResponseTimeout =
responseTimeoutMicro sixtySeconds
})
let feePolicy = getFeePolicy
$ txParameters
$ protocolParameters np
faucet <- initFaucet feePolicy
putMVar ctx (nPort, feePolicy, Context
{ _cleanup = pure ()
, _manager = manager
, _walletPort = Port . fromIntegral $ unsafePortNumber wAddr
, _faucet = faucet
, _feeEstimator = mkFeeEstimator feePolicy
, _networkParameters = np
, _target = Proxy
})
race
(takeMVar ctx >>= action)
(withServer setupContext)
>>= either pure (throwIO . ProcessHasExited "integration")
withServer setup =
withConfig $ \jmCfg ->
withMetadataRegistry $
withSystemTempDirectory "cardano-wallet-databases" $ \db ->
serveWallet @n
tracers
(SyncTolerance 10)
(Just db)
"127.0.0.1"
ListenOnRandomPort
(Launch jmCfg)
setup
tracers = setupTracers (tracerSeverities (Just Info)) tr
-- | Run a HTTP file server on any free port, serving up the integration tests
-- stake pool metadata registry.
withMetadataRegistry :: IO a -> IO a
withMetadataRegistry action = withStaticServer root $ \baseUrl -> do
let registryUrl = baseUrl <> "test-integration-registry.zip"
setEnv envVarMetadataRegistry registryUrl
action
where
root = $(getTestData) </> "jormungandr" </> "stake_pools" </> "registry"
-- NOTE²
-- We use a range (min, max) and call it an "estimator" because for the
-- bridge (and probably cardano-node on Jormungandr), it's not possible to
-- compute the fee precisely by only knowing the number of inputs and
-- ouputs since the exact fee cost depends on the values of the
-- outputs and the values of the input indexes.
mkFeeEstimator :: FeePolicy -> TxDescription -> (Natural, Natural)
mkFeeEstimator policy = \case
PaymentDescription nInps nOuts nChgs ->
let fee = linear (nInps + nOuts + nChgs) 0
in (fee, fee)
DelegDescription _action ->
let
feeMin = linear 0 1
feeMax = linear 2 1
in
(feeMin, feeMax)
where
LinearFee (Quantity a) (Quantity b) (Quantity c) = policy
-- NOTE¹
-- We safely round BEFORE the multiplication because we know that
-- Jormungandr' fee are necessarily naturals constants. We carry doubles
-- here because of the legacy with Byron. In the end, it matters not
-- because in the spectrum of numbers we're going to deal with, naturals
-- can be represented without any rounding issue using 'Double' (or,
-- transactions have suddenly become overly expensive o_O)
linear nb nc = fromIntegral $ round a + nb * round b + nc * round c