Merge #3643

3643: cluster-bench: CI benchmark r=deepfire a=deepfire

1. turn the `workbench-smoke-test`/`workbench-ci-analysis` into a generic derivation
2. extend the topology generator to generates plain lines and circles
3. clean up profile definitions wrt. fund specification
4. clean up the derivation nomenclature in the Nix layer
5. `workbench-ci-test` / `workbench-ci-analysis` derivations, as parallel to smoke.
6. refactor the workbench Nix code a bit

Co-authored-by: Kosyrev Serge <serge.kosyrev@iohk.io>

Makefile

@@ -58,11 +58,16 @@ cluster-shell-trace:     ARGS += --arg 'autoStartCluster' true --argstr 'autoSta
 cluster-shell-dev-trace: ARGS += --arg 'autoStartCluster' true --arg 'workbenchDevMode' true --argstr 'autoStartClusterArgs' '--trace --trace-workbench' ## Enter Nix shell, dev mode, start workbench cluster, with shell tracing
 fixed:                   ARGS += --arg 'autoStartCluster' true
 fixed:                   PROFILE = fixed-alzo
-smoke:                   ARGS += --arg 'autoStartCluster' true --run "grep TraceOpenEvent.ClosedDB run/current/node-0/stdout >/dev/null && echo 'Smoke test:  PASS' || echo 'Smoke test:  FAIL'"
-smoke:                   PROFILE = smoke-alzo
-smoke-loaded:            ARGS += --arg 'autoStartCluster' true --run "grep TraceOpenEvent.ClosedDB run/current/node-0/stdout >/dev/null && echo 'Smoke test:  PASS' || echo 'Smoke test:  FAIL'"
-smoke-loaded:            PROFILE = smoke-loaded-alzo
-shell-dev cluster-shell-dev cluster-shell-trace cluster-shell-dev-trace fixed smoke smoke-loaded: shell
+shell-dev cluster-shell-dev cluster-shell-trace cluster-shell-dev-trace fixed: shell
+
+test-smoke: smoke ## Build the 'workbench-smoke-test', same as the Hydra job
+smoke:
+	nix build -f 'default.nix' 'workbench-smoke-test'     --out-link result-smoke-run      --cores 0
+test-analysis: smoke-analysis ## Build the 'workbench-smoke-analysis', same as the Hydra job
+smoke-analysis:
+	nix build -f 'default.nix' 'workbench-smoke-analysis' --out-link result-smoke-analysis --cores 0 --show-trace
+ci-analysis:
+	nix build -f 'default.nix' 'workbench-ci-analysis'    --out-link result-ci-analysis    --cores 0 --show-trace
 
 shell: ## Enter Nix shell, CI mode (workbench run from Nix store)
 	nix-shell --max-jobs 8 --cores 0 --show-trace --argstr profileName ${PROFILE} ${ARGS}

bench/cardano-topology/cardano-topology.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -Wno-partial-fields -Wno-name-shadowing #-}
 
 import           Prelude hiding (id)
 
@@ -21,11 +22,22 @@ import           Options.Applicative
 import qualified System.IO as IO
 
 
-data TopoParams = TopoParams
-  { tpSize      :: Int
-  , tpLocations :: [Location]
-  , tpIdPools   :: Int -> Maybe Int
-  }
+data TopoParams
+  = Torus
+    { tpSize      :: Int
+    , tpLocations :: [Location]
+    , tpIdPools   :: Int -> Maybe Int
+    }
+  | Line
+    { tpSize      :: Int
+    , tpLocation  :: Location
+    , tpIdPools   :: Int -> Maybe Int
+    }
+  | UniCircle
+    { tpSize      :: Int
+    , tpLocation  :: Location
+    , tpIdPools   :: Int -> Maybe Int
+    }
 
 data Spec = Spec
   { id     :: Int
@@ -40,17 +52,20 @@ data Location
   deriving (Bounded, Eq, Enum, Ord, Read, Show)
 
 mkTopology :: TopoParams -> [Spec]
-mkTopology TopoParams{..} =
+mkTopology Torus{..} =
   concat phase3
  where
+   specIds = [0..(tpSize - 1)]
+   specLocs = take tpSize $ cycle tpLocations
+
    -- Assign locations and pool counts;  set initial links.
    phase0 = zipWith mkInitial specIds specLocs
    -- Split into per-location lists.
    phase1 = [ filter ((== l) . loc) phase0
             | l <- tpLocations ]
             & filter (not . null)
    -- Establish intra-location connections.
-   phase2 = intraConnect <$> phase1
+   phase2 = intraConnectRing (tpSize < 6) True <$> phase1
    -- Establish inter-location connections.
    phase3 = if length phase2 > 1
             then interConnect phase2
@@ -73,42 +88,82 @@ mkTopology TopoParams{..} =
              idOf n xs' = id (xs' !! n)
       linker [] = error "Invariant failure: empty list of specs"
 
-   intraConnect :: [Spec] -> [Spec]
-   intraConnect specs =
-     case len of
-       0 -> []
-       1 -> specs
-       2 -> connect 1
-            specs
-       _ -> connect 1                             -- next
-          $ connect (len - 1)                     -- prev
-          $ if len < 6
-            then specs
-            else connect (len `div` 3)            -- chord 1
-               $ if len < 9
-                 then specs
-                 else connect ((len * 2) `div` 3) -- chord 2
-                      specs
-    where
-      len = length specs
-      connect :: Int -> [Spec] -> [Spec]
-      connect offt xs =
-          take (length xs) $
-          fmap linker (tails ring)
-        where linker (x:xs') =
-                x { links = idOf (offt - 1) xs'
-                          : links x }
-              linker [] = error "Invariant failure: empty list of specs"
-              ring = cycle xs
-              idOf n xs' = id (xs' !! n)
-
    mkInitial :: Int -> Location -> Spec
    mkInitial id loc =
      Spec{ links = []
          , mpools = tpIdPools id
          , ..}
+
+mkTopology Line{..} =
+  breakLoop tpSize phase1
+ where
    specIds = [0..(tpSize - 1)]
-   specLocs = take tpSize $ cycle tpLocations
+   -- Assign locations and pool counts;  set initial links.
+   phase0 = mkInitial <$> specIds
+   -- Connect into a ring
+   phase1 = intraConnectRing False True phase0
+
+   mkInitial :: Int -> Spec
+   mkInitial id =
+     Spec{ links = []
+         , mpools = tpIdPools id
+         , loc = tpLocation
+         , ..}
+
+mkTopology UniCircle{..} =
+  phase1
+ where
+   specIds = [0..(tpSize - 1)]
+   -- Assign locations and pool counts;  set initial links.
+   phase0 = mkInitial <$> specIds
+   -- Connect into a ring
+   phase1 = intraConnectRing False False phase0
+
+   mkInitial :: Int -> Spec
+   mkInitial id =
+     Spec{ links = []
+         , mpools = tpIdPools id
+         , loc = tpLocation
+         , ..}
+
+breakLoop :: Int -> [Spec] -> [Spec]
+breakLoop tpSize
+  = updateHead (filterLinks (/= tpSize - 1))
+  . updateLast (filterLinks (/= 0))
+
+filterLinks :: (Int -> Bool) -> Spec -> Spec
+filterLinks f s@Spec{..} = s { links = filter f links }
+
+intraConnectRing :: Bool -> Bool -> [Spec] -> [Spec]
+intraConnectRing withChords bidirectional specs =
+  case len of
+    0 -> []
+    1 -> specs
+    2 -> connect 1
+         specs
+    _ -> connect 1                             -- next
+       $ if not bidirectional
+         then specs
+         else connect (len - 1)                -- prev
+              $ if not withChords
+                then specs
+                else connect (len `div` 3)     -- chord 1
+                     $ if len < 9
+                       then specs
+                       else connect ((len * 2) `div` 3) -- chord 2
+                            specs
+ where
+   len = length specs
+   connect :: Int -> [Spec] -> [Spec]
+   connect offt xs =
+       take (length xs) $
+       fmap linker (tails ring)
+     where linker (x:xs') =
+             x { links = idOf (offt - 1) xs'
+                       : links x }
+           linker [] = error "Invariant failure: empty list of specs"
+           ring = cycle xs
+           idOf n xs' = id (xs' !! n)
 
 main :: IO ()
 main = do
@@ -120,9 +175,14 @@ main = do
   writeTopo topo topoJson
   maybe (pure ()) (writeDot  topoSpec) topoDot
  where
+   opts = info (cliParser <**> helper)
+     ( fullDesc
+    <> progDesc "Cardano topology generator"
+    <> header "make-topology - generate Cardano node topologies" )
+
    cliParser :: Parser (TopoParams, FilePath, Maybe FilePath)
    cliParser =
-     (,,) <$> topoParamsParser
+     (,,) <$> subparser topoParamsParser
           <*> strOption
              ( long "topology-output"
             <> help "Topology file to write"
@@ -133,20 +193,54 @@ main = do
               <> help "Dot file to write"
               <> metavar "OUTFILE" ))
 
-   topoParamsParser = TopoParams
-      <$> option auto
-      ( long "size"
+   topoParamsParser =
+     command "torus"
+     (info
+       (Torus
+        <$> parseSize
+        <*> some parseLocation
+        <*> parseRoleSelector)
+       (progDesc "Toroidal mesh"
+                 <> fullDesc
+                 <> header "Generate a toroidal mesh topology"))
+     <>
+     command "line"
+     (info
+      (Line
+       <$> parseSize
+       <*> parseLocation
+       <*> parseRoleSelector)
+      (progDesc "Line"
+                <> fullDesc
+                <> header "Generate a line topology"))
+     <>
+     command "uni-circle"
+     (info
+       (UniCircle
+        <$> parseSize
+        <*> parseLocation
+        <*> parseRoleSelector)
+       (progDesc "Unidirectional circle"
+                 <> fullDesc
+                 <> header "Generate a unidirectional circle topology"))
+
+   parseSize =
+     option auto
+     ( long "size"
         <> metavar "SIZE"
         <> help "Node count" )
-      <*> some
-      (option auto
-        ( long "loc"
-          <> help "Region (at least one)"
-          <> metavar "LOCNAME" ))
-      <*> (roleSelector <$>
-           flag False True
-            ( long "with-bft-node-0"
-              <> help "Include a BFT node-0"))
+
+   parseLocation =
+     option auto
+     ( long "loc"
+       <> help "Region (at least one)"
+       <> metavar "LOCNAME" )
+
+   parseRoleSelector =
+     roleSelector <$>
+     flag False True
+     ( long "with-bft-node-0"
+       <> help "Include a BFT node-0")
 
    roleSelector withBft = \case
      -- TODO:  prepare for deprecation of BFT nodes by switching 1 & 0
@@ -156,11 +250,6 @@ main = do
            else Just 1  -- Dense pools are denoted by any amount >1
       _ ->      Just 2
 
-   opts = info (cliParser <**> helper)
-     ( fullDesc
-    <> progDesc "Cardano topology generator"
-    <> header "make-topology - generate Cardano node topologies" )
-
 --- * To JSON topology
 ---
 writeTopo :: [Node] -> FilePath -> IO ()
@@ -235,6 +324,22 @@ toGV xs =
 
 --- * Aux
 ---
+-- | Update the first element of a list, if it exists.
+--   O(1).
+updateHead :: (a -> a) -> [a] -> [a]
+updateHead _ []       = []
+updateHead f (a : as) = f a : as
+
+-- | Update the last element of a list, if it exists.
+--   O(n).
+updateLast :: (a -> a) -> [a] -> [a]
+updateLast _ [] = []
+updateLast f (a : as) = loop a as
+  -- Using a helper function to minimize the pattern matching.
+  where
+  loop a []       = [f a]
+  loop a (b : bs) = a : loop b bs
+
 idName :: Int -> String
 idName = ("node-" <>) . show
 

flake.nix

@@ -207,14 +207,19 @@
             benchmarks = collectComponents' "benchmarks" projectPackages;
           });
 
+          workbench = pkgs.clusterNix.workbench;
+
           packages = exes
             # Linux only packages:
             // optionalAttrs (system == "x86_64-linux") rec {
             "dockerImage/node" = pkgs.dockerImage;
             "dockerImage/submit-api" = pkgs.submitApiDockerImage;
             membenches = membench.outputs.packages.x86_64-linux.batch-report;
             snapshot = membench.outputs.packages.x86_64-linux.snapshot;
-            workbench-smoke-test = pkgs.clusterNix.smoke-test { profileName = "smoke-loaded-alzo"; };
+            workbench-smoke-test     = pkgs.clusterNix.profile-run-supervisord { profileName = "smoke-alzo";trace = true; };
+            workbench-smoke-analysis = workbench-smoke-test.analysis;
+            workbench-ci-test        = pkgs.clusterNix.profile-run-supervisord { profileName = "ci-light-alzo"; };
+            workbench-ci-analysis    = workbench-ci-test.analysis;
           }
             # Add checks to be able to build them individually
             // (prefixNamesWith "checks/" checks);