From 7b516f2ddb7f27bc86c146e00df4d254edd4afd6 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Tue, 28 Jul 2020 17:36:02 +0200 Subject: [PATCH 1/3] Test getNetworkInformation --- .../src/Cardano/Wallet/Byron/Api/Server.hs | 4 +- lib/core/cardano-wallet-core.cabal | 1 + lib/core/src/Cardano/Wallet/Api/Server.hs | 4 +- .../unit/Cardano/Wallet/Api/ServerSpec.hs | 81 +++++++++++++++++++ .../Cardano/Wallet/Jormungandr/Api/Server.hs | 4 +- .../src/Cardano/Wallet/Shelley/Api/Server.hs | 4 +- nix/.stack.nix/cardano-wallet-core.nix | 1 + 7 files changed, 91 insertions(+), 8 deletions(-) diff --git a/lib/byron/src/Cardano/Wallet/Byron/Api/Server.hs b/lib/byron/src/Cardano/Wallet/Byron/Api/Server.hs index 7448a710ff6..3231e2913da 100644 --- a/lib/byron/src/Cardano/Wallet/Byron/Api/Server.hs +++ b/lib/byron/src/Cardano/Wallet/Byron/Api/Server.hs @@ -282,12 +282,12 @@ server byron icarus ntp = network :: Server Network network = - getNetworkInformation genesis nl + getNetworkInformation syncTolerance nl :<|> getNetworkParameters genesis nl :<|> getNetworkClock ntp where nl = icarus ^. networkLayer @t - genesis = icarus ^. genesisData + genesis@(_,_,syncTolerance) = icarus ^. genesisData proxy :: Server Proxy_ proxy = postExternalTransaction icarus diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal index 03c32a04c17..b5c90e6a66b 100644 --- a/lib/core/cardano-wallet-core.cabal +++ b/lib/core/cardano-wallet-core.cabal @@ -192,6 +192,7 @@ test-suite unit , cardano-addresses , cardano-crypto , cardano-wallet-core + , ouroboros-consensus , cardano-wallet-launcher , cardano-wallet-test-utils , cardano-slotting diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 1737d1d5a4c..5564d810195 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -1544,10 +1544,10 @@ getCurrentEpoch ctx = do getNetworkInformation :: forall t. (HasCallStack) - => (Block, NetworkParameters, SyncTolerance) + => SyncTolerance -> NetworkLayer IO t Block -> Handler ApiNetworkInformation -getNetworkInformation (_block0, _, st) nl = do +getNetworkInformation st nl = do now <- liftIO getCurrentTime nodeTip <- liftHandler (NW.currentNodeTip nl) apiNodeTip <- liftIO $ mkApiBlockReference ti nodeTip diff --git a/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs index 4220d1b2ebc..24883de12ed 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs @@ -1,18 +1,52 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE Rank2Types #-} module Cardano.Wallet.Api.ServerSpec (spec) where import Prelude +import Cardano.Slotting.Slot + ( EpochNo (..) ) import Cardano.Wallet.Api.Server ( Listen (..), ListenError (..), withListeningSocket ) +import Cardano.Wallet.Api.Server + ( getNetworkInformation ) +import Cardano.Wallet.Api.Types + ( ApiNetworkInformation (..) ) +import Cardano.Wallet.Network + ( NetworkLayer (..) ) +import Cardano.Wallet.Primitive.Slotting + ( TimeInterpreter, mkTimeInterpreter ) +import Cardano.Wallet.Primitive.SyncProgress + ( mkSyncTolerance ) +import Cardano.Wallet.Primitive.Types + ( Block (..), BlockHeader (..), Hash (..), SlotNo (..), StartTime (..) ) +import Control.Exception + ( throwIO ) +import Data.Quantity + ( Quantity (..) ) +import Data.Time.Clock + ( addUTCTime, getCurrentTime ) import Network.Socket ( SockAddr (..), getSocketName, tupleToHostAddress ) +import Ouroboros.Consensus.BlockchainTime.WallClock.Types + ( RelativeTime (..), mkSlotLength ) +import Ouroboros.Consensus.Config.SecurityParam + ( SecurityParam (..) ) +import Ouroboros.Consensus.Util.Counting + ( exactlyOne ) +import Servant.Server.Internal.Handler + ( runHandler ) import Test.Hspec ( Spec, describe, it, shouldBe, shouldReturn ) import Test.Utils.Windows ( skipOnWindows ) +import qualified Ouroboros.Consensus.HardFork.History.EraParams as HF +import qualified Ouroboros.Consensus.HardFork.History.Qry as HF +import qualified Ouroboros.Consensus.HardFork.History.Summary as HF + spec :: Spec spec = describe "API Server" $ do it "listens on the local interface" $ do @@ -53,3 +87,50 @@ spec = describe "API Server" $ do withListeningSocket "127.0.0.1" (ListenOnPort port) $ \res -> res `shouldBe` Left (ListenErrorAddressAlreadyInUse (Just port)) Left e -> fail (show e) + + describe "getNetworkInformation" $ do + it "doesn't return 500 when the time interpreter horizon is ahead of\ + \ the current time" $ do + st <- StartTime . ((-1000) `addUTCTime`) <$> getCurrentTime + let ti = either throwIO pure . forkInterpreter st + let nl = dummyNetworkLayer ti + let tolerance = mkSyncTolerance 30 + Right info <- runHandler $ getNetworkInformation tolerance nl + (networkTip info) `shouldBe` Nothing + nextEpoch info `shouldBe` Nothing + where + + dummyNetworkLayer :: TimeInterpreter IO -> NetworkLayer IO () Block + dummyNetworkLayer ti = NetworkLayer + { nextBlocks = error "nextBlocks: not implemented" + , initCursor = error "initCursor: not implemented" + , destroyCursor = error "destroyCursor: not implemented" + , cursorSlotNo = error "cursorSlotNo: not implemented" + , currentNodeTip = return $ + BlockHeader + (SlotNo 100) + (Quantity 100) + (Hash "header hash") + (Hash "prevHeaderHash") + , watchNodeTip = error "todo" + , getProtocolParameters = error "getProtocolParameters: not implemented" + , postTx = error "postTx: not implemented" + , stakeDistribution = error "stakeDistribution: not implemented" + , getAccountBalance = error "getAccountBalance: not implemented" + , timeInterpreter = ti + } + + forkInterpreter startTime = + let + era1 = HF.initBound + era2 = HF.Bound + (RelativeTime 1000) + (SlotNo 1000) + (EpochNo 10) + + era1Params = HF.defaultEraParams (SecurityParam 100) (mkSlotLength 1) + summary = HF.summaryWithExactly $ exactlyOne + (HF.EraSummary era1 (HF.EraEnd era2) era1Params) + int = HF.mkInterpreter summary + in mkTimeInterpreter startTime int + diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs index 373a6d4b14d..f4a3e8e624f 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs @@ -272,12 +272,12 @@ server byron icarus jormungandr spl ntp = network :: Server Network network = - getNetworkInformation genesis nl + getNetworkInformation syncTolerance nl :<|> getNetworkParameters genesis nl :<|> getNetworkClock ntp where nl = jormungandr ^. networkLayer @t - genesis = jormungandr ^. genesisData + genesis@(_,_,syncTolerance) = jormungandr ^. genesisData proxy :: Server Proxy_ proxy = postExternalTransaction jormungandr diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs index ca06c41d70e..7cdd7063b79 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs @@ -310,12 +310,12 @@ server byron icarus shelley spl ntp = network :: Server Network network = - getNetworkInformation genesis nl + getNetworkInformation syncTolerance nl :<|> getNetworkParameters genesis nl :<|> getNetworkClock ntp where nl = icarus ^. networkLayer @t - genesis = icarus ^. genesisData + genesis@(_,_,syncTolerance) = icarus ^. genesisData proxy :: Server Proxy_ proxy = postExternalTransaction icarus diff --git a/nix/.stack.nix/cardano-wallet-core.nix b/nix/.stack.nix/cardano-wallet-core.nix index cae80c6ffa6..2eead7e8df3 100644 --- a/nix/.stack.nix/cardano-wallet-core.nix +++ b/nix/.stack.nix/cardano-wallet-core.nix @@ -116,6 +116,7 @@ (hsPkgs."cardano-addresses" or (errorHandler.buildDepError "cardano-addresses")) (hsPkgs."cardano-crypto" or (errorHandler.buildDepError "cardano-crypto")) (hsPkgs."cardano-wallet-core" or (errorHandler.buildDepError "cardano-wallet-core")) + (hsPkgs."ouroboros-consensus" or (errorHandler.buildDepError "ouroboros-consensus")) (hsPkgs."cardano-wallet-launcher" or (errorHandler.buildDepError "cardano-wallet-launcher")) (hsPkgs."cardano-wallet-test-utils" or (errorHandler.buildDepError "cardano-wallet-test-utils")) (hsPkgs."cardano-slotting" or (errorHandler.buildDepError "cardano-slotting")) From 39390b6eb74f50fb2ffd9231e7ee739d0cd9c610 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Wed, 29 Jul 2020 11:58:02 +0200 Subject: [PATCH 2/3] Convert unit to monadic property test --- .../unit/Cardano/Wallet/Api/ServerSpec.hs | 71 ++++++++++++++----- 1 file changed, 52 insertions(+), 19 deletions(-) diff --git a/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs index 24883de12ed..b11628ea562 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} module Cardano.Wallet.Api.ServerSpec (spec) where @@ -9,9 +10,11 @@ import Prelude import Cardano.Slotting.Slot ( EpochNo (..) ) import Cardano.Wallet.Api.Server - ( Listen (..), ListenError (..), withListeningSocket ) -import Cardano.Wallet.Api.Server - ( getNetworkInformation ) + ( Listen (..) + , ListenError (..) + , getNetworkInformation + , withListeningSocket + ) import Cardano.Wallet.Api.Types ( ApiNetworkInformation (..) ) import Cardano.Wallet.Network @@ -24,6 +27,8 @@ import Cardano.Wallet.Primitive.Types ( Block (..), BlockHeader (..), Hash (..), SlotNo (..), StartTime (..) ) import Control.Exception ( throwIO ) +import Data.Maybe + ( isJust, isNothing ) import Data.Quantity ( Quantity (..) ) import Data.Time.Clock @@ -40,6 +45,12 @@ import Servant.Server.Internal.Handler ( runHandler ) import Test.Hspec ( Spec, describe, it, shouldBe, shouldReturn ) +import Test.QuickCheck.Modifiers + ( NonNegative (..) ) +import Test.QuickCheck.Monadic + ( PropertyM, assert, monadicIO, monitor, run ) +import Test.QuickCheck.Property + ( counterexample, property ) import Test.Utils.Windows ( skipOnWindows ) @@ -90,26 +101,49 @@ spec = describe "API Server" $ do describe "getNetworkInformation" $ do it "doesn't return 500 when the time interpreter horizon is ahead of\ - \ the current time" $ do - st <- StartTime . ((-1000) `addUTCTime`) <$> getCurrentTime + \ the current time" $ property $ \(gap' ::(NonNegative Int)) -> + monadicIO $ do + let gap = fromRational $ toRational $ getNonNegative gap' + st <- run $ StartTime . ((negate gap) `addUTCTime`) + <$> getCurrentTime let ti = either throwIO pure . forkInterpreter st - let nl = dummyNetworkLayer ti - let tolerance = mkSyncTolerance 30 - Right info <- runHandler $ getNetworkInformation tolerance nl - (networkTip info) `shouldBe` Nothing - nextEpoch info `shouldBe` Nothing + let nodeTip' = SlotNo 0 + let nl = dummyNetworkLayer nodeTip' ti + let tolerance = mkSyncTolerance 5 + Right info <- run $ runHandler $ getNetworkInformation tolerance nl + + -- 0 20 + -- * | * + -- Node tip Horizon Network Tip + -- <------------------------> + -- gap + -- + -- 20 = epoch length = 10*k + if gap >= 20 + then do + assertWith "networkTip is Nothing" $ isNothing $ networkTip info + assertWith "nextEpoch is Nothing" $ isNothing $ nextEpoch info + else do + assertWith "networkTip is Just " $ isJust $ networkTip info + assertWith "nextEpoch is Just" $ isJust $ nextEpoch info + where + assertWith :: String -> Bool -> PropertyM IO () + assertWith lbl condition = do + let flag = if condition then "✓" else "✗" + monitor (counterexample $ lbl <> " " <> flag) + assert condition - dummyNetworkLayer :: TimeInterpreter IO -> NetworkLayer IO () Block - dummyNetworkLayer ti = NetworkLayer + dummyNetworkLayer :: SlotNo -> TimeInterpreter IO -> NetworkLayer IO () Block + dummyNetworkLayer sl ti = NetworkLayer { nextBlocks = error "nextBlocks: not implemented" , initCursor = error "initCursor: not implemented" , destroyCursor = error "destroyCursor: not implemented" , cursorSlotNo = error "cursorSlotNo: not implemented" , currentNodeTip = return $ BlockHeader - (SlotNo 100) - (Quantity 100) + sl + (Quantity $ fromIntegral $ unSlotNo sl) (Hash "header hash") (Hash "prevHeaderHash") , watchNodeTip = error "todo" @@ -124,13 +158,12 @@ spec = describe "API Server" $ do let era1 = HF.initBound era2 = HF.Bound - (RelativeTime 1000) - (SlotNo 1000) - (EpochNo 10) + (RelativeTime 20) + (SlotNo 20) + (EpochNo 1) - era1Params = HF.defaultEraParams (SecurityParam 100) (mkSlotLength 1) + era1Params = HF.defaultEraParams (SecurityParam 2) (mkSlotLength 1) summary = HF.summaryWithExactly $ exactlyOne (HF.EraSummary era1 (HF.EraEnd era2) era1Params) int = HF.mkInterpreter summary in mkTimeInterpreter startTime int - From 3b6daca297d63e42c58d8a49c78ddafef8e92c22 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Wed, 29 Jul 2020 12:16:03 +0200 Subject: [PATCH 3/3] Fixups --- lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs index b11628ea562..4dd3d9f3a41 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs @@ -100,7 +100,7 @@ spec = describe "API Server" $ do Left e -> fail (show e) describe "getNetworkInformation" $ do - it "doesn't return 500 when the time interpreter horizon is ahead of\ + it "doesn't return 500 when the time interpreter horizon is behind\ \ the current time" $ property $ \(gap' ::(NonNegative Int)) -> monadicIO $ do let gap = fromRational $ toRational $ getNonNegative gap' @@ -156,14 +156,14 @@ spec = describe "API Server" $ do forkInterpreter startTime = let - era1 = HF.initBound - era2 = HF.Bound + start = HF.initBound + end = HF.Bound (RelativeTime 20) (SlotNo 20) (EpochNo 1) era1Params = HF.defaultEraParams (SecurityParam 2) (mkSlotLength 1) - summary = HF.summaryWithExactly $ exactlyOne - (HF.EraSummary era1 (HF.EraEnd era2) era1Params) + summary = HF.summaryWithExactly $ exactlyOne $ + HF.EraSummary start (HF.EraEnd end) era1Params int = HF.mkInterpreter summary in mkTimeInterpreter startTime int