workbench, cardano-topology: unidirectional circle topology for more …

…predictable propagation
IntersectMBO · Mar 3, 2022 · bc66d62 · bc66d62
1 parent d72b54b
commit bc66d62
Show file tree

Hide file tree

Showing 2 changed files with 55 additions and 22 deletions.
diff --git a/bench/cardano-topology/cardano-topology.hs b/bench/cardano-topology/cardano-topology.hs
@@ -33,6 +33,11 @@ data TopoParams
     , tpLocation  :: Location
     , tpIdPools   :: Int -> Maybe Int
     }
+  | UniCircle
+    { tpSize      :: Int
+    , tpLocation  :: Location
+    , tpIdPools   :: Int -> Maybe Int
+    }
 
 data Spec = Spec
   { id     :: Int
@@ -50,14 +55,17 @@ mkTopology :: TopoParams -> [Spec]
 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 = intraConnectRing (tpSize < 6) <$> phase1
+   phase2 = intraConnectRing (tpSize < 6) True <$> phase1
    -- Establish inter-location connections.
    phase3 = if length phase2 > 1
             then interConnect phase2
@@ -85,18 +93,31 @@ mkTopology Torus{..} =
      Spec{ links = []
          , mpools = tpIdPools id
          , ..}
-   specIds = [0..(tpSize - 1)]
-   specLocs = take tpSize $ cycle tpLocations
 
 mkTopology Line{..} =
-  breakLoop phase1
+  breakLoop tpSize phase1
  where
+   specIds = [0..(tpSize - 1)]
    -- Assign locations and pool counts;  set initial links.
    phase0 = mkInitial <$> specIds
    -- Connect into a ring
-   phase1 = intraConnectRing False phase0
-   --
+   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 =
@@ -105,30 +126,32 @@ mkTopology Line{..} =
          , loc = tpLocation
          , ..}
 
-   breakLoop :: [Spec] -> [Spec]
-   breakLoop
-     = updateHead (filterLinks (/= tpSize - 1))
-     . updateLast (filterLinks (/= 0))
+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 }
+filterLinks :: (Int -> Bool) -> Spec -> Spec
+filterLinks f s@Spec{..} = s { links = filter f links }
 
-intraConnectRing :: Bool -> [Spec] -> [Spec]
-intraConnectRing withChords specs =
+intraConnectRing :: Bool -> Bool -> [Spec] -> [Spec]
+intraConnectRing withChords bidirectional specs =
   case len of
     0 -> []
     1 -> specs
     2 -> connect 1
          specs
     _ -> connect 1                             -- next
-       $ connect (len - 1)                     -- prev
-       $ if not withChords
+       $ if not bidirectional
          then specs
-         else connect (len `div` 3)            -- chord 1
-            $ if len < 9
-              then specs
-              else connect ((len * 2) `div` 3) -- chord 2
-                   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]
@@ -190,6 +213,16 @@ main = do
        (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

diff --git a/nix/workbench/profiles/defaults.jq b/nix/workbench/profiles/defaults.jq
@@ -18,7 +18,7 @@ def era_defaults($era):
     , dense_pool_density:             1
     , with_proxy:                     false
     , with_observer:                  false
-    , topology:                       "line"
+    , topology:                       "uni-circle"
     }
 
   , genesis: