From 736666ce405f76733fcbbbea642e0c453518d000 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 1 Jul 2022 08:25:01 +1000 Subject: [PATCH] Remove lens --- cardano-testnet/cardano-testnet.cabal | 2 - cardano-testnet/src/Test/Assert.hs | 52 ++++++++++++++++++++------ cardano-testnet/src/Testnet/Babbage.hs | 37 +++++++++--------- 3 files changed, 59 insertions(+), 32 deletions(-) diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 1573671f5b3..11a3204bc6a 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -43,8 +43,6 @@ library , hedgehog-extras , http-client , http-types - , lens - , lens-aeson , ouroboros-network , process , random diff --git a/cardano-testnet/src/Test/Assert.hs b/cardano-testnet/src/Test/Assert.hs index 109cf850d6a..0ace8e06dc6 100644 --- a/cardano-testnet/src/Test/Assert.hs +++ b/cardano-testnet/src/Test/Assert.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} @@ -9,29 +10,30 @@ module Test.Assert , getRelevantLeaderSlots ) where -import Control.Lens ((^.), (^?), to) +import Control.Applicative ((<*>)) import Control.Monad (Monad(..)) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Resource (ResourceT) -import Data.Aeson (Value) +import Data.Aeson (FromJSON(..), Value, (.:)) import Data.Bool (Bool(..)) import Data.Eq (Eq (..)) import Data.Function ((.), ($)) import Data.Functor ((<$>)) import Data.Int (Int) -import Data.Maybe (mapMaybe) +import Data.Maybe (mapMaybe, Maybe (..)) import Data.Ord (Ord(..)) +import Data.Text (Text) import GHC.Stack (HasCallStack) import Hedgehog (MonadTest) import Hedgehog.Extras.Internal.Test.Integration (IntegrationState) -import Prelude (fromIntegral) import System.FilePath (FilePath) import System.IO (IO) import Test.Runtime (NodeLoggingFormat(..)) +import Text.Show (Show(..)) -import qualified Data.Aeson as J -import qualified Data.Aeson.Lens as J +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Types as Aeson import qualified Data.ByteString.Lazy as LBS import qualified Data.List as L import qualified Data.Maybe as Maybe @@ -42,12 +44,12 @@ import qualified Hedgehog.Extras.Test.Base as H import qualified Test.Process as H readJsonLines :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m [Value] -readJsonLines fp = mapMaybe (J.decode @Value) . LBS.split 10 <$> H.evalIO (LBS.readFile fp) +readJsonLines fp = mapMaybe (Aeson.decode @Value) . LBS.split 10 <$> H.evalIO (LBS.readFile fp) fileJsonGrep :: FilePath -> (Value -> Bool) -> IO Bool fileJsonGrep fp f = do lines <- LBS.split 10 <$> LBS.readFile fp - let jsons = mapMaybe (J.decode @Value) lines + let jsons = mapMaybe (Aeson.decode @Value) lines return $ L.any f jsons assertChainExtended :: (H.MonadTest m, MonadIO m) @@ -59,14 +61,42 @@ assertChainExtended deadline nodeLoggingFormat nodeStdoutFile = H.assertByDeadlineIOCustom "Chain not extended" deadline $ do case nodeLoggingFormat of NodeLoggingFormatAsText -> IO.fileContains "Chain extended, new tip" nodeStdoutFile - NodeLoggingFormatAsJson -> fileJsonGrep nodeStdoutFile (\v -> v ^. J.key "data" . J.key "kind" . J._String == "") + NodeLoggingFormatAsJson -> fileJsonGrep nodeStdoutFile $ \v -> + Aeson.parseMaybe (Aeson.parseJSON @(LogEntry Kind)) v == Just (LogEntry (Kind "TraceAddBlockEvent.AddedToCurrentChain")) + +newtype LogEntry a = LogEntry + { data_ :: a + } deriving (Eq, Show) + +instance FromJSON a => FromJSON (LogEntry a) where + parseJSON = Aeson.withObject "LogEntry" $ \v -> + LogEntry <$> v .: "data" + +newtype Kind = Kind + { kind :: Text + } deriving (Eq, Show) + +data TraceNodeIsLeader = TraceNodeIsLeader + { kind :: Text + , slot :: Int + } deriving (Eq, Show) + +instance FromJSON TraceNodeIsLeader where + parseJSON = Aeson.withObject "TraceNodeIsLeader" $ \v -> + TraceNodeIsLeader + <$> v .: "kind" + <*> v .: "slot" + +instance FromJSON Kind where + parseJSON = Aeson.withObject "Kind" $ \v -> + Kind <$> v .: "kind" getRelevantLeaderSlots :: FilePath -> Int -> H.PropertyT (ReaderT IntegrationState (ResourceT IO)) [Int] getRelevantLeaderSlots poolNodeStdoutFile slotLowerBound = do vs <- readJsonLines poolNodeStdoutFile leaderSlots <- H.noteShow - $ Maybe.mapMaybe (\v -> v ^? J.key "data" . J.key "val" . J.key "slot" . J._Integer . to fromIntegral) - $ L.filter (\v -> v ^. J.key "data" . J.key "val" . J.key "kind" . J._String == "TraceNodeIsLeader") + $ L.map (slot . data_) + $ Maybe.mapMaybe (Aeson.parseMaybe (Aeson.parseJSON @(LogEntry TraceNodeIsLeader))) vs relevantLeaderSlots <- H.noteShow $ L.filter (>= slotLowerBound) diff --git a/cardano-testnet/src/Testnet/Babbage.hs b/cardano-testnet/src/Testnet/Babbage.hs index 73841c7e5ef..da872edd966 100644 --- a/cardano-testnet/src/Testnet/Babbage.hs +++ b/cardano-testnet/src/Testnet/Babbage.hs @@ -22,7 +22,6 @@ module Testnet.Babbage ) where import Control.Applicative (Applicative(..)) -import Control.Lens ((.~)) import Control.Monad (Monad (..), forM_, void, forM, (=<<), when, fmap, return) import Data.Aeson ((.=)) import Data.Bool (Bool(..)) @@ -42,7 +41,6 @@ import Test.Runtime (Delegator(..), NodeLoggingFormat(..), PaymentKeyP import Text.Show (Show(show)) import qualified Data.Aeson as J -import qualified Data.Aeson.Lens as J import qualified Data.HashMap.Lazy as HM import qualified Data.List as L import qualified Data.Time.Clock as DTC @@ -244,23 +242,24 @@ testnet testnetOptions H.Conf {..} = do H.renameFile (tempAbsPath "genesis.alonzo.json") (tempAbsPath "genesis/shelley/genesis.alonzo.json") H.renameFile (tempAbsPath "genesis.json") (tempAbsPath "genesis/shelley/genesis.json") - H.rewriteJsonFile (tempAbsPath "genesis/byron/genesis.json") - $ J.key "protocolConsts" . J.key "protocolMagic" .~ J.toJSON @Int testnetMagic - - H.rewriteJsonFile (tempAbsPath "genesis/shelley/genesis.json") - ( (J.key "slotLength" .~ J.toJSON @Double 0.1) - . (J.key "activeSlotsCoeff" .~ J.toJSON @Double 0.1) - . (J.key "securityParam" .~ J.toJSON @Int 10) - . (J.key "epochLength" .~ J.toJSON @Int 500) - . (J.key "maxLovelaceSupply" .~ J.toJSON @Int 1000000000000) - . (J.key "minFeeA" .~ J.toJSON @Int 44) - . (J.key "minFeeB" .~ J.toJSON @Int 155381) - . (J.key "minUTxOValue" .~ J.toJSON @Int 1000000) - . (J.key "decentralisationParam" .~ J.toJSON @Double 0.7) - . (J.key "major" .~ J.toJSON @Int 7) - . (J.key "rho" .~ J.toJSON @Double 0.1) - . (J.key "tau" .~ J.toJSON @Double 0.1) - . (J.key "updateQuorum" .~ J.toJSON @Int 2) + H.rewriteJsonFile (tempAbsPath "genesis/byron/genesis.json") $ J.rewriteObject + $ flip HM.adjust "protocolConsts" + ( J.rewriteObject ( HM.insert "protocolMagic" (J.toJSON @Int testnetMagic))) + + H.rewriteJsonFile (tempAbsPath "genesis/shelley/genesis.json") $ J.rewriteObject + ( HM.insert "slotLength" (J.toJSON @Double 0.1) + . HM.insert "activeSlotsCoeff" (J.toJSON @Double 0.1) + . HM.insert "securityParam" (J.toJSON @Int 10) + . HM.insert "epochLength" (J.toJSON @Int 500) + . HM.insert "maxLovelaceSupply" (J.toJSON @Int 1000000000000) + . HM.insert "minFeeA" (J.toJSON @Int 44) + . HM.insert "minFeeB" (J.toJSON @Int 155381) + . HM.insert "minUTxOValue" (J.toJSON @Int 1000000) + . HM.insert "decentralisationParam" (J.toJSON @Double 0.7) + . HM.insert "major" (J.toJSON @Int 7) + . HM.insert "rho" (J.toJSON @Double 0.1) + . HM.insert "tau" (J.toJSON @Double 0.1) + . HM.insert "updateQuorum" (J.toJSON @Int 2) ) H.renameFile (tempAbsPath "pools/vrf1.skey") (tempAbsPath "node-spo1/vrf.skey")