Add a cli option for creating a new transaction

exe/wallet/Main.hs

@@ -25,7 +25,13 @@ import Prelude hiding
     ( getLine )
 
 import Cardano.CLI
-    ( Port (..), getLine, getSensitiveLine, parseArgWith, putErrLn )
+    ( Port (..)
+    , getLine
+    , getSensitiveLine
+    , parseAllArgsWith
+    , parseArgWith
+    , putErrLn
+    )
 import Cardano.Environment
     ( network )
 import Cardano.Wallet
@@ -35,7 +41,12 @@ import Cardano.Wallet.Api
 import Cardano.Wallet.Api.Server
     ( server )
 import Cardano.Wallet.Api.Types
-    ( ApiMnemonicT (..), ApiT (..), WalletPostData (..), WalletPutData (..) )
+    ( ApiMnemonicT (..)
+    , ApiT (..)
+    , PostTransactionData (..)
+    , WalletPostData (..)
+    , WalletPutData (..)
+    )
 import Cardano.Wallet.Compatibility.HttpBridge
     ( HttpBridge )
 import Cardano.Wallet.Primitive.AddressDerivation
@@ -54,6 +65,7 @@ import Data.Function
     ( (&) )
 import Data.Functor
     ( (<&>) )
+import qualified Data.List.NonEmpty as NE
 import Data.Proxy
     ( Proxy (..) )
 import Data.Text.Class
@@ -122,6 +134,7 @@ Usage:
   cardano-wallet wallet get [--port=INT] <wallet-id>
   cardano-wallet wallet update [--port=INT] <wallet-id> --name=STRING
   cardano-wallet wallet delete [--port=INT] <wallet-id>
+  cardano-wallet transaction create [--port=INT] --wallet-id=STRING --payment=PAYMENT...
   cardano-wallet -h | --help
   cardano-wallet --version
 
@@ -130,6 +143,11 @@ Options:
   --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]
+  --payment <PAYMENT>         address to send to and amount to send separated by @: '<amount>@<address>'
+
+Examples:
+  cardano-wallet transaction create --wallet-id 2512a00e9653fe49a44a5886202e24d77eeb998f --payment 22@2cWKMJemoBam7gg1y5K2aFDhAm5L8fVc96NfxgcGhdLMFTsToNAU9t5HVdBBQKy4iDswL # Create a transaction and send 22 lovelace from wallet-id to specified addres
+
 |]
 
 main :: IO ()
@@ -153,18 +171,22 @@ exec manager args
         bridgePort <- args `parseArg` longOption "bridge-port"
         execServer walletPort bridgePort
 
-    | args `isPresent` command "generate" && args `isPresent` command "mnemonic" = do
+    | args `isPresent` command "generate" &&
+      args `isPresent` command "mnemonic" = do
         n <- args `parseArg` longOption "size"
         execGenerateMnemonic n
 
-    | args `isPresent` command "wallet" && args `isPresent` command "list" = do
+    | args `isPresent` command "wallet" &&
+      args `isPresent` command "list" = do
         runClient @Wallet Aeson.encodePretty listWallets
 
-    | args `isPresent` command "wallet" && args `isPresent` command "get" = do
+    | args `isPresent` command "wallet" &&
+      args `isPresent` command "get" = do
         wId <- args `parseArg` argument "wallet-id"
         runClient @Wallet Aeson.encodePretty $ getWallet $ ApiT wId
 
-    | args `isPresent` command "wallet" && args `isPresent` command "create" = do
+    | args `isPresent` command "wallet" &&
+      args `isPresent` command "create" = do
         wName <- args `parseArg` longOption "name"
         wGap <- args `parseArg` longOption "address-pool-gap"
         wSeed <- do
@@ -179,31 +201,23 @@ exec manager args
             getLine prompt parser <&> \case
                 (Nothing, _) -> Nothing
                 (Just a, t) -> Just (a, t)
-        (wPwd, _) <- do
-            let prompt = "Please enter a passphrase: "
-            let parser = fromText @(Passphrase "encryption")
-            getSensitiveLine prompt parser
-        (wPwd', _) <- do
-            let prompt = "Enter the passphrase a second time: "
-            let parser = fromText @(Passphrase "encryption")
-            getSensitiveLine prompt parser
-        when (wPwd /= wPwd') $ do
-            putErrLn "Passphrases don't match."
-            exitFailure
+        wPwd <- getPassphrase
         runClient @Wallet Aeson.encodePretty $ postWallet $ WalletPostData
             (Just $ ApiT wGap)
             (ApiMnemonicT . second T.words $ wSeed)
             (ApiMnemonicT . second T.words <$> wSndFactor)
             (ApiT wName)
             (ApiT wPwd)
 
-    | args `isPresent` command "wallet" && args `isPresent` command "update" = do
+    | args `isPresent` command "wallet" &&
+      args `isPresent` command "update" = do
         wId <- args `parseArg` argument "wallet-id"
         wName <- args `parseArg` longOption "name"
         runClient @Wallet Aeson.encodePretty $ putWallet (ApiT wId) $ WalletPutData
             (Just $ ApiT wName)
 
-    | args `isPresent` command "wallet" && args `isPresent` command "delete" = do
+    | args `isPresent` command "wallet" &&
+      args `isPresent` command "delete" = do
         wId <- args `parseArg` argument "wallet-id"
         runClient @Wallet (const "") $ deleteWallet (ApiT wId)
 
@@ -219,11 +233,38 @@ exec manager args
             Just version -> do
                 TIO.putStrLn $ T.pack version
 
+    | args `isPresent` command "transaction" &&
+      args `isPresent` command "create" = do
+        wId <- args `parseArg` longOption "wallet-id"
+        ts <- args `parseAllArgs` longOption "payment"
+        wPwd <- getPassphrase
+        runClient @Transaction Aeson.encodePretty $ createTransaction (ApiT wId) $
+            PostTransactionData
+                -- NOTE: we are sure this will be non-empty
+                (NE.fromList ts)
+                (ApiT wPwd)
+
     | otherwise =
         exitWithUsage cli
   where
     parseArg :: FromText a => Arguments -> Option -> IO a
     parseArg = parseArgWith cli
+    parseAllArgs :: FromText a => Arguments -> Option -> IO [a]
+    parseAllArgs = parseAllArgsWith cli
+    getPassphrase :: IO (Passphrase "encryption")
+    getPassphrase = do
+        (wPwd, _) <- do
+            let prompt = "Please enter a passphrase: "
+            let parser = fromText @(Passphrase "encryption")
+            getSensitiveLine prompt parser
+        (wPwd', _) <- do
+            let prompt = "Enter the passphrase a second time: "
+            let parser = fromText @(Passphrase "encryption")
+            getSensitiveLine prompt parser
+        when (wPwd /= wPwd') $ do
+            putErrLn "Passphrases don't match."
+            exitFailure
+        pure wPwd
 
     _ :<|> -- List Address
         ( deleteWallet
@@ -233,9 +274,7 @@ exec manager args
         :<|> putWallet
         :<|> _ -- Put Wallet Passphrase
         )
-        :<|>
-        ( _ -- Create Transaction
-        )
+        :<|> createTransaction
         = client (Proxy @("v2" :> Api))
 
     -- | 'runClient' requires a type-application to carry a particular
@@ -272,9 +311,9 @@ exec manager args
                 TIO.hPutStrLn stderr "Ok."
                 BL8.putStrLn (encode a)
 
--- | Namespaces for commands. Only 'Wallet' for now, 'Address' & 'Transaction'
--- later.
+-- | Namespaces for commands.
 data Wallet deriving (Typeable)
+data Transaction deriving (Typeable)
 
 -- | Start a web-server to serve the wallet backend API on the given port.
 execServer :: Port "wallet" -> Port "bridge" -> IO ()

lib/cli/src/Cardano/CLI.hs

@@ -22,6 +22,7 @@ module Cardano.CLI
 
     -- * Parsing Arguments
     , parseArgWith
+    , parseAllArgsWith
 
     -- * Working with Sensitive Data
     , getLine
@@ -56,7 +57,13 @@ import System.Console.ANSI
     , hSetSGR
     )
 import System.Console.Docopt
-    ( Arguments, Docopt, Option, getArgOrExitWith )
+    ( Arguments
+    , Docopt
+    , Option
+    , exitWithUsageMessage
+    , getAllArgs
+    , getArgOrExitWith
+    )
 import System.Exit
     ( exitFailure )
 import System.IO
@@ -97,15 +104,37 @@ instance ToText (Port tag) where
 parseArgWith :: FromText a => Docopt -> Arguments -> Option -> IO a
 parseArgWith cli args option = do
     (fromText . T.pack <$> args `getArgOrExit` option) >>= \case
-        Right a -> do
-            return a
+        Right a -> return a
         Left e -> do
             putErrLn $ T.pack $ getTextDecodingError e
             exitFailure
   where
     getArgOrExit :: Arguments -> Option -> IO String
     getArgOrExit = getArgOrExitWith cli
 
+parseAllArgsWith :: FromText a => Docopt -> Arguments -> Option -> IO [a]
+parseAllArgsWith cli args option = do
+    (mapM (fromText . T.pack) <$> args `getAllArgsOrExit` option) >>= \case
+        Right a -> return a
+        Left e -> do
+            putErrLn $ T.pack $ getTextDecodingError e
+            exitFailure
+  where
+    getAllArgsOrExit :: Arguments -> Option -> IO [String]
+    getAllArgsOrExit = getAllArgsOrExitWith cli
+
+-- | Same as 'getAllArgs', but 'exitWithUsage' if empty list.
+--
+--   As in 'getAllArgs', if your usage pattern required the option,
+--   'getAllArgsOrExitWith' will not exit.
+getAllArgsOrExitWith :: Docopt -> Arguments -> Option -> IO [String]
+getAllArgsOrExitWith doc args opt = exitIfEmpty $ getAllArgs args opt
+  where
+    exitIfEmpty
+      a | null a =
+            exitWithUsageMessage doc $ "argument expected for: " ++ show opt
+        | otherwise = pure a
+
 {-------------------------------------------------------------------------------
                             ANSI Terminal Helpers
 -------------------------------------------------------------------------------}

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

@@ -205,7 +205,7 @@ createTransaction
 createTransaction w (ApiT wid) body = do
     -- FIXME Compute the options based on the transaction's size / inputs
     let opts = CoinSelectionOptions { maximumNumberOfInputs = 10 }
-    let outs = coerceCoin <$> (body ^. #targets)
+    let outs = coerceCoin <$> (body ^. #payments)
     let pwd = getApiT $ body ^. #passphrase
     selection <- liftHandler $ W.createUnsignedTx w wid opts outs
     (tx, meta, wit) <- liftHandler $ W.signTx w wid pwd selection

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

@@ -92,9 +92,9 @@ import Data.List.NonEmpty
 import Data.Quantity
     ( Quantity (..) )
 import Data.Text
-    ( Text )
+    ( Text, split )
 import Data.Text.Class
-    ( FromText (..), ToText (..) )
+    ( FromText (..), TextDecodingError (..), ToText (..) )
 import Data.Time
     ( UTCTime )
 import Fmt
@@ -149,7 +149,7 @@ data WalletPutPassphraseData = WalletPutPassphraseData
     } deriving (Eq, Generic, Show)
 
 data PostTransactionData = PostTransactionData
-    { targets :: !(NonEmpty AddressAmount)
+    { payments :: !(NonEmpty AddressAmount)
     , passphrase :: !(ApiT (Passphrase "encryption"))
     } deriving (Eq, Generic, Show)
 
@@ -386,6 +386,24 @@ walletStateOptions = taggedSumTypeOptions $ TaggedObjectOptions
     , _contentsFieldName = "progress"
     }
 
+{-------------------------------------------------------------------------------
+                             FromText/ToText instances
+-------------------------------------------------------------------------------}
+
+instance FromText AddressAmount where
+    fromText text = do
+        let err = Left . TextDecodingError $ "Parse error. Expecting format \
+            \\"<amount>@<address>\" but got " <> show text
+        case split (=='@') text of
+            [] -> err
+            [_] -> err
+            [l, r] -> AddressAmount . ApiT <$> fromText r <*> fromText l
+            _ -> err
+
+instance ToText AddressAmount where
+    toText (AddressAmount (ApiT addr) coins) =
+        toText coins <> "@" <> toText addr
+
 {-------------------------------------------------------------------------------
                              HTTPApiData instances
 -------------------------------------------------------------------------------}

lib/core/src/Data/Quantity.hs

@@ -44,6 +44,8 @@ import Data.Aeson.Types
     ( Parser )
 import Data.Proxy
     ( Proxy (..) )
+import Data.Text.Class
+    ( FromText (..), ToText (..) )
 import GHC.Generics
     ( Generic )
 import GHC.TypeLits
@@ -102,6 +104,11 @@ instance (KnownSymbol unit, FromJSON a) => FromJSON (Quantity unit a) where
           where
             u = symbolVal proxy
 
+instance FromText b => FromText (Quantity sym b) where
+    fromText = fmap Quantity . fromText
+
+instance ToText b => ToText (Quantity sym b) where
+    toText (Quantity b) = toText b
 
 {-------------------------------------------------------------------------------
                                 Percentage