start implementing startNode and stopNode

Author: cleverca22

pkgs/default.nix

@@ -16242,6 +16242,7 @@ license = stdenv.lib.licenses.mit;
 , lifted-async
 , mtl
 , optparse-applicative
+, process
 , reflection
 , resourcet
 , serokell-util
@@ -16250,6 +16251,7 @@ license = stdenv.lib.licenses.mit;
 , text
 , transformers
 , universum
+, unix
 , unordered-containers
 , vty
 }:
@@ -16286,13 +16288,15 @@ lens
 lifted-async
 mtl
 optparse-applicative
+process
 reflection
 resourcet
 serokell-util
 stm
 text
 transformers
 universum
+unix
 unordered-containers
 vty
 ];

script-runner/AutomatedTestRunner.hs

@@ -8,7 +8,7 @@
 {-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE TypeApplications           #-}
 
-module AutomatedTestRunner (Example, getGenesisConfig, loadNKeys, doUpdate, onStartup, on, getScript, runScript, NodeType(..), startNode) where
+module AutomatedTestRunner (Example, getGenesisConfig, loadNKeys, doUpdate, onStartup, on, getScript, runScript, NodeType(..), startNode, stopNode, NodeHandle) where
 
 import           Brick hiding (on)
 import           Brick.BChan
@@ -35,7 +35,7 @@ import           Options.Applicative (Parser, execParser, footerDoc, fullDesc,
                      header, help, helper, info, infoOption, long, progDesc)
 import           Paths_cardano_sl (version)
 import           PocMode (AuxxContext (AuxxContext, acRealModeContext),
-                     AuxxMode, realModeToAuxx)
+                     PocMode, realModeToAuxx)
 import           Pos.Chain.Block (LastKnownHeaderTag)
 import           Pos.Chain.Genesis as Genesis
                      (Config (configGeneratedSecrets, configProtocolMagic),
@@ -69,11 +69,13 @@ import           Pos.Util (lensOf, logException)
 import           Pos.Util.CompileInfo (CompileTimeInfo (ctiGitRevision),
                      HasCompileInfo, compileInfo, withCompileInfo)
 import           Pos.Util.UserSecret (readUserSecret, usKeys, usPrimKey, usVss)
-import           Pos.Util.Wlog (LoggerName)
+import           Pos.Util.Wlog (LoggerName, logWarning)
 import           Pos.WorkMode (EmptyMempoolExt, RealMode)
 import           Prelude (show)
 import           Text.PrettyPrint.ANSI.Leijen (Doc)
 import           Universum hiding (on, show, state, when)
+import System.Process
+import System.Posix.Signals
 
 class TestScript a where
   getScript :: a -> Script
@@ -97,7 +99,7 @@ data Script = Script
   , startupActions :: [ SlotTrigger ]
   } deriving (Show, Generic)
 
-data SlotTrigger = SlotTrigger (Dict HasConfigurations -> Diffusion AuxxMode -> AuxxMode ())
+data SlotTrigger = SlotTrigger (Dict HasConfigurations -> Diffusion PocMode -> PocMode ())
 
 instance Show SlotTrigger where
   show _ = "IO ()"
@@ -115,8 +117,6 @@ instance HasEpochSlots => TestScript (Example a) where
 instance TestScript Script where
   getScript = identity
 
-data NodeHandle = NodeHandle (Async ())
-
 data EpochSlots = EpochSlots { epochSlots :: SlotCount, config :: Config }
 type HasEpochSlots = Given EpochSlots
 
@@ -196,34 +196,34 @@ runWithConfig ScriptRunnerOptions{srCommonNodeArgs,srPeers} inputParams genesisC
 thing3 :: (TestScript a, HasCompileInfo, HasConfigurations) => Config -> TxpConfiguration -> InputParams2 a -> NodeResources () -> IO ()
 thing3 genesisConfig txpConfig inputParams nr = do
   let
-    toRealMode :: AuxxMode a -> RealMode EmptyMempoolExt a
+    toRealMode :: PocMode a -> RealMode EmptyMempoolExt a
     toRealMode auxxAction = do
       realModeContext <- ask
       lift $ runReaderT auxxAction $ AuxxContext { acRealModeContext = realModeContext }
     thing2 :: Diffusion (RealMode ()) -> RealMode EmptyMempoolExt ()
     thing2 diffusion = toRealMode (thing5 (hoistDiffusion realModeToAuxx toRealMode diffusion))
-    thing5 :: Diffusion AuxxMode -> AuxxMode ()
+    thing5 :: Diffusion PocMode -> PocMode ()
     thing5 = runNode genesisConfig txpConfig nr thing4
-    thing4 :: [ (Text, Diffusion AuxxMode -> AuxxMode ()) ]
+    thing4 :: [ (Text, Diffusion PocMode -> PocMode ()) ]
     thing4 = workers genesisConfig inputParams
   runRealMode updateConfiguration genesisConfig txpConfig nr thing2
 
-workers :: (HasConfigurations, TestScript a) => Genesis.Config -> InputParams2 a -> [ (Text, Diffusion AuxxMode -> AuxxMode ()) ]
+workers :: (HasConfigurations, TestScript a) => Genesis.Config -> InputParams2 a -> [ (Text, Diffusion PocMode -> PocMode ()) ]
 workers genesisConfig InputParams2{ip2EventChan,ip2Script,ip2ReplyChan} =
   [ ( T.pack "worker1", worker1 genesisConfig ip2Script ip2EventChan)
   , ( "worker2", worker2 ip2EventChan)
   , ( "brick reply worker", brickReplyWorker ip2ReplyChan)
   ]
 
-brickReplyWorker :: HasConfigurations => BChan Reply -> Diffusion AuxxMode -> AuxxMode ()
+brickReplyWorker :: HasConfigurations => BChan Reply -> Diffusion PocMode -> PocMode ()
 brickReplyWorker replyChan diffusion = do
   reply <- liftIO $ readBChan replyChan
   case reply of
     TriggerShutdown -> do
       triggerShutdown
   brickReplyWorker replyChan diffusion
 
-worker2 :: HasConfigurations => BChan CustomEvent -> Diffusion AuxxMode -> AuxxMode ()
+worker2 :: HasConfigurations => BChan CustomEvent -> Diffusion PocMode -> PocMode ()
 worker2 eventChan diffusion = do
   localTip  <- getTipHeader
   headerRef <- view (lensOf @LastKnownHeaderTag)
@@ -238,20 +238,20 @@ worker2 eventChan diffusion = do
     threadDelay 100000
   worker2 eventChan diffusion
 
-worker1 :: (HasConfigurations, TestScript a) => Genesis.Config -> a -> BChan CustomEvent -> Diffusion (AuxxMode) -> AuxxMode ()
+worker1 :: (HasConfigurations, TestScript a) => Genesis.Config -> a -> BChan CustomEvent -> Diffusion (PocMode) -> PocMode ()
 worker1 genesisConfig script eventChan diffusion = do
   let
-    handler :: SlotId -> AuxxMode ()
+    handler :: SlotId -> PocMode ()
     handler slotid = do
       liftIO $ writeBChan eventChan $ CESlotStart $ SlotStart (getEpochIndex $ siEpoch slotid) (getSlotIndex $ siSlot slotid)
       case Map.lookup slotid (slotTriggers realScript) of
         Just (SlotTrigger act) -> runAction act
         Nothing                -> pure ()
       pure ()
     realScript = getScript script
-    errhandler :: Show e => e -> AuxxMode ()
+    errhandler :: Show e => e -> PocMode ()
     errhandler e = print e
-    runAction :: (Dict HasConfigurations -> Diffusion AuxxMode -> AuxxMode ()) -> AuxxMode ()
+    runAction :: (Dict HasConfigurations -> Diffusion PocMode -> PocMode ()) -> PocMode ()
     runAction act = do
       act Dict diffusion `catch` errhandler @SomeException
     realWorker = do
@@ -314,7 +314,7 @@ getGenesisConfig = sbGenesisConfig <$> get
 data SlotCreationFailure = SlotCreationFailure { msg :: Text, slotsInEpoch :: SlotCount } deriving Show
 instance Exception SlotCreationFailure where
 
-onStartup :: (Dict HasConfigurations -> Diffusion AuxxMode -> AuxxMode ()) -> Example ()
+onStartup :: (Dict HasConfigurations -> Diffusion PocMode -> PocMode ()) -> Example ()
 onStartup action = do
   oldsb <- get
   let
@@ -328,7 +328,7 @@ onStartup action = do
   put newsb
   pure ()
 
-on :: (Word64, Word16) -> (Dict HasConfigurations -> Diffusion AuxxMode -> AuxxMode ()) -> Example ()
+on :: (Word64, Word16) -> (Dict HasConfigurations -> Diffusion PocMode -> PocMode ()) -> Example ()
 on (epoch, slot) action = do
   oldsb <- get
   let
@@ -349,7 +349,7 @@ on (epoch, slot) action = do
     }
   put newsb
 
-doUpdate :: HasConfigurations => Diffusion AuxxMode -> Config -> Int -> BlockVersion -> SoftwareVersion -> BlockVersionModifier -> AuxxMode ()
+doUpdate :: HasConfigurations => Diffusion PocMode -> Config -> Int -> BlockVersion -> SoftwareVersion -> BlockVersionModifier -> PocMode ()
 doUpdate diffusion genesisConfig keyIndex blockVersion softwareVersion blockVersionModifier = do
   let
     --tag = SystemTag "win64"
@@ -379,12 +379,12 @@ doUpdate diffusion genesisConfig keyIndex blockVersion softwareVersion blockVers
       putText (sformat ("Update proposal submitted along with votes, upId: "%hashHexF%"\n") upid)
     print updateProposal
 
-loadNKeys :: Integer -> AuxxMode ()
+loadNKeys :: Integer -> PocMode ()
 loadNKeys n = do
   let
     fmt :: Format r (Integer -> r)
     fmt = "../state-demo/generated-keys/rich/" % int % ".key"
-    loadKey :: Integer -> AuxxMode ()
+    loadKey :: Integer -> PocMode ()
     loadKey x = do
       secret <- readUserSecret (T.unpack $ sformat fmt x)
       let
@@ -394,14 +394,30 @@ loadNKeys n = do
       addSecretKey $ noPassEncrypt primSk
   mapM_ loadKey (range (0,n - 1))
 
+data NodeHandle = NodeHandle (Async ()) ProcessHandle
+
 startNode :: NodeType -> IO NodeHandle
 startNode (Core idx) = do
+  stdout <- openFile ("poc-state/core-stdout-" <> show idx) WriteMode
   let
-    _params = [ "--configuration-file", "../lib/configuration.yaml"
+    params = [ "--configuration-file", "../lib/configuration.yaml"
              , "--system-start", "1543100429"
              , "--db-path", "poc-state/core" <> (show idx) <> "-db"
              , "--keyfile", "poc-state/secret" <> (show idx) <> ".key"
              ]
+    pc :: CreateProcess
+    pc = (proc "cardano-node-simple" params) { std_out = UseHandle stdout }
+  (stdin, stdout, stderr, ph) <- createProcess pc
   later <- async $ do
+    waitForProcess ph
     pure ()
-  pure $ NodeHandle later
+  pure $ NodeHandle later ph
+
+stopNode :: NodeHandle -> IO ()
+stopNode (NodeHandle async ph) = do
+  maybePid <- getPid ph
+  case maybePid of
+    Just pid -> do
+      signalProcess sigINT pid
+    Nothing -> do
+      logWarning "node already stopped when trying to stop it"

script-runner/BrickUI.hs

@@ -46,6 +46,7 @@ handleEvent state (VtyEvent (EvKey key [])) = do
   case key of
     KChar 'q' -> halt state
     _         -> continue $ state { asLastMsg = show key }
+
 handleEvent state (AppEvent ae) = do
   case ae of
     CENodeInfo (NodeInfo{niLocalHeight,niGlobalHeight,niLocalEpochOrSlot}) -> do
@@ -56,5 +57,6 @@ handleEvent state (AppEvent ae) = do
         }
     QuitEvent -> halt state
     CESlotStart (SlotStart e s) -> continue $ state { asLastMsg = (show e) <> " " <> (show s) }
+
 handleEvent state evt = do
   continue $ state { asLastMsg = show evt }

script-runner/Poc.hs

@@ -15,15 +15,16 @@ import           PocMode
 import           Pos.Chain.Update (ApplicationName (ApplicationName),
                      BlockVersion (BlockVersion),
                      BlockVersionData (bvdMaxBlockSize, bvdMaxTxSize),
-                     BlockVersionModifier (bvmMaxTxSize),
+                     BlockVersionModifier,
                      SoftwareVersion (SoftwareVersion))
 import           Pos.DB.Class (gsAdoptedBVData)
 import           Pos.Infra.Diffusion.Types (Diffusion)
 import           Pos.Launcher (HasConfigurations)
 import           Serokell.Data.Memory.Units (Byte)
 import           Universum hiding (on)
+import           Pos.Util.Wlog (logInfo)
 
-printbvd :: Dict HasConfigurations -> Diffusion AuxxMode -> AuxxMode ()
+printbvd :: Dict HasConfigurations -> Diffusion PocMode -> PocMode ()
 printbvd Dict _diffusion = do
   let
     bvdfmt :: Format r (Byte -> Byte -> r)
@@ -39,23 +40,33 @@ test4 = do
   --on (82,19180) $ print "it is now epoch 0 slot 10"
   --on (82,19200) $ print "it is now epoch 0 slot 20"
   let
-    proposal1 :: Dict HasConfigurations -> Diffusion AuxxMode -> AuxxMode ()
+    proposal1 :: Dict HasConfigurations -> Diffusion PocMode -> PocMode ()
     proposal1 Dict diffusion = do
       let
         keyIndex :: Int
         keyIndex = 0
         blockVersion = BlockVersion 0 0 0
         softwareVersion = SoftwareVersion (ApplicationName "cardano-sl") 1
-        blockVersionModifier = def { bvmMaxTxSize = Just 131072 }
+        blockVersionModifier :: BlockVersionModifier
+        blockVersionModifier = def -- { bvmMaxTxSize = Just 131072 }
       doUpdate diffusion genesisConfig keyIndex blockVersion softwareVersion blockVersionModifier
       print ("done?"::String)
   onStartup $ \Dict _diffusion -> loadNKeys 4
-  on (1,0) printbvd
   on (1,10) proposal1
-  on (2,0) printbvd
-  on (3,0) printbvd
+  forM_ (range (0,20)) $ \epoch -> on(epoch, 0) printbvd
 
 main :: IO ()
 main = do
-  _corenodes <- forM (range (0,3)) $ \node -> startNode (Core node)
-  runScript $ return $ getScript test4
+  let
+    createNodes :: IO [NodeHandle]
+    createNodes = do
+      corenodes <- forM (range (0,3)) $ \node -> startNode (Core node)
+      pure corenodes
+    cleanupNodes :: [NodeHandle] -> IO ()
+    cleanupNodes corenodes = do
+      logInfo "stopping all nodes"
+      mapM_ stopNode corenodes
+    runScript' :: [NodeHandle] -> IO ()
+    runScript' corenodes = do
+      runScript $ return $ getScript test4
+  bracket createNodes cleanupNodes runScript'