From 58d278fc0ab40710039487fc10e648dd01f6cfed Mon Sep 17 00:00:00 2001 From: paolino Date: Fri, 11 Aug 2023 12:39:11 +0000 Subject: [PATCH 1/2] Remove cardano-wallet-api-http build-depends from cardano-wallet-local-cluster sub-lib --- lib/local-cluster/lib/Service.hs | 7 +- lib/wallet/api/http/Cardano/CLI.hs | 11 + .../Cardano/Wallet/Api/Http/Shelley/Server.hs | 13 + lib/wallet/bench/latency-bench.hs | 5 +- lib/wallet/cardano-wallet.cabal | 1 - lib/wallet/exe/cardano-wallet.hs | 10 +- lib/wallet/exe/local-cluster.hs | 314 ------------------ .../local-cluster/Cardano/Wallet/Launch.hs | 44 +-- .../Cardano/Wallet/Launch/Cluster.hs | 47 ++- .../integration/shelley-integration-test.hs | 26 +- 10 files changed, 99 insertions(+), 379 deletions(-) delete mode 100644 lib/wallet/exe/local-cluster.hs diff --git a/lib/local-cluster/lib/Service.hs b/lib/local-cluster/lib/Service.hs index 7819bfe1fb1..c86659cc8f7 100644 --- a/lib/local-cluster/lib/Service.hs +++ b/lib/local-cluster/lib/Service.hs @@ -27,6 +27,8 @@ import Cardano.CLI ) import Cardano.Startup ( installSignalHandlers, setDefaultFilePermissions, withUtf8Encoding ) +import Cardano.Wallet.Api.Http.Shelley.Server + ( walletListenFromEnv ) import Cardano.Wallet.Faucet ( byronIntegrationTestFunds , genRewardAccounts @@ -36,7 +38,7 @@ import Cardano.Wallet.Faucet , shelleyIntegrationTestFunds ) import Cardano.Wallet.Launch - ( withSystemTempDir ) + ( envFromText, withSystemTempDir ) import Cardano.Wallet.Launch.Cluster ( ClusterLog (..) , Credential (..) @@ -46,7 +48,6 @@ import Cardano.Wallet.Launch.Cluster , oneMillionAda , testMinSeverityFromEnv , tokenMetadataServerFromEnv - , walletListenFromEnv , walletMinSeverityFromEnv , withCluster ) @@ -231,7 +232,7 @@ main = withLocalClusterSetup $ \dir clusterLogs walletLogs -> let tracers = setupTracers (tracerSeverities (Just Debug)) tr let db = dir "wallets" createDirectory db - listen <- walletListenFromEnv + listen <- walletListenFromEnv envFromText tokenMetadataServer <- tokenMetadataServerFromEnv prometheusUrl <- (maybe "none" diff --git a/lib/wallet/api/http/Cardano/CLI.hs b/lib/wallet/api/http/Cardano/CLI.hs index 00495bcec1a..426f13f3ecd 100644 --- a/lib/wallet/api/http/Cardano/CLI.hs +++ b/lib/wallet/api/http/Cardano/CLI.hs @@ -57,6 +57,7 @@ module Cardano.CLI , tokenMetadataSourceOption , metadataOption , timeToLiveOption + , modeOption -- * Option parsers for configuring tracing , LoggingOptions (..) @@ -72,6 +73,7 @@ module Cardano.CLI , Service , TxId , Port (..) + , Mode (..) -- * Logging , withLogging @@ -2054,3 +2056,12 @@ optionalE :: (Monoid m, Eq m) => (m -> Either e a) -> (m -> Either e (Maybe a)) optionalE parse = \case m | m == mempty -> Right Nothing m -> Just <$> parse m + +data Mode c = Normal c SyncTolerance + deriving (Show) + +modeOption :: Parser c -> Parser (Mode c) +modeOption nodeSocketOption = normalMode + where + normalMode = + Normal <$> nodeSocketOption <*> syncToleranceOption diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs index 9461060eef1..bbbbde2617f 100644 --- a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs +++ b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs @@ -132,6 +132,7 @@ module Cardano.Wallet.Api.Http.Shelley.Server -- * Logging , WalletEngineLog (..) + , walletListenFromEnv ) where @@ -660,6 +661,8 @@ import Servant ( Application, NoContent (..), err400, err404, err500, serve ) import Servant.Server ( Handler (..), runHandler ) +import System.Exit + ( die ) import System.IO.Error ( ioeGetErrorType , isAlreadyInUseError @@ -717,6 +720,16 @@ 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 + => (String -> IO (Maybe (Either e Port))) -> IO Listen +walletListenFromEnv envFromText = envFromText "CARDANO_WALLET_PORT" >>= \case + Nothing -> pure ListenOnRandomPort + Just (Right port) -> pure $ ListenOnPort port + Just (Left e) -> die $ show e + -- | How the server should listen for incoming requests. data Listen = ListenOnPort Port diff --git a/lib/wallet/bench/latency-bench.hs b/lib/wallet/bench/latency-bench.hs index 185115c2f1a..50b91f69a4f 100644 --- a/lib/wallet/bench/latency-bench.hs +++ b/lib/wallet/bench/latency-bench.hs @@ -26,6 +26,8 @@ import Cardano.Mnemonic ( Mnemonic, SomeMnemonic (..), mnemonicToText ) import Cardano.Startup ( withUtf8Encoding ) +import Cardano.Wallet.Api.Http.Shelley.Server + ( Listen (ListenOnRandomPort) ) import Cardano.Wallet.Api.Types ( ApiAddressWithPath , ApiAsset (..) @@ -58,7 +60,6 @@ import Cardano.Wallet.Launch.Cluster , LogFileConfig (..) , RunningNode (..) , defaultPoolConfigs - , walletListenFromEnv , withCluster ) import Cardano.Wallet.Logging @@ -506,7 +507,7 @@ withShelleyServer tracers action = do } onClusterStart act db (RunningNode conn block0 (np, vData) _) = do - listen <- walletListenFromEnv + let listen = ListenOnRandomPort serveWallet (NodeSource conn vData (SyncTolerance 10)) np diff --git a/lib/wallet/cardano-wallet.cabal b/lib/wallet/cardano-wallet.cabal index 4e2c5ec9cb5..693a6fad8d0 100644 --- a/lib/wallet/cardano-wallet.cabal +++ b/lib/wallet/cardano-wallet.cabal @@ -1180,7 +1180,6 @@ library cardano-wallet-local-cluster , cardano-ledger-core , cardano-ledger-shelley , cardano-wallet - , cardano-wallet-api-http , cardano-wallet-launcher , cardano-wallet-primitive , cardano-wallet-test-utils diff --git a/lib/wallet/exe/cardano-wallet.hs b/lib/wallet/exe/cardano-wallet.hs index 5099cfc82f6..5358c909285 100644 --- a/lib/wallet/exe/cardano-wallet.hs +++ b/lib/wallet/exe/cardano-wallet.hs @@ -34,6 +34,7 @@ import Cardano.BM.Trace import Cardano.CLI ( LogOutput (..) , LoggingOptions + , Mode (..) , cli , cmdAddress , cmdKey @@ -54,6 +55,7 @@ import Cardano.CLI , loggingOptions , loggingSeverityOrOffReader , loggingTracers + , modeOption , poolMetadataSourceOption , runCli , setupDirectory @@ -78,10 +80,10 @@ import Cardano.Wallet.Api.Client import Cardano.Wallet.Api.Http.Shelley.Server ( HostPreference, Listen (..), TlsConfiguration ) import Cardano.Wallet.Launch - ( Mode (Normal) + ( CardanoNodeConn , NetworkConfiguration (..) - , modeOption , networkConfigurationOption + , nodeSocketOption , parseGenesisData ) import Cardano.Wallet.Logging @@ -178,7 +180,7 @@ beforeMainLoop tr = logInfo tr . MsgListenAddress -- | Arguments for the 'serve' command data ServeArgs = ServeArgs { _hostPreference :: HostPreference - , _mode :: Mode + , _mode :: Mode CardanoNodeConn , _listen :: Listen , _tlsConfig :: Maybe TlsConfiguration , _networkConfiguration :: NetworkConfiguration @@ -197,7 +199,7 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ cmd = fmap exec $ ServeArgs <$> hostPreferenceOption - <*> modeOption + <*> modeOption nodeSocketOption <*> listenOption <*> optional tlsOption <*> networkConfigurationOption diff --git a/lib/wallet/exe/local-cluster.hs b/lib/wallet/exe/local-cluster.hs deleted file mode 100644 index ffebc4a91ba..00000000000 --- a/lib/wallet/exe/local-cluster.hs +++ /dev/null @@ -1,314 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} - -module Main where - -import Prelude - -import Cardano.BM.Data.Severity - ( Severity (..) ) -import Cardano.BM.Data.Tracer - ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) ) -import Cardano.BM.Plugin - ( loadPlugin ) -import Cardano.CLI - ( LogOutput (..) - , Port - , ekgEnabled - , getEKGURL - , getPrometheusURL - , withLoggingNamed - ) -import Cardano.Startup - ( installSignalHandlers, setDefaultFilePermissions, withUtf8Encoding ) -import Cardano.Wallet.Faucet - ( byronIntegrationTestFunds - , genRewardAccounts - , hwWalletFunds - , maryIntegrationTestAssets - , mirMnemonics - , shelleyIntegrationTestFunds - ) -import Cardano.Wallet.Launch - ( withSystemTempDir ) -import Cardano.Wallet.Launch.Cluster - ( ClusterLog (..) - , Credential (..) - , FaucetFunds (..) - , RunningNode (..) - , localClusterConfigFromEnv - , oneMillionAda - , testMinSeverityFromEnv - , tokenMetadataServerFromEnv - , walletListenFromEnv - , walletMinSeverityFromEnv - , withCluster - ) -import Cardano.Wallet.Logging - ( stdoutTextTracer, trMessageText ) -import Cardano.Wallet.Primitive.NetworkId - ( NetworkId (..), SNetworkId (..) ) -import Cardano.Wallet.Primitive.SyncProgress - ( SyncTolerance (..) ) -import Cardano.Wallet.Primitive.Types.Coin - ( Coin (..) ) -import Cardano.Wallet.Shelley - ( serveWallet, setupTracers, tracerSeverities ) -import Cardano.Wallet.Shelley.BlockchainSource - ( BlockchainSource (..) ) -import Cardano.Wallet.Shelley.Compatibility - ( decodeAddress ) -import Control.Arrow - ( first ) -import Control.Monad - ( void, when ) -import Control.Tracer - ( contramap, traceWith ) -import Data.Text - ( Text ) -import Data.Text.Class - ( ToText (..) ) -import Ouroboros.Network.Client.Wallet - ( tunedForMainnetPipeliningStrategy ) -import System.Directory - ( createDirectory ) -import System.FilePath - ( () ) - -import qualified Cardano.BM.Backend.EKGView as EKG -import qualified Data.Text as T - --- | --- # OVERVIEW --- --- This starts a cluster of Cardano nodes with: --- --- - 1 relay node --- - 1 BFT leader --- - 4 stake pools --- --- The BFT leader and pools are all fully connected. The network starts in the --- Byron Era and transitions into the Shelley era. Once in the Shelley era and --- once pools are registered and up-and-running, an instance of cardano-wallet --- is started. --- --- Pools have slightly different settings summarized in the table below: --- --- | # | Pledge | Retirement | Metadata | --- | --- | --- | --- | --- | --- | Pool #0 | 2M Ada | Never | Genesis Pool A | --- | Pool #1 | 1M Ada | Epoch 3 | Genesis Pool B | --- | Pool #2 | 1M Ada | Epoch 100_000 | Genesis Pool C | --- | Pool #3 | 1M Ada | Epoch 1_000_000 | Genesis Pool D | --- --- Pools' metadata are hosted on static local servers started alongside pools. --- --- # PRE-REGISTERED DATA --- --- The cluster also comes with a large number of pre-existing faucet wallets and --- special wallets identified by recovery phrases. Pre-registered wallets can be --- seen in --- --- `lib/wallet/src/Test/Integration/Faucet.hs`. --- --- All wallets (Byron, Icarus, Shelley) all have 10 UTxOs worth 100_000 Ada --- each (so 1M Ada in total). Additionally, the file also contains a set of --- wallets with pre-existing rewards (1M Ada) injected via MIR certificates. --- These wallets have the same UTxOs as other faucet wallets. --- --- Some additional wallets of interest: --- --- - (Shelley) Has a pre-registered stake key but no delegation. --- --- [ "over", "decorate", "flock", "badge", "beauty" --- , "stamp", "chest", "owner", "excess", "omit" --- , "bid", "raccoon", "spin", "reduce", "rival" --- ] --- --- - (Shelley) Contains only small coins (but greater than the minUTxOValue) --- --- [ "either" , "flip" , "maple" , "shift" , "dismiss" --- , "bridge" , "sweet" , "reveal" , "green" , "tornado" --- , "need" , "patient" , "wall" , "stamp" , "pass" --- ] --- --- - (Shelley) Contains 100 UTxO of 100_000 Ada, and 100 UTxO of 1 Ada --- --- [ "radar", "scare", "sense", "winner", "little" --- , "jeans", "blue", "spell", "mystery", "sketch" --- , "omit", "time", "tiger", "leave", "load" --- ] --- --- - (Byron) Has only 5 UTxOs of 1,2,3,4,5 Lovelace --- --- [ "suffer", "decorate", "head", "opera" --- , "yellow", "debate", "visa", "fire" --- , "salute", "hybrid", "stone", "smart" --- ] --- --- - (Byron) Has 200 UTxO, 100 are worth 1 Lovelace, 100 are worth 100_000 Ada. --- --- [ "collect", "fold", "file", "clown" --- , "injury", "sun", "brass", "diet" --- , "exist", "spike", "behave", "clip" --- ] --- --- - (Ledger) Created via the Ledger method for master key generation --- --- [ "struggle", "section", "scissors", "siren" --- , "garbage", "yellow", "maximum", "finger" --- , "duty", "require", "mule", "earn" --- ] --- --- - (Ledger) Created via the Ledger method for master key generation --- --- [ "vague" , "wrist" , "poet" , "crazy" , "danger" , "dinner" --- , "grace" , "home" , "naive" , "unfold" , "april" , "exile" --- , "relief" , "rifle" , "ranch" , "tone" , "betray" , "wrong" --- ] --- --- # CONFIGURATION --- --- There are several environment variables that can be set to make debugging --- easier if needed: --- --- - CARDANO_WALLET_PORT (default: random) --- choose a port for the API to listen on --- --- - CARDANO_NODE_TRACING_MIN_SEVERITY (default: Info) --- increase or decrease the logging severity of the nodes. --- --- - CARDANO_WALLET_TRACING_MIN_SEVERITY (default: Info) --- increase or decrease the logging severity of cardano-wallet. --- --- - TESTS_TRACING_MIN_SEVERITY (default: Notice) --- increase or decrease the logging severity of the test cluster framework. --- --- - LOCAL_CLUSTER_ERA (default: Mary) --- By default, the cluster will start in the latest era by enabling --- "virtual hard forks" in the node config files. --- The final era can be changed with this variable. --- --- - TOKEN_METADATA_SERVER (default: none) --- Use this URL for the token metadata server. --- --- - NO_CLEANUP (default: temp files are cleaned up) --- If set, the temporary directory used as a state directory for --- nodes and wallet data won't be cleaned up. -main :: IO () -main = withLocalClusterSetup $ \dir clusterLogs walletLogs -> - withLoggingNamed "cluster" clusterLogs $ \(_, (_, trCluster)) -> do - let tr' = contramap MsgCluster $ trMessageText trCluster - clusterCfg <- localClusterConfigFromEnv - withCluster tr' dir clusterCfg faucetFunds - (whenReady dir (trMessageText trCluster) walletLogs) - where - unsafeDecodeAddr = either (error . show) id . decodeAddress SMainnet - - faucetFunds = FaucetFunds - { pureAdaFunds = - shelleyIntegrationTestFunds - <> byronIntegrationTestFunds - <> map (first unsafeDecodeAddr) hwWalletFunds - , maFunds = - maryIntegrationTestAssets (Coin 10_000_000) - , mirFunds = - first KeyCredential - . (,Coin $ fromIntegral oneMillionAda) - <$> concatMap genRewardAccounts mirMnemonics - } - - whenReady dir trCluster logs (RunningNode socketPath block0 (gp, vData) _) = - withLoggingNamed "cardano-wallet" logs $ \(sb, (cfg, tr)) -> do - ekgEnabled >>= flip when (EKG.plugin cfg tr sb >>= loadPlugin sb) - - let tracers = setupTracers (tracerSeverities (Just Debug)) tr - let db = dir "wallets" - createDirectory db - listen <- walletListenFromEnv - tokenMetadataServer <- tokenMetadataServerFromEnv - - prometheusUrl <- (maybe "none" - (\(h, p) -> T.pack h <> ":" <> toText @(Port "Prometheus") p) - ) - <$> getPrometheusURL - ekgUrl <- (maybe "none" - (\(h, p) -> T.pack h <> ":" <> toText @(Port "EKG") p) - ) - <$> getEKGURL - - void $ serveWallet - (NodeSource socketPath vData (SyncTolerance 10)) - gp - tunedForMainnetPipeliningStrategy - NMainnet - [] - tracers - (Just db) - Nothing - "127.0.0.1" - listen - Nothing - Nothing - tokenMetadataServer - block0 - (\u -> traceWith trCluster $ MsgBaseUrl (T.pack . show $ u) - ekgUrl prometheusUrl) - --- Do all the program setup required for running the local cluster, create a --- temporary directory, log output configurations, and pass these to the given --- main action. -withLocalClusterSetup - :: (FilePath -> [LogOutput] -> [LogOutput] -> IO a) - -> IO a -withLocalClusterSetup action = do - -- Handle SIGTERM properly - installSignalHandlers (putStrLn "Terminated") - - -- Ensure key files have correct permissions for cardano-cli - setDefaultFilePermissions - - -- Set UTF-8, regardless of user locale - withUtf8Encoding $ - -- This temporary directory will contain logs, and all other data - -- produced by the local test cluster. - withSystemTempDir stdoutTextTracer "test-cluster" $ \dir -> do - let logOutputs name minSev = - [ LogToFile (dir name) (min minSev Info) - , LogToStdStreams minSev ] - - clusterLogs <- logOutputs "cluster.log" <$> testMinSeverityFromEnv - walletLogs <- logOutputs "wallet.log" <$> walletMinSeverityFromEnv - - action dir clusterLogs walletLogs - --- Logging - -data TestsLog - = MsgBaseUrl Text Text Text -- wallet url, ekg url, prometheus url - | MsgSettingUpFaucet - | MsgCluster ClusterLog - deriving (Show) - -instance ToText TestsLog where - toText = \case - MsgBaseUrl walletUrl ekgUrl prometheusUrl -> mconcat - [ "Wallet url: " , walletUrl - , ", EKG url: " , ekgUrl - , ", Prometheus url:", prometheusUrl - ] - MsgSettingUpFaucet -> "Setting up faucet..." - MsgCluster msg -> toText msg - -instance HasPrivacyAnnotation TestsLog -instance HasSeverityAnnotation TestsLog where - getSeverityAnnotation = \case - MsgSettingUpFaucet -> Notice - MsgBaseUrl {} -> Notice - MsgCluster msg -> getSeverityAnnotation msg diff --git a/lib/wallet/local-cluster/Cardano/Wallet/Launch.hs b/lib/wallet/local-cluster/Cardano/Wallet/Launch.hs index 8eadfa539ee..2859c3575bf 100644 --- a/lib/wallet/local-cluster/Cardano/Wallet/Launch.hs +++ b/lib/wallet/local-cluster/Cardano/Wallet/Launch.hs @@ -33,9 +33,6 @@ module Cardano.Wallet.Launch -- * Logging , TempDirLog (..) - -- * Light Mode - , Mode (..) - , modeOption ) where import Prelude @@ -46,8 +43,6 @@ import Cardano.BM.Data.Tracer ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) ) import Cardano.Chain.Genesis ( GenesisData (..), readGenesisData ) -import Cardano.CLI - ( optionT, syncToleranceOption ) import Cardano.Launcher ( LauncherLog ) import Cardano.Launcher.Node @@ -56,10 +51,10 @@ import Cardano.Wallet.Logging ( BracketLog, BracketLog' (..), bracketTracer ) import Cardano.Wallet.Primitive.NetworkId ( NetworkId (..) ) -import Cardano.Wallet.Primitive.SyncProgress - ( SyncTolerance ) import Cardano.Wallet.Primitive.Types ( Block (..), NetworkParameters (..) ) +import Control.Arrow + ( left ) import Control.Monad.IO.Unlift ( MonadUnliftIO, liftIO ) import Control.Monad.Trans.Except @@ -73,9 +68,19 @@ import Data.Maybe import Data.Text ( Text ) import Data.Text.Class - ( FromText (..), TextDecodingError, ToText (..) ) + ( FromText (..), TextDecodingError, ToText (..), getTextDecodingError ) import "optparse-applicative" Options.Applicative - ( Parser, eitherReader, flag', help, long, metavar, option, (<|>) ) + ( Mod + , OptionFields + , Parser + , eitherReader + , flag' + , help + , long + , metavar + , option + , (<|>) + ) import Ouroboros.Network.Magic ( NetworkMagic (..) ) import Ouroboros.Network.NodeToClient @@ -96,6 +101,14 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T +-- | Helper for writing an option 'Parser' using a 'FromText' instance. +optionT :: FromText a => Mod OptionFields a -> Parser a +optionT = option (eitherReader fromTextS) + +-- | Like 'fromText', but stringly-typed. +fromTextS :: FromText a => String -> Either String a +fromTextS = left getTextDecodingError . fromText . T.pack + -- | Shelley hard fork network configuration has two genesis data. -- As a special case for mainnet, we hardcode the byron genesis data. data NetworkConfiguration where @@ -333,16 +346,3 @@ instance HasSeverityAnnotation TempDirLog where getSeverityAnnotation = \case MsgNoCleanup _ BracketStart -> Debug MsgNoCleanup _ _ -> Notice - -{------------------------------------------------------------------------------- - Mode --------------------------------------------------------------------------------} - -data Mode = Normal CardanoNodeConn SyncTolerance - deriving (Show) - -modeOption :: Parser Mode -modeOption = normalMode - where - normalMode = - Normal <$> nodeSocketOption <*> syncToleranceOption diff --git a/lib/wallet/local-cluster/Cardano/Wallet/Launch/Cluster.hs b/lib/wallet/local-cluster/Cardano/Wallet/Launch/Cluster.hs index 6730a8338a7..8ff706068bd 100644 --- a/lib/wallet/local-cluster/Cardano/Wallet/Launch/Cluster.hs +++ b/lib/wallet/local-cluster/Cardano/Wallet/Launch/Cluster.hs @@ -39,7 +39,6 @@ module Cardano.Wallet.Launch.Cluster -- * Cluster node launcher , defaultPoolConfigs , clusterEraFromEnv - , clusterToApiEra , clusterEraToString , withSMASH @@ -51,7 +50,6 @@ module Cardano.Wallet.Launch.Cluster , walletMinSeverityFromEnv , testMinSeverityFromEnv , testLogDirFromEnv - , walletListenFromEnv , tokenMetadataServerFromEnv -- * Faucets @@ -90,8 +88,6 @@ import Cardano.BM.Data.Severity ( Severity (..) ) import Cardano.BM.Data.Tracer ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) ) -import Cardano.CLI - ( parseLoggingSeverity ) import Cardano.CLI.Shelley.Key ( VerificationKeyOrFile (..), readVerificationKeyOrFile ) import Cardano.Launcher @@ -143,10 +139,6 @@ import Cardano.Startup ( restrictFileMode ) import Cardano.Wallet.Address.Derivation ( hex ) -import Cardano.Wallet.Api.Http.Shelley.Server - ( Listen (..) ) -import Cardano.Wallet.Api.Types - ( ApiEra (..), HealthStatusSMASH (..) ) import Cardano.Wallet.Launch ( TempDirLog (..), envFromText, lookupEnvNonEmpty ) import Cardano.Wallet.Logging @@ -183,7 +175,7 @@ import Codec.Binary.Bech32.TH import Control.Arrow ( first ) import Control.Lens - ( over, set, (&), (.~) ) + ( over, set, (&), (.~), (<&>) ) import Control.Monad ( forM, forM_, liftM2, replicateM, replicateM_, void, when, (>=>) ) import Control.Retry @@ -260,6 +252,7 @@ import UnliftIO.MVar import qualified Cardano.Ledger.Address as Ledger import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Shelley.API as Ledger +import qualified Cardano.Pool.Metadata as SMASH import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap import qualified Codec.Binary.Bech32 as Bech32 @@ -301,6 +294,16 @@ logFileConfigFromEnv subdir = LogFileConfig <*> (testLogDirFromEnv subdir) <*> pure Info +-- | The lower-case names of all 'Severity' values. +loggingSeverities :: [(String, Severity)] +loggingSeverities = [(toLower <$> show s, s) | s <- [minBound .. maxBound]] + +parseLoggingSeverity :: String -> Either String Severity +parseLoggingSeverity arg = + case lookup (map toLower arg) loggingSeverities of + Just sev -> pure sev + Nothing -> Left $ "unknown logging severity: " ++ arg + minSeverityFromEnv :: Severity -> String -> IO Severity minSeverityFromEnv def var = lookupEnvNonEmpty var >>= \case Nothing -> pure def @@ -324,13 +327,6 @@ testMinSeverityFromEnv :: IO Severity testMinSeverityFromEnv = minSeverityFromEnv Notice "TESTS_TRACING_MIN_SEVERITY" --- | Allow configuring which port the wallet server listen to in an integration --- setup. Crashes if the variable is not a number. -walletListenFromEnv :: IO Listen -walletListenFromEnv = envFromText "CARDANO_WALLET_PORT" >>= \case - Nothing -> pure ListenOnRandomPort - Just (Right port) -> pure $ ListenOnPort port - Just (Left e) -> die $ show e tokenMetadataServerFromEnv :: IO (Maybe TokenMetadataServer) tokenMetadataServerFromEnv = envFromText "TOKEN_METADATA_SERVER" >>= \case @@ -837,15 +833,7 @@ data ClusterEra | BabbageHardFork deriving (Show, Read, Eq, Ord, Bounded, Enum) --- | Convert @ClusterEra@ to a @ApiEra@. -clusterToApiEra :: ClusterEra -> ApiEra -clusterToApiEra = \case - ByronNoHardFork -> ApiByron - ShelleyHardFork -> ApiShelley - AllegraHardFork -> ApiAllegra - MaryHardFork -> ApiMary - AlonzoHardFork -> ApiAlonzo - BabbageHardFork -> ApiBabbage + -- | Defaults to the latest era. clusterEraFromEnv :: IO ClusterEra @@ -1416,10 +1404,15 @@ withSMASH tr parentDir action = do let delistedPoolIds = poolId <$> NE.filter delisted defaultPoolConfigs BL8.writeFile (baseDir "delisted") - (Aeson.encode delistedPoolIds) + (Aeson.encode $ delistedPoolIds <&> + \p -> object [ "poolId" Aeson..= SMASH.poolId p] + ) -- health check - let health = Aeson.encode (HealthStatusSMASH "OK" "1.2.0") + let health = Aeson.encode $ object + [ "status" Aeson..= ("OK" :: Text) + , "version" Aeson..= ("1.2.0" :: Text) + ] BL8.writeFile (baseDir "status") health diff --git a/lib/wallet/test/integration/shelley-integration-test.hs b/lib/wallet/test/integration/shelley-integration-test.hs index 6e65d9dadfe..a6f9bdc8fcf 100644 --- a/lib/wallet/test/integration/shelley-integration-test.hs +++ b/lib/wallet/test/integration/shelley-integration-test.hs @@ -39,6 +39,10 @@ import Cardano.Startup , setDefaultFilePermissions , withUtf8Encoding ) +import Cardano.Wallet.Api.Http.Shelley.Server + ( walletListenFromEnv ) +import Cardano.Wallet.Api.Types + ( ApiEra (..) ) import Cardano.Wallet.Faucet ( byronIntegrationTestFunds , genRewardAccounts @@ -51,22 +55,21 @@ import Cardano.Wallet.Faucet import Cardano.Wallet.Faucet.Shelley ( initFaucet ) import Cardano.Wallet.Launch - ( withSystemTempDir ) + ( envFromText, withSystemTempDir ) import Cardano.Wallet.Launch.Cluster - ( ClusterLog + ( ClusterEra (..) + , ClusterLog , Credential (..) , FaucetFunds (..) , RunningNode (..) , clusterEraFromEnv , clusterEraToString - , clusterToApiEra , localClusterConfigFromEnv , moveInstantaneousRewardsTo , oneMillionAda , sendFaucetAssetsTo , testLogDirFromEnv , testMinSeverityFromEnv - , walletListenFromEnv , walletMinSeverityFromEnv , withCluster , withSMASH @@ -139,6 +142,7 @@ import UnliftIO.MVar ( newEmptyMVar, newMVar, putMVar, takeMVar, withMVar ) import qualified Cardano.BM.Backend.EKGView as EKG +import qualified Cardano.CLI as CLI import qualified Cardano.Pool.DB as Pool import qualified Cardano.Pool.DB.Sqlite as Pool import qualified Data.Text as T @@ -240,6 +244,16 @@ withTestsSetup action = do withSystemTempDir stdoutTextTracer "test" $ \testDir -> withTracers testDir $ action testDir +-- | Convert @ClusterEra@ to a @ApiEra@. +clusterToApiEra :: ClusterEra -> ApiEra +clusterToApiEra = \case + ByronNoHardFork -> ApiByron + ShelleyHardFork -> ApiShelley + AllegraHardFork -> ApiAllegra + MaryHardFork -> ApiMary + AlonzoHardFork -> ApiAlonzo + BabbageHardFork -> ApiBabbage + specWithServer :: FilePath -> (Tracer IO TestsLog, Tracers IO) @@ -270,7 +284,7 @@ specWithServer testDir (tr, tracers) = aroundAll withContext putMVar ctx $ Context { _cleanup = pure () , _manager = (baseUrl, manager) - , _walletPort = Port . fromIntegral $ portFromURL baseUrl + , _walletPort = CLI.Port . fromIntegral $ portFromURL baseUrl , _faucet = faucet , _networkParameters = np , _poolGarbageCollectionEvents = poolGarbageCollectionEvents @@ -340,7 +354,7 @@ specWithServer testDir (tr, tracers) = aroundAll withContext onClusterStart action dbDecorator (RunningNode conn block0 (gp, vData) genesisPools) = do let db = testDir "wallets" createDirectory db - listen <- walletListenFromEnv + listen <- walletListenFromEnv envFromText let testMetadata = $(getTestData) "token-metadata.json" withMetadataServer (queryServerStatic testMetadata) $ \tokenMetaUrl -> serveWallet From ff4ad329b797936ba5fc7fec9f4973b7d79b4c6d Mon Sep 17 00:00:00 2001 From: paolino Date: Fri, 11 Aug 2023 14:14:28 +0000 Subject: [PATCH 2/2] Remove hls duplicated test in CI --- scripts/buildkite/check-haskell-nix-cabal.sh | 5 ----- 1 file changed, 5 deletions(-) diff --git a/scripts/buildkite/check-haskell-nix-cabal.sh b/scripts/buildkite/check-haskell-nix-cabal.sh index c848251f704..680244dd286 100755 --- a/scripts/buildkite/check-haskell-nix-cabal.sh +++ b/scripts/buildkite/check-haskell-nix-cabal.sh @@ -13,8 +13,3 @@ echo echo "+++ Cabal configure" cabal configure --enable-tests --enable-benchmarks echo - -echo "+++ haskell-language-server" -ln -sf hie-direnv.yaml hie.yaml -haskell-language-server lib/wallet/src/Cardano/Wallet.hs -echo