add command-line option for enabling a pool metadata proxy

Going for a command-line option so that this can easily be turned on and off at will in case of any issue. Plus, not everyone might agree with the idea of going through a registry so hard-coding the registry URL is a no go. cardano-wallet-jormungandr uses an ad-hoc environment variable for this, but a documented option in the command-line is definitely cleaner.
cardano-foundation · Jul 8, 2020 · 3bcc56f · 3bcc56f
1 parent abdb858
commit 3bcc56f
Show file tree

Hide file tree

Showing 7 changed files with 46 additions and 3 deletions.
diff --git a/lib/cli/cardano-wallet-cli.cabal b/lib/cli/cardano-wallet-cli.cabal
@@ -42,6 +42,7 @@ library
     , fmt
     , http-client
     , iohk-monitoring
+    , network-uri
     , servant-client
     , servant-client-core
     , text

diff --git a/lib/cli/src/Cardano/CLI.hs b/lib/cli/src/Cardano/CLI.hs
@@ -53,6 +53,7 @@ module Cardano.CLI
     , stateDirOption
     , syncToleranceOption
     , tlsOption
+    , poolMetadataProxyOption
 
     -- * Option parsers for configuring tracing
     , LoggingOptions (..)
@@ -205,6 +206,8 @@ import Network.HTTP.Client
     , newManager
     , responseTimeoutNone
     )
+import Network.URI
+    ( URI, parseURI )
 import Options.Applicative
     ( ArgumentFields
     , CommandFields
@@ -1301,6 +1304,21 @@ tlsOption = TlsConfiguration
         <> metavar "FILE"
         <> help "The RSA Server key which signed the x.509 server certificate."
 
+poolMetadataProxyOption
+    :: Parser URI
+poolMetadataProxyOption = option (eitherReader reader) $ mempty
+    <> long "pool-metadata-proxy"
+    <> metavar "URI"
+    <> help "An optional URI to a proxy serving pool metadata (e.g. SMASH)"
+  where
+    reader :: String -> Either String URI
+    reader = maybe (Left err) Right . parseURI
+
+    err :: String
+    err =
+        "Invalid URI. Make sure the URI is well formed, with \
+        \a protocol and a host."
+
 -- | <wallet-id=WALLET_ID>
 walletIdArgument :: Parser WalletId
 walletIdArgument = argumentT $ mempty

diff --git a/lib/core/src/Cardano/Pool/Metadata.hs b/lib/core/src/Cardano/Pool/Metadata.hs
@@ -119,7 +119,7 @@ registryUrlBuilder baseUrl _ (StakePoolMetadataHash bytes) =
     hash = T.unpack $ T.decodeUtf8 $ convertToBase Base16 bytes
 
 fetchFromRemote
-    :: (forall m. MonadThrow m => [StakePoolMetadataUrl -> StakePoolMetadataHash -> m URI])
+    :: [StakePoolMetadataUrl -> StakePoolMetadataHash -> ExceptT String IO URI]
     -> Manager
     -> StakePoolMetadataUrl
     -> StakePoolMetadataHash

diff --git a/lib/shelley/cardano-wallet-shelley.cabal b/lib/shelley/cardano-wallet-shelley.cabal
@@ -61,6 +61,7 @@ library
     , memory
     , network
     , network-mux
+    , network-uri
     , optparse-applicative
     , ouroboros-consensus
     , ouroboros-consensus-shelley
@@ -111,6 +112,7 @@ executable cardano-wallet-shelley
     , contra-tracer
     , iohk-monitoring
     , network
+    , network-uri
     , optparse-applicative
     , text
     , text-class

diff --git a/lib/shelley/exe/cardano-wallet-shelley.hs b/lib/shelley/exe/cardano-wallet-shelley.hs
@@ -50,6 +50,7 @@ import Cardano.CLI
     , loggingOptions
     , loggingSeverityOrOffReader
     , loggingTracers
+    , poolMetadataProxyOption
     , runCli
     , setupDirectory
     , shutdownHandlerFlag
@@ -111,6 +112,8 @@ import Data.Text.Class
     ( ToText (..) )
 import Network.Socket
     ( SockAddr )
+import Network.URI
+    ( URI )
 import Options.Applicative
     ( CommandFields
     , Mod
@@ -171,6 +174,7 @@ data ServeArgs = ServeArgs
     , _database :: Maybe FilePath
     , _syncTolerance :: SyncTolerance
     , _enableShutdownHandler :: Bool
+    , _poolMetadataProxy :: Maybe URI
     , _logging :: LoggingOptions TracerSeverities
     } deriving (Show)
 
@@ -190,6 +194,7 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty
         <*> optional databaseOption
         <*> syncToleranceOption
         <*> shutdownHandlerFlag
+        <*> optional poolMetadataProxyOption
         <*> loggingOptions tracerSeveritiesOption
     exec
         :: ServeArgs -> IO ()
@@ -202,6 +207,7 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty
       databaseDir
       sTolerance
       enableShutdownHandler
+      poolMetadataProxy
       logOpt) = do
         withTracers logOpt $ \tr tracers -> do
             installSignalHandlers (logNotice tr MsgSigTerm)
@@ -224,6 +230,7 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty
                     host
                     listen
                     tlsConfig
+                    poolMetadataProxy
                     nodeSocket
                     block0
                     (gp, vData)

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley.hs b/lib/shelley/src/Cardano/Wallet/Shelley.hs
@@ -54,7 +54,12 @@ import Cardano.BM.Trace
 import Cardano.DB.Sqlite
     ( DBLog )
 import Cardano.Pool.Metadata
-    ( defaultManagerSettings, fetchFromRemote, identityUrlBuilder, newManager )
+    ( defaultManagerSettings
+    , fetchFromRemote
+    , identityUrlBuilder
+    , newManager
+    , registryUrlBuilder
+    )
 import Cardano.Wallet
     ( WalletLog )
 import Cardano.Wallet.Api
@@ -142,6 +147,8 @@ import Network.Ntp
     ( NtpClient (..), NtpTrace (..), withWalletNtpClient )
 import Network.Socket
     ( SockAddr, Socket, getSocketName )
+import Network.URI
+    ( URI )
 import Network.Wai.Handler.Warp
     ( setBeforeMainLoop )
 import Network.Wai.Middleware.Logging
@@ -201,6 +208,8 @@ serveWallet
     -- ^ HTTP API Server port.
     -> Maybe TlsConfiguration
     -- ^ An optional TLS configuration
+    -> Maybe URI
+    -- ^ An optional base URI for a pool metadata proxy
     -> FilePath
     -- ^ Socket for communicating with the node
     -> Block
@@ -224,6 +233,7 @@ serveWallet
   hostPref
   listen
   tlsConfig
+  poolMetadataProxy
   socketPath
   block0
   (np, vData)
@@ -300,13 +310,17 @@ serveWallet
         Pool.withDBLayer poolsDbTracer (Pool.defaultFilePath <$> dir) $ \db -> do
             let spl = newStakePoolLayer (genesisParameters np) nl db
             void $ forkFinally (monitorStakePools tr gp nl db) onExit
-            fetch <- fetchFromRemote [identityUrlBuilder]
+            fetch <- fetchFromRemote fetchStrategies
                 <$> newManager defaultManagerSettings
             void $ forkFinally (monitorMetadata tr gp fetch db) onExit
             action spl
       where
         tr = contramap (MsgFromWorker mempty) poolsEngineTracer
         onExit = defaultWorkerAfter poolsEngineTracer
+        fetchStrategies = maybe
+            [identityUrlBuilder]
+            (\proxyUrl -> [registryUrlBuilder proxyUrl, identityUrlBuilder])
+            poolMetadataProxy
 
     apiLayer
         :: forall s k.

diff --git a/lib/shelley/test/integration/Main.hs b/lib/shelley/test/integration/Main.hs
@@ -217,6 +217,7 @@ specWithServer (tr, tracers) = aroundAll withContext . after tearDown
                         "127.0.0.1"
                         ListenOnRandomPort
                         Nothing
+                        Nothing
                         socketPath
                         block0
                         (gp, vData)