server: Listen on available TCP port selected at random

exe/wallet/Main.hs

@@ -64,8 +64,6 @@ import Control.Monad
     ( when )
 import Data.Aeson
     ( (.:) )
-import Data.Function
-    ( (&) )
 import Data.Functor
     ( (<&>) )
 import qualified Data.List.NonEmpty as NE
@@ -122,7 +120,6 @@ import qualified Data.ByteString.Lazy.Char8 as BL8
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.IO as TIO
-import qualified Network.Wai.Handler.Warp as Warp
 
 
 cli :: Docopt
@@ -149,7 +146,7 @@ Usage:
   cardano-wallet --version
 
 Options:
-  --port <INT>                port used for serving the wallet API [default: 8090]
+  --port <INT>                port used for serving the wallet API
   --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]
@@ -337,8 +334,8 @@ execHttpBridge
     :: forall n. (KeyToAddress (HttpBridge n), KnownNetwork n)
     => Arguments -> Proxy (HttpBridge n) -> IO ()
 execHttpBridge args _ = do
-    (walletPort :: Int)
-        <- args `parseArg` longOption "port"
+    (walletPort :: Maybe Int)
+        <- args `parseArgMaybe` longOption "port"
     (bridgePort :: Int)
         <- args `parseArg` longOption "bridge-port"
     let dbFile = args `getArg` longOption "database"
@@ -347,12 +344,9 @@ execHttpBridge args _ = do
     waitForConnection nw defaultRetryPolicy
     let tl = HttpBridge.newTransactionLayer @n
     wallet <- newWalletLayer @_ @(HttpBridge n) db nw tl
-    let settings = Warp.defaultSettings
-            & Warp.setPort walletPort
-            & Warp.setBeforeMainLoop (TIO.hPutStrLn stderr $
-                "Wallet backend server listening on: " <> toText walletPort
-            )
-    Server.start settings wallet
+    let logStartup port = TIO.hPutStrLn stderr $
+            "Wallet backend server listening on: " <> toText port
+    Server.start logStartup walletPort wallet
 
 -- | Generate a random mnemonic of the given size 'n' (n = number of words),
 -- and print it to stdout.
@@ -395,5 +389,10 @@ decodeError bytes = do
 parseArg :: FromText a => Arguments -> Option -> IO a
 parseArg = parseArgWith cli
 
+parseArgMaybe :: FromText a => Arguments -> Option -> IO (Maybe a)
+parseArgMaybe args option
+    | args `isPresent` option = Just <$> parseArg args option
+    | otherwise = pure Nothing
+
 parseAllArgs :: FromText a => Arguments -> Option -> IO (NE.NonEmpty a)
 parseAllArgs = parseAllArgsWith cli

lib/core/cardano-wallet-core.cabal

@@ -50,6 +50,7 @@ library
     , http-media
     , memory
     , monad-logger
+    , network
     , path-pieces
     , persistent
     , persistent-sqlite
@@ -59,6 +60,7 @@ library
     , servant
     , servant-server
     , split
+    , streaming-commons
     , text
     , text-class
     , time

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

@@ -4,6 +4,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
@@ -70,12 +71,16 @@ import Cardano.Wallet.Primitive.Types
     , WalletId (..)
     , WalletMetadata (..)
     )
+import Control.Exception
+    ( bracket )
 import Control.Monad.IO.Class
     ( liftIO )
 import Control.Monad.Trans.Except
     ( ExceptT, withExceptT )
 import Data.Aeson
     ( (.=) )
+import Data.Function
+    ( (&) )
 import Data.Generics.Internal.VL.Lens
     ( (^.) )
 import Data.Generics.Labels
@@ -88,6 +93,8 @@ import Data.Proxy
     ( Proxy (..) )
 import Data.Quantity
     ( Quantity (..) )
+import Data.Streaming.Network
+    ( bindPortTCP, bindRandomPortTCP )
 import Data.Text
     ( Text )
 import Data.Text.Class
@@ -100,6 +107,8 @@ import Network.HTTP.Media.RenderHeader
     ( renderHeader )
 import Network.HTTP.Types.Header
     ( hContentType )
+import Network.Socket
+    ( Socket, close )
 import Network.Wai.Middleware.ServantError
     ( handleRawError )
 import Servant
@@ -131,11 +140,25 @@ import qualified Network.Wai.Handler.Warp as Warp
 
 -- | Start the application server
 start
+    :: forall t. (TxId t, KeyToAddress t, EncodeAddress t, DecodeAddress t)
+    => (Warp.Port -> IO ())
+    -> Maybe Warp.Port
+    -> WalletLayer (SeqState t) t
+    -> IO ()
+start logStartup mport wl =
+    withListeningSocket mport $ \(port, socket) -> do
+        let settings = Warp.defaultSettings
+                & Warp.setPort port
+                & Warp.setBeforeMainLoop (logStartup port)
+        startOnSocket settings socket wl
+
+startOnSocket
     :: forall t. (TxId t, KeyToAddress t, EncodeAddress t, DecodeAddress t)
     => Warp.Settings
+    -> Socket
     -> WalletLayer (SeqState t) t
     -> IO ()
-start settings wl = Warp.runSettings settings
+startOnSocket settings socket wl = Warp.runSettingsSocket settings socket
     $ handleRawError handler
     application
   where
@@ -146,6 +169,18 @@ start settings wl = Warp.runSettings settings
     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.
+withListeningSocket :: Maybe Warp.Port -> ((Warp.Port, Socket) -> IO ()) -> IO ()
+withListeningSocket mport = bracket acquire release
+  where
+    acquire = case mport of
+        Just port -> (port,) <$> bindPortTCP port hostPreference
+        Nothing -> bindRandomPortTCP hostPreference
+    release (_, socket) = liftIO $ close socket
+    -- TODO: make configurable, default to secure for now.
+    hostPreference = "127.0.0.1"
+
 {-------------------------------------------------------------------------------
                                     Wallets
 -------------------------------------------------------------------------------}

lib/http-bridge/test/integration/Main.hs

@@ -27,8 +27,6 @@ import Control.Monad
     ( forM, void )
 import Data.Aeson
     ( Value (..), (.:) )
-import Data.Function
-    ( (&) )
 import Data.Proxy
     ( Proxy (..) )
 import Data.Time
@@ -57,7 +55,6 @@ import qualified Cardano.Wallet.HttpBridge.Transaction as HttpBridge
 import qualified Cardano.WalletSpec as Wallet
 import qualified Data.Aeson.Types as Aeson
 import qualified Data.Text as T
-import qualified Network.Wai.Handler.Warp as Warp
 import qualified Test.Integration.Scenario.API.Addresses as Addresses
 import qualified Test.Integration.Scenario.API.Transactions as Transactions
 import qualified Test.Integration.Scenario.API.Wallets as Wallets
@@ -179,8 +176,7 @@ main = hspec $ do
         db <- MVar.newDBLayer
         let tl = HttpBridge.newTransactionLayer
         wallet <- newWalletLayer db nl tl
-        let settings = Warp.defaultSettings & Warp.setPort serverPort
-        Server.start settings wallet
+        Server.start (const $ pure ()) (Just serverPort) wallet
 
     waitForCluster :: String -> IO ()
     waitForCluster addr = do