Skip to content

Commit

Permalink
Try #2225:
Browse files Browse the repository at this point in the history
  • Loading branch information
iohk-bors[bot] committed Oct 16, 2020
2 parents 6c38409 + 36b1f60 commit cdbf5a4
Show file tree
Hide file tree
Showing 6 changed files with 93 additions and 27 deletions.
28 changes: 15 additions & 13 deletions lib/core-integration/src/Test/Integration/Framework/DSL.hs
Expand Up @@ -668,35 +668,37 @@ expectationFailure' msg = do
-- has been retried enough.
--
-- It is like 'eventuallyUsingDelay', but with the default delay of 500 ms
-- between retries.
-- and timeout of 120s between retries.
-- NOTE
-- This __120s__ is mostly justified by the parameters in the shelley
-- genesis. The longest action we have two wait for are about 2 epochs,
-- which corresponds to 80s with the current parameters. Using something
-- much longer than that isn't really useful (in particular, this doesn't
-- depend on the host machine running the test, because the protocol moves
-- forward at the same speed regardless...)
eventually :: String -> IO a -> IO a
eventually = eventuallyUsingDelay (500 * ms)
eventually = eventuallyUsingDelay (500 * ms) 120
where
ms = 1000

-- Retry the given action a couple of time until it doesn't throw, or until it
-- has been retried enough.
--
-- It sleeps for a specified delay between retries.
-- It sleeps for a specified delay between retries and fails after timeout.
eventuallyUsingDelay
:: Int -- ^ Delay in microseconds
-> Int -- ^ Timeout in seconds
-> String -- ^ Brief description of the IO action
-> IO a
-> IO a
eventuallyUsingDelay delay desc io = do
eventuallyUsingDelay delay timeout desc io = do
lastErrorRef <- newIORef Nothing
-- NOTE
-- This __90s__ is mostly justified by the parameters in the shelley
-- genesis. The longest action we have two wait for are about 2 epochs,
-- which corresponds to 80s with the current parameters. Using something
-- much longer than that isn't really useful (in particular, this doesn't
-- depend on the host machine running the test, because the protocol moves
-- forward at the same speed regardless...)
winner <- race (threadDelay $ 90 * oneSecond) (trial lastErrorRef)
winner <- race (threadDelay $ timeout * oneSecond) (trial lastErrorRef)
case winner of
Left () -> do
lastError <- readIORef lastErrorRef
let msg = "Waited longer than 90s (more than 2 epochs) to resolve action: " ++ show desc ++ "."
let msg = "Waited longer than " ++ show timeout ++
"s to resolve action: " ++ show desc ++ "."
case fromException @HUnitFailure =<< lastError of
Just lastError' -> throwIO $ appendFailureReason msg lastError'
Nothing ->
Expand Down
Expand Up @@ -12,12 +12,18 @@

module Test.Integration.Scenario.API.Shelley.Settings
( spec
, updateMetadataSource
) where

import Prelude

import Cardano.Wallet.Api.Types
( ApiT (..), DecodeAddress, DecodeStakeAddress, EncodeAddress (..) )
( ApiStakePool
, ApiT (..)
, DecodeAddress
, DecodeStakeAddress
, EncodeAddress (..)
)
import Cardano.Wallet.Primitive.AddressDerivation
( PaymentAddress )
import Cardano.Wallet.Primitive.AddressDerivation.Byron
Expand All @@ -27,22 +33,30 @@ import Cardano.Wallet.Primitive.AddressDerivation.Icarus
import Cardano.Wallet.Primitive.AddressDerivation.Shelley
( ShelleyKey )
import Cardano.Wallet.Primitive.Types
( PoolMetadataSource, Settings )
( Coin (..), PoolMetadataSource (..), Settings )
import Data.Generics.Internal.VL.Lens
( view )
import Data.Maybe
( isJust, isNothing )
import Data.Text
( Text )
import Data.Text.Class
( fromText )
import Test.Hspec
( SpecWith, describe, shouldBe )
( SpecWith, describe, shouldBe, shouldSatisfy )
import Test.Hspec.Extra
( it )
import Test.Integration.Framework.DSL
( Context (..)
, Headers (..)
, Payload (..)
, eventually
, eventuallyUsingDelay
, expectField
, expectResponseCode
, json
, request
, unsafeRequest
, verify
)

Expand All @@ -60,14 +74,7 @@ spec :: forall n t.
spec = describe "SHELLEY_SETTINGS" $ do
it "SETTINGS_01 - Can put and read settings" $ \ctx -> do
let uri = "http://smash.it"
payload = Json [json| {
"settings": {
"pool_metadata_source": #{uri}
}
} |]
r <- request @(ApiT Settings) ctx Link.putSettings Default
payload
expectResponseCode @IO HTTP.status204 r
updateMetadataSource ctx uri
eventually "The settings are applied" $ do
r2 <- request @(ApiT Settings) ctx Link.getSettings Default Empty
verify r2
Expand All @@ -76,3 +83,48 @@ spec = describe "SHELLEY_SETTINGS" $ do
(`shouldBe` (either (const (error "no")) id $ fromText
@PoolMetadataSource uri))
]

it "SETTINGS_02 - Changing pool_metadata_source re-syncs metadata" $ \ctx -> do
let toNone = "none"
toDirect = "direct"
getMetadata = fmap (view #metadata) . snd <$> unsafeRequest
@[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty
delay = 500 * 1000
timeout = 300

updateMetadataSource ctx toNone
verifyMetadataSource ctx FetchNone
eventuallyUsingDelay delay timeout "1. There is no metadata" $
getMetadata >>= (`shouldSatisfy` all isNothing)

updateMetadataSource ctx toDirect
verifyMetadataSource ctx FetchDirect
eventuallyUsingDelay delay timeout "2. There is metadata" $
getMetadata >>= (`shouldSatisfy` all isJust)

updateMetadataSource ctx toNone
verifyMetadataSource ctx FetchNone
eventuallyUsingDelay delay timeout "3. There is no metadata" $
getMetadata >>= (`shouldSatisfy` all isNothing)


updateMetadataSource :: Context t -> Text -> IO ()
updateMetadataSource ctx t = do
r <- request @(ApiT Settings) ctx Link.putSettings Default payload
expectResponseCode @IO HTTP.status204 r
where
payload = Json [json| {
"settings": {
"pool_metadata_source": #{t}
}
} |]

verifyMetadataSource :: Context t -> PoolMetadataSource -> IO ()
verifyMetadataSource ctx s = do
r <- request @(ApiT Settings) ctx Link.getSettings Default Empty
expectResponseCode @IO HTTP.status200 r
expectField (#getApiT . #poolMetadataSource) (`shouldBe` s) r

arbitraryStake :: Maybe Coin
arbitraryStake = Just $ ada 10_000
where ada = Coin . (1000*1000*)
Expand Up @@ -112,6 +112,8 @@ import Test.Integration.Framework.TestData
, errMsg404NoSuchPool
, errMsg404NoWallet
)
import Test.Integration.Scenario.API.Shelley.Settings
( updateMetadataSource )

import qualified Cardano.Wallet.Api.Link as Link
import qualified Data.ByteString as BS
Expand Down Expand Up @@ -735,6 +737,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
saturation `shouldSatisfy` (any (> 0))

it "contains pool metadata" $ \ctx -> do
updateMetadataSource ctx "direct"
eventually "metadata is fetched" $ do
r <- listPools ctx arbitraryStake
let metadataPossible = Set.fromList
Expand Down Expand Up @@ -771,6 +774,8 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
mapMaybe (fmap getApiT . view #metadata) pools
metadataActual
`shouldSatisfy` (`Set.isSubsetOf` metadataPossible)
metadataActual
`shouldSatisfy` (not . Set.null)
]

it "contains and is sorted by non-myopic-rewards" $ \ctx -> do
Expand Down
Expand Up @@ -235,7 +235,7 @@ spec = do
-- This might take a few tries (epoch changes), so it is only feasible
-- to test with very short epochs.
let ms = 1000
eventuallyUsingDelay (50*ms)
eventuallyUsingDelay (50*ms) 100
"Shows error when listing stake pools on epoch boundaries"
$ do
r <- request @[ApiStakePool] ctx Link.listJormungandrStakePools Default Empty
Expand Down
1 change: 1 addition & 0 deletions nix/haskell.nix
Expand Up @@ -77,6 +77,7 @@ let
unit.preCheck = lib.optionalString stdenv.isDarwin "export TMPDIR=/tmp";
integration.preCheck = ''
# Variables picked up by integration tests
export CARDANO_WALLET_TRACING_MIN_SEVERITY=info
export CARDANO_NODE_TRACING_MIN_SEVERITY=notice
# Integration tests will place logs here
Expand Down
10 changes: 8 additions & 2 deletions specifications/api/swagger.yaml
Expand Up @@ -329,7 +329,13 @@ x-settings: &settings
properties:
pool_metadata_source:
<<: *poolMetadataSource
description: How to fetch pool metadata
description: |
Select stake pool metadata fetching strategy:
- `none` - metadata is not fetched at all,
- `direct` - metadata is fetched directly from chain,
- `uri` - metadata is fetched from the external Stake-Pool Metadata Aggregation Server (SMASH)
After update existing metadata will be dropped forcing it to re-sync automatically with the new setting.
x-walletMnemonicSentence: &walletMnemonicSentence
description: A list of mnemonic words
Expand Down Expand Up @@ -3007,7 +3013,7 @@ paths:
description: |
<p align="right">status: <strong>stable</strong></p>
Overwrite current settings
Overwrite current settings.
requestBody:
required: true
content:
Expand Down

0 comments on commit cdbf5a4

Please sign in to comment.