Merge #2225

2225: Testing pool fetching runtime selection r=piotr-iohk a=piotr-iohk

# Issue Number

#2163 / [ADP-427](https://jira.iohk.io/browse/ADP-427)

# Overview

- 8c0c580
  More detailed description of poolMetadataSource in swagger.yaml
  
- 439f8f0
  Integration test checking metadata is re-synced after settings update
  
- 1d13fd5
  Fix existing stake pool test checking metadata exists


# Comments

![Screenshot from 2020-10-08 14-06-59](https://user-images.githubusercontent.com/42900201/95456553-ca995b80-096f-11eb-89ee-b1b42ae8d40f.png)


Co-authored-by: Piotr Stachyra <piotr.stachyra@iohk.io>

lib/core-integration/src/Test/Integration/Framework/DSL.hs

@@ -659,36 +659,39 @@ a .<= b
 -- 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
             fail $ mconcat
-                [ "Waited longer than 90s (more than 2 epochs) for an action to resolve. "
+                [ "Waited longer than "
+                , show timeout
+                ,"s for an action to resolve. "
                 , "Action: "
                 , show desc
                 , ". Error condition: "

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Settings.hs

@@ -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
@@ -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
     )
 
@@ -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
@@ -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 = 180
+
+        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*)

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs

@@ -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
@@ -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
@@ -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

lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs

@@ -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

specifications/api/swagger.yaml

@@ -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
@@ -3004,7 +3010,7 @@ paths:
       description: |
         <p align="right">status: <strong>stable</strong></p>
 
-        Overwrite current settings
+        Overwrite current settings.
       requestBody:
         required: true
         content: