Implement 'cardano-wallet server' command to spin up an actual server

app/cli/Main.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
 
 -- |
 -- Copyright: © 2018-2019 IOHK
@@ -20,7 +21,18 @@ module Main where
 import Prelude
 
 import Cardano.CLI
-    ( getOptionalSensitiveValue, getRequiredSensitiveValue, parseArgWith )
+    ( Network
+    , Port (..)
+    , getOptionalSensitiveValue
+    , getRequiredSensitiveValue
+    , parseArgWith
+    )
+import Cardano.Wallet
+    ( mkWalletLayer )
+import Cardano.Wallet.Api
+    ( Api )
+import Cardano.Wallet.Api.Server
+    ( server )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( FromMnemonic (..), Passphrase (..) )
 import Cardano.Wallet.Primitive.AddressDiscovery
@@ -29,10 +41,14 @@ import Cardano.Wallet.Primitive.Mnemonic
     ( entropyToMnemonic, genEntropy, mnemonicToText )
 import Cardano.Wallet.Primitive.Types
     ( WalletId (..), WalletName )
-import Data.Text
-    ( Text )
+import Data.Function
+    ( (&) )
+import Data.Proxy
+    ( Proxy (..) )
 import Data.Text.Class
-    ( FromText (..) )
+    ( FromText (..), ToText (..) )
+import Servant
+    ( (:>), serve )
 import System.Console.Docopt
     ( Arguments
     , Docopt
@@ -49,8 +65,11 @@ import System.Environment
 import System.IO
     ( BufferMode (NoBuffering), hSetBuffering, stdout )
 
+import qualified Cardano.Wallet.DB.MVar as MVar
+import qualified Cardano.Wallet.Network.HttpBridge as HttpBridge
 import qualified Data.Text as T
 import qualified Data.Text.IO as TIO
+import qualified Network.Wai.Handler.Warp as Warp
 
 
 cli :: Docopt
@@ -61,6 +80,8 @@ commands. Those Commands are turned into corresponding API calls, and
 submitted to an up-and-running server. Some other commands do not require an
 active server and can be ran "offline" (e.g. 'generate mnemonic')
 
+    ⚠️  Options are positional (--a --b is not equivalent to --b --a) ! ⚠️
+
 Usage:
   cardano-wallet server [--network=NETWORK] [--port=INT] [--bridge-port=INT]
   cardano-wallet generate mnemonic [--size=INT]
@@ -98,19 +119,11 @@ exec args
         network <- args `parseArg` longOption "network"
         walletPort <- args `parseArg` longOption "port"
         bridgePort <- args `parseArg` longOption "bridge-port"
-        print (network :: Text, walletPort :: Int, bridgePort :: Int)
+        execServer network walletPort bridgePort
 
     | args `isPresent` command "generate" && args `isPresent` command "mnemonic" = do
         n <- args `parseArg` longOption "size"
-        m <- case (n :: Int) of
-            9  -> mnemonicToText @9 . entropyToMnemonic <$> genEntropy
-            12 -> mnemonicToText @12 . entropyToMnemonic <$> genEntropy
-            15 -> mnemonicToText @15 . entropyToMnemonic <$> genEntropy
-            18 -> mnemonicToText @18 . entropyToMnemonic <$> genEntropy
-            21 -> mnemonicToText @21 . entropyToMnemonic <$> genEntropy
-            24 -> mnemonicToText @24 . entropyToMnemonic <$> genEntropy
-            _  -> fail "Invalid mnemonic size. Expected one of: 9,12,15,18,21,24"
-        TIO.putStrLn $ T.unwords m
+        execGenerateMnemonic n
 
     | args `isPresent` command "address" && args `isPresent` command "list" = do
         wid <- args `parseArg` longOption "wallet-id"
@@ -155,3 +168,31 @@ exec args
   where
     parseArg :: FromText a => Arguments -> Option -> IO a
     parseArg = parseArgWith cli
+
+-- | Start a web-server to serve the wallet backend API on the given port.
+execServer :: Network -> Port "wallet" -> Port "bridge" -> IO ()
+execServer target (Port port) (Port bridgePort) = do
+    db <- MVar.newDBLayer
+    network <- HttpBridge.newNetworkLayer (toText target) bridgePort
+    let wallet = mkWalletLayer db network
+    Warp.runSettings settings (serve (Proxy @("v2" :> Api)) (server wallet))
+  where
+    settings = Warp.defaultSettings
+        & Warp.setPort port
+        & Warp.setBeforeMainLoop (do
+            TIO.putStrLn $ "Wallet backend server listening on: " <> toText port
+        )
+
+-- | Generate a random mnemonic of the given size 'n' (n = number of words),
+-- and print it to stdout.
+execGenerateMnemonic :: Int -> IO ()
+execGenerateMnemonic n = do
+    m <- case n of
+        9  -> mnemonicToText @9 . entropyToMnemonic <$> genEntropy
+        12 -> mnemonicToText @12 . entropyToMnemonic <$> genEntropy
+        15 -> mnemonicToText @15 . entropyToMnemonic <$> genEntropy
+        18 -> mnemonicToText @18 . entropyToMnemonic <$> genEntropy
+        21 -> mnemonicToText @21 . entropyToMnemonic <$> genEntropy
+        24 -> mnemonicToText @24 . entropyToMnemonic <$> genEntropy
+        _  -> fail "Invalid mnemonic size. Expected one of: 9,12,15,18,21,24"
+    TIO.putStrLn $ T.unwords m

app/launcher/Main.hs

@@ -101,9 +101,9 @@ walletOn :: Port "Wallet" -> Port "Node" -> Network -> Command
 walletOn wp np net = Command
     "cardano-wallet"
     [ "server"
+    , "--network", T.unpack (toText net)
     , "--port", T.unpack (toText wp)
     , "--bridge-port", T.unpack (toText np)
-    , "--network", T.unpack (toText net)
     ]
     (threadDelay oneSecond)
     Inherit

cardano-wallet.cabal

@@ -245,7 +245,9 @@ executable cardano-wallet
     , cardano-wallet
     , docopt
     , fmt
+    , servant-server
     , text
+    , warp
   hs-source-dirs:
       app
       app/cli

src/Cardano/Wallet/Api.hs

@@ -13,8 +13,6 @@ import Cardano.Wallet.Api.Types
     )
 import Cardano.Wallet.Primitive.Types
     ( AddressState, WalletId )
-import Data.Proxy
-    ( Proxy (..) )
 import Servant.API
     ( (:<|>)
     , (:>)
@@ -23,15 +21,13 @@ import Servant.API
     , Get
     , JSON
     , NoContent
+    , OctetStream
     , Post
     , Put
     , QueryParam
     , ReqBody
     )
 
-api :: Proxy Api
-api = Proxy
-
 type Api = Addresses :<|> Wallets
 
 {-------------------------------------------------------------------------------
@@ -45,7 +41,7 @@ type Addresses =
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/listAddresses
 type ListAddresses = "wallets"
-    :> Capture "walletId" WalletId
+    :> Capture "walletId" (ApiT WalletId)
     :> QueryParam "state" (ApiT AddressState)
     :> Get '[JSON] [ApiAddress]
 
@@ -65,12 +61,12 @@ type Wallets =
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/deleteWallet
 type DeleteWallet = "wallets"
-    :> Capture "walletId" WalletId
-    :> Delete '[] NoContent
+    :> Capture "walletId" (ApiT WalletId)
+    :> Delete '[OctetStream] NoContent
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/getWallet
 type GetWallet = "wallets"
-    :> Capture "walletId" WalletId
+    :> Capture "walletId" (ApiT WalletId)
     :> Get '[JSON] ApiWallet
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/listWallets
@@ -84,12 +80,13 @@ type PostWallet = "wallets"
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/putWallet
 type PutWallet = "wallets"
-    :> Capture "walletId" WalletId
+    :> Capture "walletId" (ApiT WalletId)
     :> ReqBody '[JSON] WalletPutData
     :> Put '[JSON] ApiWallet
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/putWalletPassphrase
 type PutWalletPassphrase = "wallets"
-    :> Capture "walletId" WalletId
+    :> Capture "walletId" (ApiT WalletId)
+    :> "passphrase"
     :> ReqBody '[JSON] WalletPutPassphraseData
-    :> Put '[] NoContent
+    :> Put '[OctetStream] NoContent

src/Cardano/Wallet/Api/Server.hs

@@ -75,16 +75,16 @@ wallets w =
 
 deleteWallet
     :: WalletLayer SeqState
-    -> WalletId
+    -> ApiT WalletId
     -> Handler NoContent
 deleteWallet _ _ =
     throwM err501
 
 getWallet
     :: WalletLayer SeqState
-    -> WalletId
+    -> ApiT WalletId
     -> Handler ApiWallet
-getWallet w wid = do
+getWallet w (ApiT wid) = do
     (wallet, meta) <- liftHandler $ readWallet w wid
     return ApiWallet
         { id =
@@ -130,19 +130,19 @@ postWallet w req = do
         , gap =
             maybe defaultAddressPoolGap getApiT (req ^.  #addressPoolGap)
         }
-    getWallet w wid
+    getWallet w (ApiT wid)
 
 putWallet
     :: WalletLayer SeqState
-    -> WalletId
+    -> ApiT WalletId
     -> WalletPutData
     -> Handler ApiWallet
 putWallet _ _ _ =
     throwM err501
 
 putWalletPassphrase
     :: WalletLayer SeqState
-    -> WalletId
+    -> ApiT WalletId
     -> WalletPutPassphraseData
     -> Handler NoContent
 putWalletPassphrase _ _ _ =
@@ -157,7 +157,7 @@ addresses = listAddresses
 
 listAddresses
     :: WalletLayer SeqState
-    -> WalletId
+    -> ApiT WalletId
     -> Maybe (ApiT AddressState)
     -> Handler [ApiAddress]
 listAddresses _ _ _ =

src/Cardano/Wallet/Api/Types.hs

@@ -81,10 +81,14 @@ import Data.Text
     ( Text )
 import Data.Text.Class
     ( FromText (..), ToText (..) )
+import Fmt
+    ( pretty )
 import GHC.Generics
     ( Generic )
 import GHC.TypeLits
     ( Nat, Symbol )
+import Web.HttpApiData
+    ( FromHttpApiData (..), ToHttpApiData (..) )
 
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
@@ -289,6 +293,15 @@ walletStateOptions = taggedSumTypeOptions $ TaggedObjectOptions
     , _contentsFieldName = "progress"
     }
 
+{-------------------------------------------------------------------------------
+                             HTTPApiData instances
+-------------------------------------------------------------------------------}
+
+instance FromText a => FromHttpApiData (ApiT a) where
+    parseUrlPiece = bimap pretty ApiT . fromText
+instance ToText a => ToHttpApiData (ApiT a) where
+    toUrlPiece = toText . getApiT
+
 {-------------------------------------------------------------------------------
                                 Aeson Options
 -------------------------------------------------------------------------------}

src/Cardano/Wallet/Primitive/Types.hs

@@ -126,6 +126,7 @@ import GHC.TypeLits
 import Numeric.Natural
     ( Natural )
 
+import qualified Data.Char as Char
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import qualified Data.Text as T
@@ -412,6 +413,19 @@ instance ToText Address where
 data AddressState = Used | Unused
     deriving (Eq, Generic, Show)
 
+instance FromText AddressState where
+    fromText = \case
+        "used" ->
+            Right Used
+        "unused" ->
+            Right Unused
+        _ ->
+            Left $ TextDecodingError "Unable to decode address state: \
+            \it's neither \"used\" nor \"unused\""
+
+instance ToText AddressState where
+    toText = T.pack . (\(h:q) -> Char.toLower h : q) . show
+
 {-------------------------------------------------------------------------------
                                      Coin
 -------------------------------------------------------------------------------}

test/unit/Cardano/Wallet/Api/TypesSpec.hs

@@ -20,7 +20,7 @@ import Prelude hiding
     ( id )
 
 import Cardano.Wallet.Api
-    ( api )
+    ( Api )
 import Cardano.Wallet.Api.Types
     ( ApiAddress (..)
     , ApiMnemonicT (..)
@@ -162,12 +162,12 @@ spec = do
     describe
         "verify that every type used with JSON content type in a servant API \
         \has compatible ToJSON and ToSchema instances using validateToJSON." $
-        validateEveryToJSON api
+        validateEveryToJSON (Proxy :: Proxy Api)
 
     describe
         "verify that every path specified by the servant server matches an \
         \existing path in the specification" $
-        validateEveryPath api
+        validateEveryPath (Proxy :: Proxy Api)
 
     describe "verify parsing failures too" $ do
         it "ApiT Address" $ do

test/unit/Cardano/Wallet/Primitive/TypesSpec.hs

@@ -11,6 +11,7 @@ import Prelude
 
 import Cardano.Wallet.Primitive.Types
     ( Address (..)
+    , AddressState (..)
     , Block (..)
     , BlockHeader (..)
     , Coin (..)
@@ -57,6 +58,8 @@ import Test.QuickCheck
     , vectorOf
     , (===)
     )
+import Test.QuickCheck.Arbitrary.Generic
+    ( genericArbitrary, genericShrink )
 import Test.Text.Roundtrip
     ( textRoundtrip )
 
@@ -72,6 +75,7 @@ spec = do
 
     describe "Can perform roundtrip textual encoding & decoding" $ do
         textRoundtrip $ Proxy @Address
+        textRoundtrip $ Proxy @AddressState
         textRoundtrip $ Proxy @WalletName
         textRoundtrip $ Proxy @WalletId
 
@@ -247,6 +251,10 @@ instance Arbitrary Address where
         , pure $ Address "ADDR03"
         ]
 
+instance Arbitrary AddressState where
+    shrink = genericShrink
+    arbitrary = genericArbitrary
+
 instance Arbitrary Coin where
     -- No Shrinking
     arbitrary = Coin <$> choose (0, 3)