Merge #3530

3530: Extract cardano-wallet-api-http library r=Unisay a=Unisay In order to unlock evolution of the Wallet’s API as described in [this document](https://docs.google.com/document/d/17tM0VKFBLFRULVI2k1y67uEViEK1jtihg94IT77iH08/edit?usp=sharing), this PR separates a core wallet functionality (library) from its HTTP API (Servant) by using a separate cabal [internal] libraries. - [x] Extract `cardano-wallet-api-http` [internal] cabal library. - [x] Extract `mock-token-metadata` [internal] cabal library. - [x] Extract `mock-token-metadata` executable. - [x] Extract `wai-middleware-logging` [internal] cabal library. - [x] Rename `Cardano.Wallet.Api.XXX` to `Cardano.Wallet.Api.Http.XXX` at several occasions as we're shifting towards a "1 wallet library `N` API's" model, where `HTTP` is one point in `N`. Stake pool functionality used API-types so I had to decouple it: - [x] Replace `ApiPoolId` with the `ApiT PoolId`; - [x] Replace `ApiStakePool` with the `ApiT StakePool`; - [x] Remove `apiPool` type parameter from the API definition as it wasn't used with different types anyway; ### Issue Number ADP-2522 Co-authored-by: Yura Lazarev <[email protected]>
cardano-foundation · Oct 18, 2022 · 45f7bc9 · 45f7bc9
2 parents c3e2e61 + 7d52ebf
commit 45f7bc9
Show file tree

Hide file tree

Showing 72 changed files with 1,704 additions and 1,319 deletions.
diff --git a/cabal.project b/cabal.project
@@ -49,6 +49,7 @@ packages:
   , lib/text-class/
   , lib/test-utils/
   , lib/strict-non-empty-containers/
+  , lib/wai-middleware-logging/
 
 -- Using RDRAND instead of /dev/urandom as an entropy source for key
 -- generation is dubious. Set the flag so we use /dev/urandom by default.
@@ -381,7 +382,7 @@ package cardano-wallet
   tests: True
   ghc-options: -fwrite-ide-info
 
-package cardano-wallet
+package cardano-wallet-api-http
   tests: True
   ghc-options: -fwrite-ide-info
 
@@ -413,6 +414,10 @@ package strict-non-empty-containers
   tests: True
   ghc-options: -fwrite-ide-info
 
+package wai-middleware-logging
+  tests: True
+  ghc-options: -fwrite-ide-info
+
 -- Now disable all other tests with a global flag.
 -- This is what they do in cardano-node/cabal.project.
 

diff --git a/...let/src/Network/Wai/Middleware/Logging.hs → ...ing/src/Network/Wai/Middleware/Logging.hs b/...let/src/Network/Wai/Middleware/Logging.hs → ...ing/src/Network/Wai/Middleware/Logging.hs
@@ -78,10 +78,7 @@ import qualified Data.Text.Encoding as T
 --
 -- The logger logs requests' and responses' bodies along with a few other
 -- useful piece of information.
-withApiLogger
-    :: Tracer IO ApiLog
-    -> ApiLoggerSettings
-    -> Middleware
+withApiLogger :: Tracer IO ApiLog -> ApiLoggerSettings -> Middleware
 withApiLogger t0 settings app req0 sendResponse = do
     rid <- nextRequestId settings
     let t = contramap (ApiLog rid) t0

diff --git a/...src/Network/Wai/Middleware/ServerError.hs → ...src/Network/Wai/Middleware/ServerError.hs b/...src/Network/Wai/Middleware/ServerError.hs → ...src/Network/Wai/Middleware/ServerError.hs
@@ -55,9 +55,7 @@ handleRawError adjust app req send =
 
 -- | Analyze whether a given error is a raw error thrown by Servant before
 -- reaching our application layer, or one from our application layer.
-eitherRawError
-    :: Response
-    -> Either ServerError Response
+eitherRawError :: Response -> Either ServerError Response
 eitherRawError res =
     let
         status = responseStatus res
@@ -74,15 +72,9 @@ eitherRawError res =
 -- | Extract raw body of a response, only if it suitables for transformation.
 -- Servant doesn't return files or streams by default, so if one of the two is
 -- met, it means it comes from our application layer anyway.
-responseBody
-  :: Response
-  -> Maybe ByteString
+responseBody :: Response -> Maybe ByteString
 responseBody = \case
-    ResponseBuilder _ _ b ->
-        Just (Binary.toLazyByteString b)
-    ResponseRaw _ r ->
-        responseBody r
-    ResponseFile{} ->
-        Nothing
-    ResponseStream{} ->
-        Nothing
+    ResponseBuilder _ _ b -> Just (Binary.toLazyByteString b)
+    ResponseRaw _ r -> responseBody r
+    ResponseFile{} -> Nothing
+    ResponseStream{} -> Nothing
diff --git a/lib/wai-middleware-logging/test/Main.hs b/lib/wai-middleware-logging/test/Main.hs
@@ -0,0 +1,13 @@
+module Main where
+
+import Prelude
+
+import Main.Utf8
+    ( withUtf8 )
+import Test.Hspec.Extra
+    ( hspecMain )
+
+import qualified Network.Wai.Middleware.LoggingSpec as LoggingSpec
+
+main :: IO ()
+main = withUtf8 $ hspecMain LoggingSpec.spec
diff --git a/...nit/Network/Wai/Middleware/LoggingSpec.hs → ...est/Network/Wai/Middleware/LoggingSpec.hs b/...nit/Network/Wai/Middleware/LoggingSpec.hs → ...est/Network/Wai/Middleware/LoggingSpec.hs
@@ -3,12 +3,11 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
-module Network.Wai.Middleware.LoggingSpec
-    ( spec
-    ) where
+module Network.Wai.Middleware.LoggingSpec (spec) where
 
 import Prelude
 
@@ -18,8 +17,6 @@ import Cardano.BM.Data.Tracer
     ( HasSeverityAnnotation (..) )
 import Cardano.BM.Trace
     ( traceInTVarIO )
-import Cardano.Wallet.Api.Server
-    ( Listen (..), withListeningSocket )
 import Control.Monad
     ( forM_, void, when )
 import Control.Monad.IO.Class
@@ -34,8 +31,12 @@ import Data.Function
     ( (&) )
 import Data.Functor
     ( ($>), (<&>) )
+import Data.List
+    ( isInfixOf )
 import Data.Proxy
     ( Proxy (..) )
+import Data.Streaming.Network
+    ( HostPreference, bindPortTCP, bindRandomPortTCP )
 import Data.Text
     ( Text )
 import Data.Text.Class
@@ -57,7 +58,7 @@ import Network.HTTP.Client
 import Network.HTTP.Types.Header
     ( hContentType )
 import Network.Socket
-    ( Socket )
+    ( Socket, close )
 import Network.Wai.Handler.Warp
     ( Port, runSettingsSocket, setBeforeMainLoop )
 import Network.Wai.Middleware.Logging
@@ -88,10 +89,19 @@ import Servant
     )
 import Servant.Server
     ( Handler )
+import System.IO.Error
+    ( ioeGetErrorType
+    , isAlreadyInUseError
+    , isDoesNotExistError
+    , isPermissionError
+    , isUserError
+    )
 import Test.Hspec
     ( Spec, after, before, describe, it, shouldBe, shouldContain )
 import Test.QuickCheck
     ( Arbitrary (..), choose )
+import UnliftIO
+    ( IOException, bracket, tryJust )
 import UnliftIO.Async
     ( Async, async, cancel )
 import UnliftIO.Concurrent
@@ -413,3 +423,74 @@ type Api =
     :<|> "error400" :> Get '[JSON] ()
     :<|> "error500" :> Get '[JSON] ()
     :<|> "error503" :> Get '[JSON] ()
+
+-- | 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)
+
+withListeningSocket
+    :: HostPreference
+    -- ^ Which host to bind.
+    -> Listen
+    -- ^ Whether to listen on a given port, or random port.
+    -> (Either ListenError (Port, Socket) -> IO a)
+    -- ^ Action to run with listening socket.
+    -> IO a
+withListeningSocket hostPreference portOpt = bracket acquire release
+  where
+    acquire = tryJust handleErr bindAndListen
+    -- Note: These Data.Streaming.Network functions also listen on the socket,
+    -- even though their name just says "bind".
+    bindAndListen = case portOpt of
+        ListenOnPort p -> (p,) <$> bindPortTCP p hostPreference
+        ListenOnRandomPort -> bindRandomPortTCP hostPreference
+    release (Right (_, socket)) = liftIO $ close socket
+    release (Left _) = pure ()
+    handleErr = ioToListenError hostPreference portOpt
+
+data ListenError
+    = ListenErrorAddressAlreadyInUse (Maybe Port)
+    | ListenErrorOperationNotPermitted
+    | ListenErrorHostDoesNotExist HostPreference
+    | ListenErrorInvalidAddress HostPreference
+    deriving (Show, Eq)
+
+ioToListenError :: HostPreference -> Listen -> IOException -> Maybe ListenError
+ioToListenError hostPreference portOpt e
+    -- A socket is already listening on that address and port
+    | isAlreadyInUseError e =
+        Just (ListenErrorAddressAlreadyInUse (listenPort portOpt))
+    -- Usually caused by trying to listen on a privileged port
+    | isPermissionError e =
+        Just ListenErrorOperationNotPermitted
+    -- Bad hostname -- Linux and Darwin
+    | isDoesNotExistError e =
+        Just (ListenErrorHostDoesNotExist hostPreference)
+    -- Bad hostname -- Windows
+    -- WSAHOST_NOT_FOUND, WSATRY_AGAIN, or bind: WSAEOPNOTSUPP
+    | isUserError e && any hasDescription ["11001", "11002", "10045"] =
+        Just (ListenErrorHostDoesNotExist hostPreference)
+    -- Address is valid, but can't be used for listening -- Linux
+    | show (ioeGetErrorType e) == "invalid argument" =
+        Just (ListenErrorInvalidAddress hostPreference)
+    -- Address is valid, but can't be used for listening -- Darwin
+    | show (ioeGetErrorType e) == "unsupported operation" =
+        Just (ListenErrorInvalidAddress hostPreference)
+    -- Address is valid, but can't be used for listening -- Windows
+    | isOtherError e && any hasDescription ["WSAEINVAL", "WSAEADDRNOTAVAIL"] =
+        Just (ListenErrorInvalidAddress hostPreference)
+    -- Listening on an unavailable or privileged port -- Windows
+    | isOtherError e && hasDescription "WSAEACCESS" =
+        Just (ListenErrorAddressAlreadyInUse (listenPort portOpt))
+    | otherwise =
+        Nothing
+  where
+    listenPort (ListenOnPort p) = Just p
+    listenPort ListenOnRandomPort = Nothing
+
+    isOtherError ex = show (ioeGetErrorType ex) == "failed"
+    hasDescription text = text `isInfixOf` show e
diff --git a/lib/wai-middleware-logging/wai-middleware-logging.cabal b/lib/wai-middleware-logging/wai-middleware-logging.cabal
@@ -0,0 +1,76 @@
+cabal-version: 2.2
+name:          wai-middleware-logging
+version:       1.0
+synopsis:      WAI Middleware for Logging
+homepage:      https://github.com/input-output-hk/cardano-wallet
+author:        IOHK Engineering Team
+maintainer:    [email protected]
+copyright:     2018-2022 IOHK
+license:       Apache-2.0
+category:      Web
+build-type:    Simple
+
+flag release
+  description: Enable optimization and `-Werror`
+  default:     False
+  manual:      True
+
+common language
+  default-language:   Haskell2010
+  default-extensions:
+    NoImplicitPrelude
+    OverloadedStrings
+
+common opts-lib
+  ghc-options: -Wall -Wcompat -fwarn-redundant-constraints
+
+  if flag(release)
+    ghc-options: -O2 -Werror
+
+common opts-exe
+  ghc-options: -threaded -rtsopts -Wall
+
+  if flag(release)
+    ghc-options: -O2 -Werror
+
+common deps
+  build-depends:
+    , aeson
+    , base
+    , binary
+    , bytestring
+    , cardano-wallet-test-utils
+    , contra-tracer
+    , hspec
+    , http-client
+    , http-types
+    , iohk-monitoring
+    , network
+    , QuickCheck
+    , servant-server
+    , streaming-commons
+    , text
+    , text-class
+    , time
+    , unliftio
+    , unordered-containers
+    , wai
+    , warp
+    , with-utf8
+
+library
+  import:          language, opts-lib, deps
+  hs-source-dirs:  src
+  exposed-modules:
+    Network.Wai.Middleware.Logging
+    Network.Wai.Middleware.ServerError
+
+test-suite unit
+  import:             language, opts-exe, deps
+  ghc-options:        -with-rtsopts=-M2G -with-rtsopts=-N4
+  type:               exitcode-stdio-1.0
+  hs-source-dirs:     test
+  main-is:            Main.hs
+  build-depends:      wai-middleware-logging
+  build-tool-depends: hspec-discover:hspec-discover
+  other-modules:      Network.Wai.Middleware.LoggingSpec
diff --git a/lib/wallet/src/Cardano/CLI.hs → lib/wallet/api/http/Cardano/CLI.hs b/lib/wallet/src/Cardano/CLI.hs → lib/wallet/api/http/Cardano/CLI.hs
@@ -137,7 +137,7 @@ import Cardano.Wallet.Api.Client
     , TransactionClient (..)
     , WalletClient (..)
     )
-import Cardano.Wallet.Api.Server
+import Cardano.Wallet.Api.Http.Shelley.Server
     ( HostPreference, Listen (..), TlsConfiguration (..) )
 import Cardano.Wallet.Api.Types
     ( AccountPostData (..)