Embed cardano-cli and use it to test operation of devnet

flake.nix

@@ -23,6 +23,8 @@
           pkgs.lib.trivial.pipe (self.callCabal2nix "pegasus" ./. { }) [
             # Cardano-node to build against
             (pkgs.haskell.lib.compose.addBuildTool inputs.cardano-node.packages.${system}.cardano-node)
+            # Cardano-cli to build against
+            (pkgs.haskell.lib.compose.addBuildTool inputs.cardano-node.packages.${system}.cardano-cli)
             # Don't run (integration) tests
             pkgs.haskell.lib.compose.dontCheck
           ];

pegasus.cabal

@@ -47,8 +47,8 @@ library
     Paths_pegasus
     Pegasus
     Pegasus.CardanoNode
-    Pegasus.CardanoNode.Embed
-    Pegasus.CardanoNode.EmbedTH
+    Pegasus.Embed
+    Pegasus.EmbedTH
 
   build-depends:
     , aeson
@@ -86,10 +86,12 @@ test-suite integration
   hs-source-dirs:     test
   main-is:            Main.hs
   build-depends:
-    , base           ^>=4.18.1.0
+    , base             ^>=4.18.1.0
     , bytestring
     , hspec
     , HUnit
+    , microlens
+    , microlens-aeson
     , stm
     , time
     , typed-process

src/Pegasus.hs

@@ -21,8 +21,8 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
 import Lens.Micro (at, (?~))
 import Lens.Micro.Aeson (_Object)
 import Paths_pegasus qualified as Pkg
-import Pegasus.CardanoNode (CardanoNodeArgs (..), cardanoNodeProcess, defaultCardanoNodeArgs, getCardanoNodeVersion)
-import Pegasus.CardanoNode.Embed (writeCardanoNodeTo)
+import Pegasus.CardanoNode (CardanoNodeArgs (..), cardanoNodeProcess, defaultCardanoNodeArgs, getCardanoNodeVersion, waitForSocket)
+import Pegasus.Embed (writeCardanoCliTo, writeCardanoNodeTo)
 import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, findExecutable, removeDirectoryRecursive)
 import System.Environment (getEnv, setEnv)
 import System.Exit (die)
@@ -64,11 +64,13 @@ withCardanoNodeDevnet dir cont = do
     withProcessWait cmd $ \p -> do
       -- Ensure the sub-process is also stopped when we get asked to terminate.
       _ <- installHandler sigTERM (Catch $ stopProcess p) Nothing
-      race_ (waitExitCode p >>= \ec -> die $ "cardano-node exited with: " <> show ec) $
+      race_ (waitExitCode p >>= \ec -> die $ "cardano-node exited with: " <> show ec) $ do
+        let socketPath = File $ dir </> nodeSocket
+        waitForSocket socketPath
         cont
           RunningNode
             { nodeVersion
-            , nodeSocket = File $ dir </> nodeSocket
+            , nodeSocket = socketPath
             , logFile
             , networkId = Testnet (NetworkMagic 42) -- TODO: load this from config
             , blockTime = 0.1 -- FIXME: query this
@@ -88,6 +90,8 @@ withCardanoNodeDevnet dir cont = do
   instantiateCardanoNode = do
     createDirectoryIfMissing True binDir
     writeCardanoNodeTo $ binDir </> "cardano-node"
+    -- TODO: make cli instantiation optional?
+    writeCardanoCliTo $ binDir </> "cardano-cli"
     -- NOTE: We put it into first position to ensure the cardano-node included
     -- is used (until users can pick one)
     getEnv "PATH" >>= \path -> setEnv "PATH" (binDir <> ":" <> path)

src/Pegasus/CardanoNode.hs

@@ -1,10 +1,14 @@
 module Pegasus.CardanoNode where
 
+import Cardano.Api (SocketPath, unFile)
+import Control.Concurrent (threadDelay)
+import Control.Monad (unless)
 import Data.ByteString (toStrict)
 import Data.Function ((&))
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
+import System.Directory (doesFileExist)
 import System.FilePath ((</>))
 import System.Process.Typed (ProcessConfig, proc, readProcessStdout_, setWorkingDir)
 
@@ -87,3 +91,11 @@ cardanoNodeProcess workingDir args =
     , nodeKesKeyFile
     , nodeVrfKeyFile
     } = args
+
+-- | Wait for the node socket file to become available.
+waitForSocket :: SocketPath -> IO ()
+waitForSocket socketPath = do
+  exists <- doesFileExist $ unFile socketPath
+  unless exists $ do
+    threadDelay 10_000
+    waitForSocket socketPath

src/Pegasus/Embed.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | Functions to access embedded binaries.
+module Pegasus.Embed where
+
+import Data.Bits ((.|.))
+import Data.ByteString qualified as BS
+import Pegasus.EmbedTH (embedExecutable)
+import System.Posix.Files (ownerExecuteMode, ownerReadMode, ownerWriteMode, setFileMode)
+
+-- | Write the embedded 'cardano-node' binary to a path.
+writeCardanoNodeTo :: FilePath -> IO ()
+writeCardanoNodeTo fp = do
+  BS.writeFile fp $(embedExecutable "cardano-node")
+  setFileMode fp (ownerReadMode .|. ownerWriteMode .|. ownerExecuteMode)
+
+-- | Write the embedded 'cardano-cli' binary to a path.
+writeCardanoCliTo :: FilePath -> IO ()
+writeCardanoCliTo fp = do
+  BS.writeFile fp $(embedExecutable "cardano-cli")
+  setFileMode fp (ownerReadMode .|. ownerWriteMode .|. ownerExecuteMode)

src/Pegasus/EmbedTH.hs

@@ -0,0 +1,17 @@
+-- | Template haskell expression to embed executables.
+module Pegasus.EmbedTH where
+
+import Data.FileEmbed (embedFile)
+import Language.Haskell.TH (Exp, Q, runIO)
+import System.Directory (findExecutable)
+
+-- | Template haskell expression to find and embed an executable with given name.
+embedExecutable :: String -> Q Exp
+embedExecutable exe = do
+  fp <- runIO $ do
+    findExecutable exe >>= \case
+      Nothing -> fail $ exe <> " not found, ensure it is in PATH when compiling (and do a cabal clean)"
+      Just fp -> do
+        putStrLn $ "Embedding " <> exe <> " from: " <> fp
+        pure fp
+  embedFile fp

test/Main.hs

@@ -9,7 +9,24 @@ import Data.ByteString qualified as BS
 import Data.ByteString.Char8 qualified as BS8
 import Data.Function ((&))
 import Data.Time (NominalDiffTime)
-import System.Process.Typed (ExitCode (..), byteStringOutput, createPipe, getStderr, getStdout, nullStream, readProcess_, runProcess_, setStderr, setStdout, shell, waitExitCode, withProcessTerm)
+import Lens.Micro ((^?))
+import Lens.Micro.Aeson (key, _Number)
+import System.Process.Typed (
+  ExitCode (..),
+  byteStringOutput,
+  createPipe,
+  getStderr,
+  getStdout,
+  nullStream,
+  readProcessStdout_,
+  readProcess_,
+  runProcess_,
+  setStderr,
+  setStdout,
+  shell,
+  waitExitCode,
+  withProcessTerm,
+ )
 import System.Timeout (timeout)
 import Test.HUnit (assertFailure)
 import Test.Hspec (HasCallStack, Spec, hspec, it, shouldReturn, shouldSatisfy)
@@ -25,8 +42,12 @@ spec = do
 
 testStartsDevnetWithin1Second :: IO ()
 testStartsDevnetWithin1Second =
-  withProcessTerm cmd $ \p ->
+  withProcessTerm cmd $ \p -> do
     failAfter 1 $ waitUntilReady p
+    b1 <- cliQueryBlock
+    threadDelay 100_000 -- TODO: configurable block time
+    b2 <- cliQueryBlock
+    b2 `shouldSatisfy` (> b1)
  where
   waitUntilReady p = do
     t <- BS8.hGetLine (getStdout p)
@@ -39,12 +60,17 @@ testStartsDevnetWithin1Second =
       & setStdout createPipe
       & setStderr nullStream
 
+  cliQueryBlock = do
+    out <- readProcessStdout_ (shell "./tmp-pegasus/bin/cardano-cli query tip --testnet-magic 42 --socket-path tmp-pegasus/node.socket")
+    pure $ out ^? key "block" . _Number
+
 testCardanoNodeEmbed :: IO ()
 testCardanoNodeEmbed = do
   withProcessTerm cmd $ \_ -> do
     -- Give pegasus some time to set-up a node
     threadDelay 100_000
     void $ readProcess_ (shell "./tmp-pegasus/bin/cardano-node --version")
+    void $ readProcess_ (shell "./tmp-pegasus/bin/cardano-cli --version")
  where
   cmd =
     shell "pegasus"