Add tests for the application http API

.buildkite/pipeline.yml

@@ -55,6 +55,15 @@ steps:
     env:
       TMPDIR: "/cache"
 
+  - label: Run local-cluster tests
+    key: local-cluster-tests
+    depends_on: linux-nix
+    command: nix shell .#local-cluster -c cabal test -O0 local-cluster
+    agents:
+      system: ${linux}
+    env:
+      TMPDIR: "/cache"
+
   - label: "Babbage integration tests (linux)"
     key: linux-tests-integration-babbage
     depends_on: linux-nix

justfile

@@ -46,6 +46,9 @@ unit-tests-cabal-match match:
     -O0 -v0 \
     --test-options '--match="{{match}}"'
 
+unit-tests-local-cluster-match match:
+    nix shell '.#local-cluster' 'nixpkgs#just' \
+    -c just unit-tests-cabal-match {{match}}
 # run unit tests
 unit-tests-cabal:
     just unit-tests-cabal-match ""

lib/launcher/src/Cardano/Launcher.hs

@@ -65,6 +65,9 @@ import Data.Text
 import Data.Text.Class
     ( ToText (..)
     )
+import Data.Text.Lazy.Builder
+    ( toLazyText
+    )
 import Fmt
     ( Buildable (..)
     , Builder
@@ -124,6 +127,7 @@ import UnliftIO.Process
     )
 
 import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
 
 -- | Represent a command to execute. Args are provided as a list where options
 -- are expected to be prefixed with `--` or `-`. For example:
@@ -149,7 +153,7 @@ data Command = Command
     } deriving (Generic)
 
 instance Show Command where
-    show = show . build
+    show = TL.unpack . toLazyText . build
 
 instance Eq Command where
     a == b = build a == build b

lib/local-cluster/exe/local-cluster.hs

@@ -5,15 +5,20 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLabels #-}
+{-# HLINT ignore "Use newtype instead of data" #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
 import Prelude
 
 import Cardano.Address.Style.Shelley
     ( shelleyTestnet
     )
-import Cardano.BM.Extra
-    ( stdoutTextTracer
+import Cardano.BM.Tracing
+    ( HasSeverityAnnotation (..)
+    , Severity
     )
 import Cardano.Launcher.Node
     ( nodeSocketFile
@@ -63,6 +68,11 @@ import Control.Exception
 import Control.Lens
     ( over
     )
+import Control.Monad
+    ( forever
+    , unless
+    , (>=>)
+    )
 import Control.Monad.Cont
     ( ContT (..)
     , evalContT
@@ -74,8 +84,17 @@ import Control.Tracer
     ( Tracer (..)
     , traceWith
     )
+import Data.Text
+    ( Text
+    )
 import Data.Text.Class
-    ( ToText
+    ( ToText (..)
+    )
+import Data.Time
+    ( getCurrentTime
+    )
+import Data.Time.Format.ISO8601
+    ( iso8601Show
     )
 import Main.Utf8
     ( withUtf8
@@ -86,17 +105,34 @@ import System.Directory
 import System.Environment.Extended
     ( isEnvSet
     )
+import System.IO.Extra
+    ( BufferMode (NoBuffering)
+    , IOMode (..)
+    , hSetBuffering
+    , stdout
+    , withFile
+    , withTempFile
+    )
 import System.IO.Temp.Extra
     ( SkipCleanup (..)
     , withSystemTempDir
     )
 import System.Path
     ( absDir
+    , absFile
     , parse
     , relDir
     , relFile
     , (</>)
     )
+import UnliftIO
+    ( async
+    , atomically
+    , link
+    , newTChanIO
+    , readTChan
+    , writeTChan
+    )
 import UnliftIO.Concurrent
     ( threadDelay
     )
@@ -105,6 +141,8 @@ import qualified Cardano.Node.Cli.Launcher as NC
 import qualified Cardano.Wallet.Cli.Launcher as WC
 import qualified Cardano.Wallet.Faucet as Faucet
 import qualified Cardano.Wallet.Launch.Cluster as Cluster
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
 
 -- |
 -- # OVERVIEW
@@ -223,6 +261,35 @@ import qualified Cardano.Wallet.Launch.Cluster as Cluster
 -- - 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.
+data AnyTextTracer
+    = AnyTextTracer
+        (forall a. (HasSeverityAnnotation a, ToText a) => Tracer IO a)
+
+newAnyTextTracer
+    :: Maybe (FileOf a)
+    -> Maybe Severity
+    -> ContT r IO AnyTextTracer
+newAnyTextTracer clusterLogs minSeverity = do
+    ch <- newTChanIO
+    h <- case clusterLogs of
+        Nothing -> pure stdout
+        Just (FileOf logFile) -> do
+            ContT $ withFile (toFilePath logFile) WriteMode
+    liftIO $ hSetBuffering h NoBuffering
+    liftIO $ async >=> link $ forever $ do
+        (x, s, t) <- atomically $ readTChan ch
+        T.hPutStrLn h
+            $ T.pack (iso8601Show t)
+                <> " ["
+                <> T.pack (show s)
+                <> "] "
+                <> x
+    pure $ AnyTextTracer $ Tracer $ \msg -> do
+        let severity = getSeverityAnnotation msg
+        unless (Just severity < minSeverity) $ do
+            t <- getCurrentTime
+            atomically $ writeTChan ch (toText msg, severity, t)
+
 main :: IO ()
 main = withUtf8 $ do
     -- Handle SIGTERM properly
@@ -232,8 +299,6 @@ main = withUtf8 $ do
     setDefaultFilePermissions
 
     skipCleanup <- SkipCleanup <$> isEnvSet "NO_CLEANUP"
-    let tr :: ToText a => Tracer IO a
-        tr = stdoutTextTracer
     clusterEra <- Cluster.clusterEraFromEnv
     cfgNodeLogging <-
         Cluster.logFileConfigFromEnv
@@ -246,9 +311,14 @@ main = withUtf8 $ do
         , clusterLogs
         , nodeToClientSocket
         , monitoring
+        , minSeverity
         } <-
         parseCommandLineOptions
     evalContT $ do
+        AnyTextTracer tr <- newAnyTextTracer clusterLogs minSeverity
+
+        let traceText = liftIO . traceWith @_ @Text tr
+        traceText "Starting the local cluster"
         -- Create a temporary directory for the cluster
         clusterPath <-
             case clusterDir of
@@ -257,6 +327,9 @@ main = withUtf8 $ do
                     fmap (DirOf . absDir)
                         $ ContT
                         $ withSystemTempDir tr "test-cluster" skipCleanup
+        socketPath <- case nodeToClientSocket of
+            Just path -> pure path
+            Nothing -> FileOf . absFile <$> ContT withTempFile
         let clusterCfg =
                 Cluster.Config
                     { cfgStakePools = Cluster.defaultPoolConfigs
@@ -266,11 +339,11 @@ main = withUtf8 $ do
                     , cfgClusterConfigs = clusterConfigsDir
                     , cfgTestnetMagic = Cluster.TestnetMagic 42
                     , cfgShelleyGenesisMods = [over #sgSlotLength \_ -> 0.2]
-                    , cfgTracer = stdoutTextTracer
+                    , cfgTracer = tr
                     , cfgNodeOutputFile = Nothing
                     , cfgRelayNodePath = mkRelDirOf "relay"
                     , cfgClusterLogFile = clusterLogs
-                    , cfgNodeToClientSocket = nodeToClientSocket
+                    , cfgNodeToClientSocket = socketPath
                     }
         (_, phaseTracer) <- withSNetworkId (NTestnet 42)
             $ \network -> do
@@ -282,13 +355,15 @@ main = withUtf8 $ do
                     tr
                     monitoring
         -- Start the faucet
+        traceText "Starting the faucet"
         faucetClientEnv <- ContT withFaucet
+        traceText "Funding the faucet"
         maryAllegraFunds <-
             liftIO
                 $ runFaucetM faucetClientEnv
                 $ Faucet.maryAllegraFunds (Coin 10_000_000) shelleyTestnet
         -- Start the cluster
-
+        traceText "Starting the cluster"
         node <-
             ContT
                 $ Cluster.withCluster
@@ -298,6 +373,7 @@ main = withUtf8 $ do
                         , maryAllegraFunds
                         , massiveWalletFunds = []
                         }
+        traceText "Starting the relay node"
         nodeSocket <-
             case parse . nodeSocketFile
                 $ Cluster.runningNodeSocketPath node of
@@ -321,7 +397,7 @@ main = withUtf8 $ do
                             $ clusterDirPath
                                 </> relFile "byron-genesis.json"
                     }
-
+        traceText "Starting the wallet"
         (_walletInstance, _walletApi) <-
             ContT $ bracket (WC.start walletProcessConfig) (WC.stop . fst)
         liftIO

lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/CommandLine.hs

@@ -11,6 +11,10 @@ where
 
 import Prelude
 
+import qualified Cardano.BM.Data.Severity as Severity
+import Cardano.BM.Tracing
+    ( Severity
+    )
 import Cardano.Wallet.Launch.Cluster.FileOf
     ( Absolutizer (..)
     , DirOf (..)
@@ -55,7 +59,8 @@ data CommandLineOptions = CommandLineOptions
     { clusterConfigsDir :: DirOf "cluster-configs"
     , clusterDir :: Maybe (DirOf "cluster")
     , clusterLogs :: Maybe (FileOf "cluster-logs")
-    , nodeToClientSocket :: FileOf "node-to-client-socket"
+    , minSeverity :: Maybe Severity
+    , nodeToClientSocket :: Maybe (FileOf "node-to-client-socket")
     , monitoring :: MonitorConfiguration
     }
     deriving stock (Show)
@@ -69,12 +74,36 @@ parseCommandLineOptions = do
                 <$> clusterConfigsDirParser absolutizer
                 <*> clusterDirParser absolutizer
                 <*> clusterLogsParser absolutizer
+                <*> minSeverityParser
                 <*> nodeToClientSocketParser absolutizer
                 <*> monitoringParser
                 <**> helper
             )
             (progDesc "Local Cluster for testing")
 
+minSeverityParser :: Parser (Maybe Severity)
+minSeverityParser =
+    optional
+        $ option
+            parse
+            ( long "min-severity"
+                <> metavar "MIN_SEVERITY"
+                <> help "Minimum severity level for logging"
+            )
+  where
+    parse = do
+        s :: String <- auto
+        case s of
+            "Debug" -> pure Severity.Debug
+            "Info" -> pure Severity.Info
+            "Notice" -> pure Severity.Notice
+            "Warning" -> pure Severity.Warning
+            "Error" -> pure Severity.Error
+            "Critical" -> pure Severity.Critical
+            "Alert" -> pure Severity.Alert
+            "Emergency" -> pure Severity.Emergency
+            _ -> fail "Invalid severity level"
+
 monitoringParser :: Parser MonitorConfiguration
 monitoringParser =
     mkMonitorConfiguration
@@ -126,14 +155,17 @@ httpApiPortParser = do
 validPorts :: [PortNumber]
 validPorts = [1024 .. 65535]
 
-nodeToClientSocketParser :: Absolutizer -> Parser (FileOf "node-to-client-socket")
+nodeToClientSocketParser
+    :: Absolutizer
+    -> Parser (Maybe (FileOf "node-to-client-socket"))
 nodeToClientSocketParser (Absolutizer absOf) =
-    FileOf . absOf . absRel
-        <$> strOption
-            ( long "socket-path"
-                <> metavar "NODE_TO_CLIENT_SOCKET"
-                <> help "Path to the node-to-client socket"
-            )
+    optional
+        $ FileOf . absOf . absRel
+            <$> strOption
+                ( long "socket-path"
+                    <> metavar "NODE_TO_CLIENT_SOCKET"
+                    <> help "Path to the node-to-client socket"
+                )
 
 clusterConfigsDirParser :: Absolutizer -> Parser (DirOf "cluster-configs")
 clusterConfigsDirParser (Absolutizer absOf) =

lib/local-cluster/lib/Cardano/Wallet/Launch/Cluster/Monitoring/Http/Logging.hs

@@ -8,6 +8,12 @@ where
 
 import Prelude
 
+import Cardano.BM.Data.Tracer
+    ( HasSeverityAnnotation (getSeverityAnnotation)
+    )
+import Cardano.BM.Tracing
+    ( Severity (..)
+    )
 import Cardano.Wallet.Launch.Cluster.Monitoring.Http.Client
     ( MsgClient
     )
@@ -45,3 +51,13 @@ instance ToText MsgHttpMonitoring where
             "HTTP monitoring client stopped"
         MsgHttpMonitoringDone ->
             "HTTP monitoring done"
+
+instance HasSeverityAnnotation MsgHttpMonitoring where
+    getSeverityAnnotation = \case
+        MsgHttpMonitoringPort _ -> Info
+        MsgHttpMonitoringQuery _ -> Info
+        MsgHttpMonitoringServerStarted -> Info
+        MsgHttpMonitoringServerStopped -> Info
+        MsgHttpMonitoringClientStarted -> Info
+        MsgHttpMonitoringClientStopped -> Info
+        MsgHttpMonitoringDone -> Info