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..4dd3d9f3a41 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/ServerSpec.hs @@ -1,18 +1,63 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} module Cardano.Wallet.Api.ServerSpec (spec) where import Prelude +import Cardano.Slotting.Slot + ( EpochNo (..) ) import Cardano.Wallet.Api.Server - ( Listen (..), ListenError (..), withListeningSocket ) + ( Listen (..) + , ListenError (..) + , getNetworkInformation + , withListeningSocket + ) +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.Maybe + ( isJust, isNothing ) +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.QuickCheck.Modifiers + ( NonNegative (..) ) +import Test.QuickCheck.Monadic + ( PropertyM, assert, monadicIO, monitor, run ) +import Test.QuickCheck.Property + ( counterexample, property ) 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 +98,72 @@ 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 behind\ + \ 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 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 :: 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 + sl + (Quantity $ fromIntegral $ unSlotNo sl) + (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 + 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 start (HF.EraEnd end) 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"))