[CBR-503] Refactor script-runner testcases; fix testHFM

Michael Hueschen · Michael Hueschen · commit 8b5321c8784f · 2019-02-11T17:27:38.000-05:00
I had repeated myself in `testHardForkMechanism`, by copying the
body of `test4`. Due to (what seems like) a botched rebase, my
CBR-503 PR was broken, and because of the duplication, I didn't
catch it in review. This commit factors out the shared logic, and
does checking (`confSetBvAndSv`) to make sure proposals are sane.

I also fix `testHFM` by making the BlockVersions and SoftwareVersions
agree.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -12,8 +12,7 @@
 ### Features
 
 - Support for (unused) addresses batch import ([CO-448](https://iohk.myjetbrains.com/youtrack/issue/CO-448) [#4040](https://github.com/input-output-hk/cardano-sl/pull/4040))
-
-- Add `script-runner` tool to automate cluster-level testing ([DEVOPS-1131](https://iohk.myjetbrains.com/youtrack/v2/issue/devops-1131): [#3916](https://github.com/input-output-hk/cardano-sl/pull/3916) [#4057](https://github.com/input-output-hk/cardano-sl/pull/4057))
+- Add `script-runner` tool to automate cluster-level testing ([DEVOPS-1131](https://iohk.myjetbrains.com/youtrack/v2/issue/devops-1131): [#3916](https://github.com/input-output-hk/cardano-sl/pull/3916) [#4057](https://github.com/input-output-hk/cardano-sl/pull/4057)) ([CBR-503](https://iohk.myjetbrains.com/youtrack/issue/CBR-503): [#4061](https://github.com/input-output-hk/cardano-sl/pull/4061) [#4073](https://github.com/input-output-hk/cardano-sl/pull/4073))
 
 - Node Monitoring API: nodes now serve their own settings and info via a web server via a `/api/v1/node-settings` and `/api/v1/node-info` (still proxied by the wallet backend) ([#110](https://github.com/input-output-hk/cardano-wallet/issues/110))
   - Set up scaffolding for node API [#3788](https://github.com/input-output-hk/cardano-sl/pull/3788)
diff --git a/script-runner/TestCases.hs b/script-runner/TestCases.hs
@@ -20,9 +20,9 @@ import           Pos.Chain.Update (ApplicationName (ApplicationName),
                      BlockVersion (BlockVersion),
                      BlockVersionData (bvdMaxBlockSize, bvdUnlockStakeEpoch),
                      BlockVersionModifier (bvmMaxBlockSize, bvmUnlockStakeEpoch),
-                     SoftwareVersion (SoftwareVersion), UpdateConfiguration,
-                     ccApplicationVersion_L, ccLastKnownBlockVersion_L,
-                     obftEraFlagValue)
+                     SoftwareVersion (..), UpdateConfiguration,
+                     ccApplicationName_L, ccApplicationVersion_L,
+                     ccLastKnownBlockVersion_L, obftEraFlagValue)
 import qualified Pos.Client.CLI as CLI
 import           Pos.Core.Slotting (EpochIndex)
 import           Pos.DB.Class (gsAdoptedBVData)
@@ -42,15 +42,18 @@ import           Types (NodeType (..))
 
 import           Serokell.Data.Memory.Units (Byte)
 
-mutateConfiguration :: Configuration -> Configuration
-mutateConfiguration cfg = (cfg & ccUpdate_L . ccLastKnownBlockVersion_L .~ BlockVersion 0 1 0) & ccUpdate_L . ccApplicationVersion_L .~ 1
+-- | Helper to make sure BV and SV are set in accordance with the arguments passed in
+confSetBvAndSv :: BlockVersion -> SoftwareVersion -> Configuration -> Configuration
+confSetBvAndSv bv sv cfg = ((cfg & ccUpdate_L . ccLastKnownBlockVersion_L .~ bv)
+                                 & ccUpdate_L . ccApplicationVersion_L .~ (svNumber sv))
+                                 & ccUpdate_L . ccApplicationName_L .~ (svAppName sv)
 
 mutateConfigurationForObft :: Configuration -> Configuration
-mutateConfigurationForObft cfg = (cfg & ccUpdate_L . ccLastKnownBlockVersion_L .~ BlockVersion 1 0 0) & over ccGenesis_L (updateUnlockStakeEpoch obftEraFlagValue)
-
-updateUnlockStakeEpoch :: EpochIndex -> StaticConfig -> StaticConfig
-updateUnlockStakeEpoch ei (GCSrc _ _) = error "updateUnlockStakeEpoch: got GCSrc"
-updateUnlockStakeEpoch ei (GCSpec gs) = GCSpec (gs { gsBlockVersionData = ((gsBlockVersionData gs) { bvdUnlockStakeEpoch = ei })})
+mutateConfigurationForObft = over ccGenesis_L (updateUnlockStakeEpoch obftEraFlagValue)
+ where
+  updateUnlockStakeEpoch :: EpochIndex -> StaticConfig -> StaticConfig
+  updateUnlockStakeEpoch _  (GCSrc _ _) = error "updateUnlockStakeEpoch: got GCSrc"
+  updateUnlockStakeEpoch ei (GCSpec gs) = GCSpec (gs { gsBlockVersionData = ((gsBlockVersionData gs) { bvdUnlockStakeEpoch = ei })})
 
 data ExpectedResult = SuccessFullUpdate | FailedProposalUpdate deriving (Show, Eq)
 
@@ -60,81 +63,23 @@ data ExpectedResult = SuccessFullUpdate | FailedProposalUpdate deriving (Show, E
 logMsg :: String -> PocMode ()
 logMsg = liftIO . hPutStrLn stderr
 
-{-# ANN testHardForkMechanism ("HLint: ignore Reduce duplication" :: Text) #-}
-testHardForkMechanism :: Script ()
-testHardForkMechanism = do
-  genesisConfig <- getGenesisConfig
-  let
-    proposal :: Dict HasConfigurations -> Diffusion PocMode -> PocMode ()
-    proposal Dict diffusion = do
-      let
-        keyIndex :: Int
-        keyIndex = 0
-        blockVersion = BlockVersion 0 1 0
-        softwareVersion = SoftwareVersion (ApplicationName "cardano-sl") 1
-        blockVersionModifier :: BlockVersionModifier
-        blockVersionModifier = def { bvmUnlockStakeEpoch = Just obftEraFlagValue }
-      doUpdate diffusion genesisConfig keyIndex blockVersion softwareVersion blockVersionModifier
-    expectedResult = SuccessFullUpdate
-  onStartup $ \Dict _diffusion -> do
-    stateDir <- view acStatePath
-    loadNKeys stateDir 4
-  on (1,2) proposal
-  on (2,6) $ \Dict _diffusion -> do
-    uc <- view (lensOf @UpdateConfiguration)
-    proposals <- GS.getConfirmedProposals uc Nothing
-    case (proposals, expectedResult) of
-      ([], FailedProposalUpdate) -> do
-        logMsg "expected failed proposal, passing test"
-        endScript ExitSuccess
-      (_, FailedProposalUpdate) -> do
-        logMsg "expected failure, but proposal was accepted!"
-        endScript $ ExitFailure 1
-      ([], _) -> do
-        logMsg "expected proposal to pass, but it didnt"
-        endScript $ ExitFailure 2
-      ([_one], SuccessFullUpdate) -> do
-        stateDir <- view acStatePath
-        opts <- view acScriptOptions
-        let
-          -- the config for the script-runner is mirrored to the nodes it starts
-          cfg = opts ^. srCommonNodeArgs . CLI.commonArgs_L
-        newConfiguration <- liftIO $ mutateConfigurationYaml (cfg ^. CLI.configurationOptions_L . cfoFilePath_L) (cfg ^. CLI.configurationOptions_L . cfoKey_L) mutateConfigurationForObft
-        liftIO $ BS.writeFile (T.unpack $ stateDir <> "/configuration2.yaml") newConfiguration
-        let
-          cfg2 = cfg & CLI.configurationOptions_L . cfoFilePath_L .~ (T.unpack $ stateDir <> "/configuration2.yaml")
-        forAllNodes_ $ \node -> do
-          stopNodeByName (Core, node)
-          startNode $ NodeInfo node Core stateDir (stateDir <> "/topology.yaml") cfg2
-      (_toomany, SuccessFullUpdate) -> do
-        logMsg "expected 1 proposal to pass, but >1 have passed"
-        endScript $ ExitFailure 3
-  on (3,10) $ \Dict _diffusion -> do
-    bvd <- gsAdoptedBVData
-    case (bvdUnlockStakeEpoch bvd == obftEraFlagValue) of
-      True -> do
-        liftIO $ hPutStrLn stderr "test passed"
-        endScript ExitSuccess
-      _ -> do
-        liftIO $ hPutStrLn stderr "bvdUnlockStakeEpoch was not what was we expected"
-        endScript $ ExitFailure 4
-  forM_ (range (0,20)) $ \epoch -> do
-    on(epoch, 0) $ printbvd epoch 0
-    on(epoch, 1) $ printbvd epoch 1
-
-test4 :: Byte -> ExpectedResult -> Script ()
-test4 targetblocksize expectedResult = do
+sharedUpdateTester :: (Configuration -> Configuration)
+                   -> ExpectedResult
+                   -> BlockVersion
+                   -> SoftwareVersion
+                   -> BlockVersionModifier
+                   -> (BlockVersionData -> Bool)
+                   -> String
+                   -> Script ()
+sharedUpdateTester mutateConf expectedResult blockVersion softwareVersion
+                   blockVersionModifier checkBvd errMsg = do
   genesisConfig <- getGenesisConfig
   let
     proposal :: Dict HasConfigurations -> Diffusion PocMode -> PocMode ()
     proposal Dict diffusion = do
       let
         keyIndex :: Int
         keyIndex = 0
-        blockVersion = BlockVersion 0 1 0
-        softwareVersion = SoftwareVersion (ApplicationName "cardano-sl") 1
-        blockVersionModifier :: BlockVersionModifier
-        blockVersionModifier = def { bvmMaxBlockSize = Just targetblocksize }
       doUpdate diffusion genesisConfig keyIndex blockVersion softwareVersion blockVersionModifier
   onStartup $ \Dict _diffusion -> do
     stateDir <- view acStatePath
@@ -145,43 +90,85 @@ test4 targetblocksize expectedResult = do
     proposals <- GS.getConfirmedProposals uc Nothing
     case (proposals, expectedResult) of
       ([], FailedProposalUpdate) -> do
-        logMsg "expected failed proposal, passing test"
+        logMsg "test passed: proposal failed, as expected"
         endScript ExitSuccess
       (_, FailedProposalUpdate) -> do
-        logMsg "expected failure, but proposal was accepted!"
+        logMsg "test failed: proposal was accepted, but we expected failure"
         endScript $ ExitFailure 1
       ([], _) -> do
-        logMsg "expected proposal to pass, but it didnt"
+        logMsg "test failed: proposal failed, but we expected success"
         endScript $ ExitFailure 2
       ([_one], SuccessFullUpdate) -> do
         stateDir <- view acStatePath
         opts <- view acScriptOptions
         let
           -- the config for the script-runner is mirrored to the nodes it starts
           cfg = opts ^. srCommonNodeArgs . CLI.commonArgs_L
-        newConfiguration <- liftIO $ mutateConfigurationYaml (cfg ^. CLI.configurationOptions_L . cfoFilePath_L) (cfg ^. CLI.configurationOptions_L . cfoKey_L) mutateConfiguration
+          fullConfMutator = mutateConf . confSetBvAndSv blockVersion softwareVersion
+          --
+        newConfiguration <- liftIO $ mutateConfigurationYaml (cfg ^. CLI.configurationOptions_L . cfoFilePath_L)
+                                                             (cfg ^. CLI.configurationOptions_L . cfoKey_L)
+                                                             fullConfMutator
         liftIO $ BS.writeFile (T.unpack $ stateDir <> "/configuration2.yaml") newConfiguration
         let
           cfg2 = cfg & CLI.configurationOptions_L . cfoFilePath_L .~ (T.unpack $ stateDir <> "/configuration2.yaml")
         forAllNodes_ $ \node -> do
           stopNodeByName (Core, node)
           startNode $ NodeInfo node Core stateDir (stateDir <> "/topology.yaml") cfg2
       (_toomany, SuccessFullUpdate) -> do
-        logMsg "expected 1 proposal to pass, but >1 have passed"
+        logMsg "test failed: expected 1 proposal to pass, but >1 have passed"
         endScript $ ExitFailure 3
   on (3,10) $ \Dict _diffusion -> do
     bvd <- gsAdoptedBVData
-    if bvdMaxBlockSize bvd == targetblocksize
+    if checkBvd bvd
        then do
          liftIO $ hPutStrLn stderr "test passed"
          endScript ExitSuccess
        else do
-         liftIO $ hPutStrLn stderr "max block size not what was expected"
+         liftIO $ hPutStrLn stderr errMsg
          endScript $ ExitFailure 4
   forM_ (range (0,20)) $ \epoch -> do
     on(epoch, 0) $ printbvd epoch 0
     on(epoch, 1) $ printbvd epoch 1
 
+testHardForkMechanism :: Script ()
+testHardForkMechanism =
+  sharedUpdateTester mutateConf expectedResult blockVersion softwareVersion
+                     blockVersionModifier checkBvd errMsg
+ where
+  mutateConf :: Configuration -> Configuration
+  mutateConf = mutateConfigurationForObft
+  expectedResult :: ExpectedResult
+  expectedResult = SuccessFullUpdate
+  blockVersion :: BlockVersion
+  blockVersion = BlockVersion 1 0 0
+  softwareVersion :: SoftwareVersion
+  softwareVersion = SoftwareVersion (ApplicationName "cardano-sl") 0
+  blockVersionModifier :: BlockVersionModifier
+  blockVersionModifier = def { bvmUnlockStakeEpoch = Just obftEraFlagValue }
+  checkBvd :: BlockVersionData -> Bool
+  checkBvd bvd = bvdUnlockStakeEpoch bvd == obftEraFlagValue
+  errMsg :: String
+  errMsg = "bvdUnlockStakeEpoch was not what was we expected"
+
+test4 :: Byte -> ExpectedResult -> Script ()
+test4 targetblocksize expectedResult =
+  sharedUpdateTester mutateConf expectedResult blockVersion softwareVersion
+                     blockVersionModifier checkBvd errMsg
+ where
+  mutateConf :: Configuration -> Configuration
+  mutateConf = identity
+  blockVersion :: BlockVersion
+  blockVersion = BlockVersion 0 1 0
+  softwareVersion :: SoftwareVersion
+  softwareVersion = SoftwareVersion (ApplicationName "cardano-sl") 1
+  blockVersionModifier :: BlockVersionModifier
+  blockVersionModifier = def { bvmMaxBlockSize = Just targetblocksize }
+  checkBvd :: BlockVersionData -> Bool
+  checkBvd bvd = bvdMaxBlockSize bvd == targetblocksize
+  errMsg :: String
+  errMsg = "max block size not what was expected"
+
 emptyScript :: Script ()
 emptyScript = do
   pure ()
