Merge pull request #5626 from IntersectMBO/newhoggy/upgrade-to-cardan…

…o-cli-8.17.0.0-and-cardano-api-8.37.0.0 Use lenses for JSON editing. Upgrade to `hedgehog-extras0.5.1.0`
IntersectMBO · Jan 13, 2024 · 31f5634 · 31f5634
2 parents 072ae58 + 0db4af8
commit 31f5634
Show file tree

Hide file tree

Showing 4 changed files with 14 additions and 24 deletions.
diff --git a/bench/locli/locli.cabal b/bench/locli/locli.cabal
@@ -175,7 +175,7 @@ test-suite test-locli
   build-depends:        cardano-prelude
                       , containers
                       , hedgehog
-                      , hedgehog-extras ^>= 0.5.0.0
+                      , hedgehog-extras ^>= 0.5.1.0
                       , locli
                       , text
 

diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal
@@ -73,7 +73,7 @@ test-suite chairman-tests
                       , cardano-crypto-class ^>= 2.1.2
                       , filepath
                       , hedgehog
-                      , hedgehog-extras ^>= 0.5.0.0
+                      , hedgehog-extras ^>= 0.5.1.0
                       , network
                       , process
                       , random

diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal
@@ -55,7 +55,9 @@ library
                       , exceptions
                       , filepath
                       , hedgehog
-                      , hedgehog-extras ^>= 0.5.0.0
+                      , hedgehog-extras ^>= 0.5.1.0
+                      , microlens
+                      , lens-aeson
                       , mtl
                       , network
                       , network-mux

diff --git a/cardano-testnet/src/Testnet/Components/Configuration.hs b/cardano-testnet/src/Testnet/Components/Configuration.hs
@@ -23,7 +23,6 @@ import           Control.Monad.Catch (MonadCatch)
 import           Control.Monad.IO.Class (MonadIO)
 import           Data.Aeson
 import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.KeyMap as KM
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.List as List
 import           Data.String
@@ -34,11 +33,13 @@ import           System.FilePath.Posix ((</>))
 
 import           Hedgehog
 import qualified Hedgehog as H
-import qualified Hedgehog.Extras.Stock.Aeson as J
 import qualified Hedgehog.Extras.Stock.Time as DTC
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H
 
+import qualified Data.Aeson.Lens as L
+import           Lens.Micro
+
 import           Testnet.Defaults
 import           Testnet.Filepath
 import           Testnet.Process.Run (execCli_)
@@ -75,13 +76,6 @@ createConfigYaml (TmpAbsolutePath tempAbsPath') anyCardanoEra' = GHC.withFrozenC
 numSeededUTxOKeys :: Int
 numSeededUTxOKeys = 3
 
--- | Adjust a value at a specific key. When the key is not a member of the map, the original map is returned
-adjustKM :: (v -> v) -> KM.Key -> KM.KeyMap v -> KM.KeyMap v
-adjustKM f k m =
-  case KM.lookup k m of
-    Nothing -> m
-    Just v -> KM.insert k (f v) m
-
 createSPOGenesisAndFiles
   :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
   => CardanoTestnetOptions
@@ -111,18 +105,12 @@ createSPOGenesisAndFiles testnetOptions startTime (TmpAbsolutePath tempAbsPath')
   -- TODO: Remove this rewrite.
  -- 50 second epochs
  -- Epoch length should be "10 * k / f" where "k = securityParam, f = activeSlotsCoeff"
-  H.rewriteJsonFile createStakedInitialGenesisFile $ J.rewriteObject
-      ( KM.insert "securityParam"          (toJSON @Int 5)    -- TODO: USE config p arameter
-      . adjustKM
-          (J.rewriteObject
-              $ adjustKM
-                (J.rewriteObject (KM.insert "major" (toJSON @Int 8)))
-                "protocolVersion"
-          )   "protocolParams"
-      . KM.insert "rho"                    (toJSON @Double 0.1)
-      . KM.insert "tau"                    (toJSON @Double 0.1)
-      . KM.insert "updateQuorum"           (toJSON @Int 2)
-      )
+  H.rewriteJsonFile createStakedInitialGenesisFile $ \o -> o
+    & L.key "securityParam" . L._Integer .~ 5
+    & L.key "rho" . L._Double  .~ 0.1
+    & L.key "tau" . L._Double  .~ 0.1
+    & L.key "updateQuorum" . L._Integer .~ 2
+    & L.key "protocolParams" . L.key "protocolVersion" . L.key "major" . L._Integer .~ 8
 
   execCli_
     [ "genesis", "create-staked"