From 5d7552b524e7b31bc5a5f82c539343fca15d4ece Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 4 Apr 2019 18:34:40 +0200 Subject: [PATCH 1/4] implement the 'server' command from the CLI --- app/cli/Main.hs | 67 +++++++++++++++++++++++++++++++-------- cardano-wallet.cabal | 2 ++ src/Cardano/Wallet/Api.hs | 5 --- 3 files changed, 55 insertions(+), 19 deletions(-) diff --git a/app/cli/Main.hs b/app/cli/Main.hs index d7987ea82ad..4350f9df873 100644 --- a/app/cli/Main.hs +++ b/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 @@ -98,19 +117,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 +166,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 diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal index 2a934c89020..18c26b7f7a1 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -245,7 +245,9 @@ executable cardano-wallet , cardano-wallet , docopt , fmt + , servant-server , text + , warp hs-source-dirs: app app/cli diff --git a/src/Cardano/Wallet/Api.hs b/src/Cardano/Wallet/Api.hs index ed710dddb45..d44876b74e9 100644 --- a/src/Cardano/Wallet/Api.hs +++ b/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 ( (:<|>) , (:>) @@ -29,9 +27,6 @@ import Servant.API , ReqBody ) -api :: Proxy Api -api = Proxy - type Api = Addresses :<|> Wallets {------------------------------------------------------------------------------- From f636f3d97d4e8e8e274a6ba0104a2e63d0568f11 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 4 Apr 2019 19:10:38 +0200 Subject: [PATCH 2/4] fix missing '*HttpApiData' instances on path & query param for Servant --- src/Cardano/Wallet/Api.hs | 15 ++++++++------- src/Cardano/Wallet/Api/Server.hs | 14 +++++++------- src/Cardano/Wallet/Api/Types.hs | 13 +++++++++++++ src/Cardano/Wallet/Primitive/Types.hs | 14 ++++++++++++++ test/unit/Cardano/Wallet/Api/TypesSpec.hs | 6 +++--- test/unit/Cardano/Wallet/Primitive/TypesSpec.hs | 8 ++++++++ 6 files changed, 53 insertions(+), 17 deletions(-) diff --git a/src/Cardano/Wallet/Api.hs b/src/Cardano/Wallet/Api.hs index d44876b74e9..06def00affb 100644 --- a/src/Cardano/Wallet/Api.hs +++ b/src/Cardano/Wallet/Api.hs @@ -21,6 +21,7 @@ import Servant.API , Get , JSON , NoContent + , OctetStream , Post , Put , QueryParam @@ -40,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] @@ -60,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 @@ -79,12 +80,12 @@ 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) :> ReqBody '[JSON] WalletPutPassphraseData - :> Put '[] NoContent + :> Put '[OctetStream] NoContent diff --git a/src/Cardano/Wallet/Api/Server.hs b/src/Cardano/Wallet/Api/Server.hs index ca37da573e3..da6022cbf36 100644 --- a/src/Cardano/Wallet/Api/Server.hs +++ b/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,11 +130,11 @@ 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 _ _ _ = @@ -142,7 +142,7 @@ putWallet _ _ _ = 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 _ _ _ = diff --git a/src/Cardano/Wallet/Api/Types.hs b/src/Cardano/Wallet/Api/Types.hs index d099619de01..a68c75b789a 100644 --- a/src/Cardano/Wallet/Api/Types.hs +++ b/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 -------------------------------------------------------------------------------} diff --git a/src/Cardano/Wallet/Primitive/Types.hs b/src/Cardano/Wallet/Primitive/Types.hs index adfb965897c..ad6f47225a2 100644 --- a/src/Cardano/Wallet/Primitive/Types.hs +++ b/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 -------------------------------------------------------------------------------} diff --git a/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/test/unit/Cardano/Wallet/Api/TypesSpec.hs index 25dbb235a9d..f2156d95513 100644 --- a/test/unit/Cardano/Wallet/Api/TypesSpec.hs +++ b/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 diff --git a/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs b/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs index 68d17856282..904c80d1ade 100644 --- a/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs +++ b/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) From f782785a0ea1eeed16c84fbb49ff829ca4234d1c Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 4 Apr 2019 19:36:16 +0200 Subject: [PATCH 3/4] fix missing path in update passphrase endpoint --- src/Cardano/Wallet/Api.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Cardano/Wallet/Api.hs b/src/Cardano/Wallet/Api.hs index 06def00affb..07fcabcb5e9 100644 --- a/src/Cardano/Wallet/Api.hs +++ b/src/Cardano/Wallet/Api.hs @@ -87,5 +87,6 @@ type PutWallet = "wallets" -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/putWalletPassphrase type PutWalletPassphrase = "wallets" :> Capture "walletId" (ApiT WalletId) + :> "passphrase" :> ReqBody '[JSON] WalletPutPassphraseData :> Put '[OctetStream] NoContent From af25a8b613769f5a9a2ebf0042e2ba44fc727925 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Fri, 5 Apr 2019 09:17:35 +0200 Subject: [PATCH 4/4] fix option position and add warning into doc description --- app/cli/Main.hs | 2 ++ app/launcher/Main.hs | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/app/cli/Main.hs b/app/cli/Main.hs index 4350f9df873..725713ef943 100644 --- a/app/cli/Main.hs +++ b/app/cli/Main.hs @@ -80,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] diff --git a/app/launcher/Main.hs b/app/launcher/Main.hs index 2a92e0c8d52..cdbb40d08f4 100644 --- a/app/launcher/Main.hs +++ b/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