Merge pull request #407 from input-output-hk/paweljakubas/401/port-ar…

…g-bug

Fix CLI port argument bug.

exe/launcher/Main.hs

@@ -73,7 +73,6 @@ Usage:
 
 Options:
   --network <STRING>           testnet, mainnet, or local [default: testnet]
-  --wallet-server-port <PORT>  port used for serving the wallet API [default: 8090]
   --http-bridge-port <PORT>    port used for communicating with the http-bridge [default: 8080]
   --state-dir <DIR>            write wallet state (blockchain and database) to this directory
 |]
@@ -90,14 +89,13 @@ main = do
     let stateDir = args `getArg` (longOption "state-dir")
     let network = fromMaybe "testnet" $ args `getArg` (longOption "network")
     bridgePort <- args `parseArg` longOption "http-bridge-port"
-    walletPort <- args `parseArg` longOption "wallet-server-port"
 
     sayErr "Starting..."
     installSignalHandlers
     maybe (pure ()) setupStateDir stateDir
     let commands =
             [ nodeHttpBridgeOn stateDir bridgePort network
-            , walletOn stateDir walletPort bridgePort network
+            , walletOn stateDir bridgePort network
             ]
     sayErr $ fmt $ blockListF commands
     (ProcessHasExited name code) <- launch commands
@@ -107,7 +105,11 @@ main = do
     parseArg :: FromText a => Arguments -> Option -> IO a
     parseArg = parseArgWith cli
 
-nodeHttpBridgeOn :: Maybe FilePath -> Port "Node" -> String -> Command
+nodeHttpBridgeOn
+    :: Maybe FilePath
+    -> Port "Node"
+    -> String
+    -> Command
 nodeHttpBridgeOn stateDir port net =
     Command "cardano-http-bridge" args (return ()) Inherit
   where
@@ -118,18 +120,24 @@ nodeHttpBridgeOn stateDir port net =
         ] ++ networkArg
     networkArg = maybe [] (\d -> ["--networks-dir", d]) stateDir
 
-walletOn :: Maybe FilePath -> Port "Wallet" -> Port "Node" -> String -> Command
-walletOn stateDir wp np net =
+walletOn
+    :: Maybe FilePath
+    -> Port "Node"
+    -> String
+    -> Command
+walletOn stateDir np net =
     Command "cardano-wallet" args (threadDelay oneSecond) Inherit
   where
-    args =
-        [ "server"
-        , "--network", if net == "local" then "testnet" else net
-        , "--port", T.unpack (toText wp)
-        , "--bridge-port", T.unpack (toText np)
-        ] ++ dbArg
-    dbArg = maybe [] (\d -> ["--database", d </> "wallet.db"]) stateDir
     oneSecond = 1000000
+    args = mconcat
+        [ [ "server" ]
+        , [ "--network", if net == "local" then "testnet" else net ]
+        , ["--random-port"]
+        , [ "--bridge-port", showT np ]
+        , maybe [] (\d -> ["--database", d </> "wallet.db"]) stateDir
+        ]
+    showT :: ToText a => a -> String
+    showT = T.unpack . toText
 
 setupStateDir :: FilePath -> IO ()
 setupStateDir dir = doesDirectoryExist dir >>= \case

exe/wallet/Main.hs

@@ -31,7 +31,7 @@ import Cardano.BM.Configuration.Static
 import Cardano.BM.Setup
     ( setupTrace )
 import Cardano.BM.Trace
-    ( Trace, appendName )
+    ( Trace, appendName, logInfo )
 import Cardano.CLI
     ( getLine
     , getSensitiveLine
@@ -140,7 +140,7 @@ and can be run "offline". (e.g. 'generate mnemonic')
     ⚠️  Options are positional (--a --b is not equivalent to --b --a) ! ⚠️
 
 Usage:
-  cardano-wallet server [--network=STRING] [--port=INT] [--bridge-port=INT] [--database=FILE]
+  cardano-wallet server [--network=STRING] [(--port=INT | --random-port)] [--bridge-port=INT] [--database=FILE]
   cardano-wallet mnemonic generate [--size=INT]
   cardano-wallet wallet list [--port=INT]
   cardano-wallet wallet create [--port=INT] <name> [--address-pool-gap=INT]
@@ -153,7 +153,8 @@ Usage:
   cardano-wallet --version
 
 Options:
-  --port <INT>                port used for serving the wallet API
+  --port <INT>                port used for serving the wallet API [default: 8090]
+  --random-port               serve wallet API on any available port (conflicts with --port)
   --bridge-port <INT>         port used for communicating with the http-bridge [default: 8080]
   --address-pool-gap <INT>    number of unused consecutive addresses to keep track of [default: 20]
   --size <INT>                number of mnemonic words to generate [default: 15]
@@ -375,8 +376,7 @@ execHttpBridge
     => Arguments -> Proxy (HttpBridge n) -> IO ()
 execHttpBridge args _ = do
     tracer <- initTracer
-    (walletPort :: Maybe Int)
-        <- args `parseOptionalArg` longOption "port"
+    walletListen <- getWalletListen args
     (bridgePort :: Int)
         <- args `parseArg` longOption "bridge-port"
     let dbFile = args `getArg` longOption "database"
@@ -385,9 +385,17 @@ execHttpBridge args _ = do
     waitForConnection nw defaultRetryPolicy
     let tl = HttpBridge.newTransactionLayer @n
     wallet <- newWalletLayer @_ @(HttpBridge n) tracer block0 db nw tl
-    let logStartup port = TIO.hPutStrLn stderr $
+    let logStartup port = logInfo tracer $
             "Wallet backend server listening on: " <> toText port
-    Server.start logStartup walletPort wallet
+    Server.start logStartup walletListen wallet
+
+getWalletListen :: Arguments -> IO Server.Listen
+getWalletListen args = do
+    let useRandomPort = args `isPresent` longOption "random-port"
+    walletPort <- args `parseArg` longOption "port"
+    pure $ case (useRandomPort, walletPort) of
+        (True, _) -> Server.ListenOnRandomPort
+        (False, port) -> Server.ListenOnPort port
 
 -- | Generate a random mnemonic of the given size 'n' (n = number of words),
 -- and print it to stdout.

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -17,6 +17,7 @@
 
 module Cardano.Wallet.Api.Server
     ( start
+    , Listen (..)
     ) where
 
 import Prelude
@@ -74,6 +75,8 @@ import Cardano.Wallet.Primitive.Types
     )
 import Control.Exception
     ( bracket )
+import Control.Monad
+    ( void )
 import Control.Monad.IO.Class
     ( liftIO )
 import Control.Monad.Trans.Except
@@ -110,6 +113,8 @@ import Network.HTTP.Types.Header
     ( hContentType )
 import Network.Socket
     ( Socket, close )
+import Network.Wai.Handler.Warp
+    ( Port )
 import Network.Wai.Middleware.ServantError
     ( handleRawError )
 import Servant
@@ -139,19 +144,28 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Network.Wai.Handler.Warp as Warp
 
+-- | How the server should listen for incoming requests.
+data Listen
+    = ListenOnPort Port
+      -- ^ Listen on given TCP port
+    | ListenOnRandomPort
+      -- ^ Listen on an unused TCP port, selected at random
+    deriving (Show, Eq)
+
 -- | Start the application server
 start
     :: forall t. (TxId t, KeyToAddress t, EncodeAddress t, DecodeAddress t)
-    => (Warp.Port -> IO ())
-    -> Maybe Warp.Port
+    => (Port -> IO ())
+    -> Listen
     -> WalletLayer (SeqState t) t
     -> IO ()
-start onStartup mport wl =
-    withListeningSocket mport $ \(port, socket) -> do
+start onStartup portOption wl =
+    void $ withListeningSocket portOption $ \(port, socket) -> do
         let settings = Warp.defaultSettings
                 & Warp.setPort port
                 & Warp.setBeforeMainLoop (onStartup port)
         startOnSocket settings socket wl
+        pure port
 
 startOnSocket
     :: forall t. (TxId t, KeyToAddress t, EncodeAddress t, DecodeAddress t)
@@ -170,17 +184,17 @@ startOnSocket settings socket wl = Warp.runSettingsSocket settings socket
     application :: Application
     application = serve (Proxy @("v2" :> Api t)) server
 
--- | Run an action with a TCP socket bound to a port. If no port is specified,
--- then an unused port will be selected at random.
+-- | Run an action with a TCP socket bound to a port specified by the `Listen`
+-- parameter.
 withListeningSocket
-    :: Maybe Warp.Port
-    -> ((Warp.Port, Socket) -> IO ())
-    -> IO ()
-withListeningSocket mport = bracket acquire release
+    :: Listen
+    -> ((Port, Socket) -> IO Port)
+    -> IO Port
+withListeningSocket portOpt = bracket acquire release
   where
-    acquire = case mport of
-        Just port -> (port,) <$> bindPortTCP port hostPreference
-        Nothing -> bindRandomPortTCP hostPreference
+    acquire = case portOpt of
+        ListenOnPort port -> (port,) <$> bindPortTCP port hostPreference
+        ListenOnRandomPort -> bindRandomPortTCP hostPreference
     release (_, socket) = liftIO $ close socket
     -- TODO: make configurable, default to secure for now.
     hostPreference = "127.0.0.1"

lib/core/test/integration/Test/Integration/Framework/DSL.hs

@@ -153,6 +153,8 @@ import Language.Haskell.TH.Quote
     ( QuasiQuoter )
 import Network.HTTP.Types.Method
     ( Method )
+import Network.Wai.Handler.Warp
+    ( Port )
 import Numeric.Natural
     ( Natural )
 import System.Command
@@ -539,8 +541,8 @@ emptyWalletWith ctx (name, passphrase, addrPoolGap) = do
 fixtureWallet
     :: Context t
     -> IO ApiWallet
-fixtureWallet ctx@(Context _ _ _ faucet _ _) = do
-    mnemonics <- mnemonicToText <$> nextWallet faucet
+fixtureWallet ctx = do
+    mnemonics <- mnemonicToText <$> nextWallet (_faucet ctx)
     let payload = Json [aesonQQ| {
             "name": "Faucet Wallet",
             "mnemonic_sentence": #{mnemonics},
@@ -738,16 +740,19 @@ generateMnemonicsViaCLI args = cardanoWalletCLI
     (["mnemonic", "generate"] ++ args)
 
 createWalletViaCLI
-    :: [String]
+    :: HasType Port s
+    => s
+    -> [String]
     -> String
     -> String
     -> String
     -> IO (ExitCode, String, Text)
-createWalletViaCLI args mnemonics secondFactor passphrase = do
+createWalletViaCLI ctx args mnemonics secondFactor passphrase = do
+    let portArg =
+            [ "--port", show (ctx ^. typed @Port) ]
     let fullArgs =
-            [ "exec", "--", "cardano-wallet"
-            , "wallet", "create", "--port", "1337"
-            ] ++ args
+            [ "exec", "--", "cardano-wallet", "wallet", "create" ]
+            ++ portArg ++ args
     let process = (proc "stack" fullArgs)
             { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }
     withCreateProcess process $ \(Just stdin) (Just stdout) (Just stderr) h -> do
@@ -762,31 +767,36 @@ createWalletViaCLI args mnemonics secondFactor passphrase = do
         err <- TIO.hGetContents stderr
         return (c, T.unpack out, err)
 
-deleteWalletViaCLI :: CmdResult r => String -> IO r
-deleteWalletViaCLI walId = cardanoWalletCLI
-    ["wallet", "delete", "--port", "1337", walId ]
+deleteWalletViaCLI :: (CmdResult r, HasType Port s) => s -> String -> IO r
+deleteWalletViaCLI ctx walId = cardanoWalletCLI
+    ["wallet", "delete", "--port", show (ctx ^. typed @Port), walId ]
 
-getWalletViaCLI :: CmdResult r => String -> IO r
-getWalletViaCLI walId = cardanoWalletCLI
-    ["wallet", "get", "--port", "1337" , walId ]
+getWalletViaCLI :: (CmdResult r, HasType Port s) => s -> String -> IO r
+getWalletViaCLI ctx walId = cardanoWalletCLI
+    ["wallet", "get", "--port", show (ctx ^. typed @Port) , walId ]
 
-listAddressesViaCLI :: CmdResult r => [String] -> IO r
-listAddressesViaCLI args = cardanoWalletCLI
-    (["address", "list", "--port", "1337"] ++ args)
+listAddressesViaCLI :: (CmdResult r, HasType Port s) => s -> [String] -> IO r
+listAddressesViaCLI ctx args = cardanoWalletCLI
+    (["address", "list", "--port", show (ctx ^. typed @Port)] ++ args)
 
-listWalletsViaCLI :: CmdResult r => IO r
-listWalletsViaCLI = cardanoWalletCLI
-    ["wallet", "list", "--port", "1337" ]
+listWalletsViaCLI :: (CmdResult r, HasType Port s) => s -> IO r
+listWalletsViaCLI ctx = cardanoWalletCLI
+    ["wallet", "list", "--port", show (ctx ^. typed @Port) ]
 
-updateWalletViaCLI :: CmdResult r => [String] -> IO r
-updateWalletViaCLI args = cardanoWalletCLI
-    (["wallet", "update", "--port", "1337"] ++ args)
+updateWalletViaCLI :: (CmdResult r, HasType Port s) => s -> [String] -> IO r
+updateWalletViaCLI ctx args = cardanoWalletCLI
+    (["wallet", "update", "--port", show (ctx ^. typed @Port)] ++ args)
 
-postTransactionViaCLI :: String -> [String] ->  IO (ExitCode, String, Text)
-postTransactionViaCLI passphrase args = do
+postTransactionViaCLI
+    :: HasType Port s
+    => s
+    -> String
+    -> [String]
+    -> IO (ExitCode, String, Text)
+postTransactionViaCLI ctx passphrase args = do
     let fullArgs =
             [ "exec", "--", "cardano-wallet"
-            , "transaction", "create", "--port", "1337"
+            , "transaction", "create", "--port", show (ctx ^. typed @Port)
             ] ++ args
     let process = (proc "stack" fullArgs)
             { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }

lib/core/test/integration/Test/Integration/Framework/Request.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
@@ -33,6 +34,8 @@ import Data.Text
     ( Text )
 import Database.Persist.Sqlite
     ( SqlBackend )
+import GHC.Generics
+    ( Generic )
 import Network.HTTP.Client
     ( HttpException (..)
     , HttpExceptionContent
@@ -52,6 +55,8 @@ import Network.HTTP.Types.Method
     ( Method )
 import Network.HTTP.Types.Status
     ( status500 )
+import Network.Wai.Handler.Warp
+    ( Port )
 import System.IO
     ( Handle )
 import Test.Integration.Faucet
@@ -71,6 +76,9 @@ data Context t = Context
     , _manager
         :: (Text, Manager)
         -- ^ The underlying BaseUrl and Manager used by the Wallet Client
+    , _port
+        :: Port
+        -- ^ Server TCP port
     , _logs
         :: Handle
         -- ^ A file 'Handle' to the launcher log output
@@ -82,7 +90,7 @@ data Context t = Context
         -- ^ A database connection handle
     , _target
         :: Proxy t
-    }
+    } deriving Generic
 
 -- | The result when 'request' fails.
 data RequestException
@@ -125,7 +133,8 @@ request
     -> Payload
         -- ^ Request body
     -> m (HTTP.Status, Either RequestException a)
-request (Context _ (base, manager) _ _ _ _) (verb, path) reqHeaders body = do
+request ctx (verb, path) reqHeaders body = do
+    let (base, manager) = _manager ctx
     req <- parseRequest $ T.unpack $ base <> path
     let io = handleResponse <$> liftIO (httpLbs (prepareReq req) manager)
     catch io handleException