{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- Shared types and helpers for CLI parsing

module Cardano.CLI
    (
    -- * CLI Execution
      cli
    , runCli

    -- * Commands
    , cmdMnemonic
    , cmdWallet
    , cmdWalletCreate
    , cmdByronWalletCreate
    , cmdTransaction
    , cmdAddress
    , cmdStakePool
    , cmdNetwork
    , cmdVersion
    , cmdKey

    -- * Option & Argument Parsers
    , optionT
    , argumentT
    , databaseOption
    , hostPreferenceOption
    , listenOption
    , shutdownHandlerFlag
    , stateDirOption
    , syncToleranceOption
    , tlsOption
    , poolMetadataSourceOption
    , tokenMetadataSourceOption
    , metadataOption
    , timeToLiveOption

    -- * Option parsers for configuring tracing
    , LoggingOptions (..)
    , LogOutput (..)
    , helperTracing
    , loggingOptions
    , loggingSeverities
    , parseLoggingSeverity
    , loggingSeverityOrOffReader
    , loggingSeverityReader

    -- * Types
    , Service
    , TxId
    , Port (..)

    -- * Logging
    , withLogging
    , withLoggingNamed

    -- * ANSI Terminal Helpers
    , putErrLn
    , hPutErrLn
    , enableWindowsANSI

    -- * Working with Sensitive Data
    , getLine
    , hGetLine
    , getSensitiveLine
    , hGetSensitiveLine

    -- * Helpers
    , decodeError
    , requireFilePath
    , getDataDir
    , setupDirectory
    , getPrometheusURL
    , getEKGURL
    , ekgEnabled
    ) where

import Prelude hiding
    ( getLine )

import Cardano.BM.Backend.Switchboard
    ( Switchboard )
import Cardano.BM.Configuration.Static
    ( defaultConfigStdout )
import Cardano.BM.Counters
    ( readCounters )
import Cardano.BM.Data.Configuration
    ( Endpoint (..) )
import Cardano.BM.Data.Counter
    ( Counter (..), nameCounter )
import Cardano.BM.Data.LogItem
    ( LOContent (..), LoggerName, PrivacyAnnotation (..), mkLOMeta )
import Cardano.BM.Data.Output
    ( ScribeDefinition (..)
    , ScribeFormat (..)
    , ScribeId
    , ScribeKind (..)
    , ScribePrivacy (..)
    )
import Cardano.BM.Data.Severity
    ( Severity (..) )
import Cardano.BM.Data.SubTrace
    ( SubTrace (..) )
import Cardano.BM.Setup
    ( setupTrace_, shutdown )
import Cardano.BM.Trace
    ( Trace, appendName, logDebug, traceNamedObject )
import Cardano.Mnemonic
    ( MkSomeMnemonic (..), SomeMnemonic (..) )
import Cardano.Wallet.Api.Client
    ( AddressClient (..)
    , NetworkClient (..)
    , StakePoolClient (..)
    , TransactionClient (..)
    , WalletClient (..)
    )
import Cardano.Wallet.Api.Server
    ( HostPreference, Listen (..), TlsConfiguration (..) )
import Cardano.Wallet.Api.Types
    ( AccountPostData (..)
    , AddressAmount
    , AllowedMnemonics
    , ApiAccountPublicKey
    , ApiByronWallet
    , ApiBytesT (..)
    , ApiMnemonicT (..)
    , ApiPostRandomAddressData (..)
    , ApiT (..)
    , ApiTxId (ApiTxId)
    , ApiWallet
    , Base (Base16)
    , ByronWalletPostData (..)
    , ByronWalletPutPassphraseData (ByronWalletPutPassphraseData)
    , ByronWalletStyle (..)
    , Iso8601Time (..)
    , SomeByronWalletPostData (..)
    , WalletOrAccountPostData (..)
    , WalletPostData (..)
    , WalletPutData (..)
    , WalletPutPassphraseData (..)
    , WalletPutPassphraseMnemonicData (WalletPutPassphraseMnemonicData)
    , WalletPutPassphraseOldPassphraseData (WalletPutPassphraseOldPassphraseData)
    , fmtAllowedWords
    )
import Cardano.Wallet.Api.Types.SchemaMetadata
    ( TxMetadataSchema (..), TxMetadataWithSchema )
import Cardano.Wallet.Orphans
    ()
import Cardano.Wallet.Primitive.AddressDerivation
    ( Depth (..), DerivationType (..), Index (..) )
import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
    ( AddressPoolGap, defaultAddressPoolGap )
import Cardano.Wallet.Primitive.Passphrase
    ( Passphrase (..), PassphraseMaxLength, PassphraseMinLength )
import Cardano.Wallet.Primitive.SyncProgress
    ( SyncTolerance (..) )
import Cardano.Wallet.Primitive.Types
    ( PoolMetadataSource (..)
    , SortOrder
    , TokenMetadataServer
    , WalletId
    , WalletName
    )
import Cardano.Wallet.Primitive.Types.Address
    ( AddressState )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin (..) )
import Cardano.Wallet.Primitive.Types.Hash
    ( Hash (..) )
import Cardano.Wallet.Primitive.Types.Tx
    ( SerialisedTx (..) )
import Cardano.Wallet.Version
    ( gitRevision, showFullVersion, version )
import Control.Applicative
    ( optional, some, (<|>) )
import Control.Arrow
    ( first, left )
import Control.Monad
    ( forM_, forever, join, unless, void, when )
import Control.Monad.IO.Class
    ( MonadIO )
import Data.Aeson
    ( ToJSON (..), (.:), (.=) )
import Data.Bifunctor
    ( bimap )
import Data.Char
    ( toLower )
import Data.Coerce
    ( coerce )
import Data.List.NonEmpty
    ( NonEmpty (..) )
import Data.Maybe
    ( fromMaybe, isJust )
import Data.Quantity
    ( Quantity (..) )
import Data.String
    ( IsString )
import Data.Text
    ( Text )
import Data.Text.Class
    ( FromText (..), TextDecodingError (..), ToText (..), showT )
import Data.Text.Read
    ( decimal )
import Data.Time.Clock
    ( NominalDiffTime )
import Data.Void
    ( Void )
import Fmt
    ( Buildable, pretty )
import GHC.Generics
    ( Generic )
import GHC.TypeLits
    ( Symbol )
import Network.HTTP.Client
    ( defaultManagerSettings
    , managerResponseTimeout
    , newManager
    , responseTimeoutNone
    )
-- See ADP-1910
import "optparse-applicative" Options.Applicative
    ( ArgumentFields
    , CommandFields
    , Mod
    , OptionFields
    , ParseError (InfoMsg)
    , Parser
    , ParserInfo
    , abortOption
    , argument
    , auto
    , command
    , customExecParser
    , eitherReader
    , flag
    , flag'
    , header
    , help
    , helpDoc
    , helper
    , hidden
    , info
    , long
    , metavar
    , option
    , prefs
    , progDesc
    , showDefaultWith
    , showHelpOnEmpty
    , str
    , strOption
    , subparser
    , switch
    , value
    )
-- See ADP-1910
import "optparse-applicative" Options.Applicative.Help.Pretty
    ( string, vsep )
-- See ADP-1910
import "optparse-applicative" Options.Applicative.Types
    ( ReadM (..), readerAsk )
import Servant.Client
    ( BaseUrl (..), ClientM, Scheme (..), mkClientEnv, runClientM )
import Servant.Client.Core
    ( ClientError (..), responseBody )
import System.Console.ANSI
    ( Color (..)
    , ColorIntensity (..)
    , ConsoleLayer (..)
    , SGR (..)
    , hCursorBackward
    , hSetSGR
    , hSupportsANSIWithoutEmulation
    )
import System.Directory
    ( XdgDirectory (..)
    , createDirectoryIfMissing
    , doesDirectoryExist
    , doesFileExist
    , getXdgDirectory
    )
import System.Environment
    ( lookupEnv )
import System.Exit
    ( exitFailure, exitSuccess )
import System.FilePath
    ( (</>) )
import System.Info
    ( os )
import System.IO
    ( BufferMode (..)
    , Handle
    , hGetBuffering
    , hGetChar
    , hGetEcho
    , hIsTerminalDevice
    , hPutChar
    , hSetBuffering
    , hSetEcho
    , stderr
    , stdin
    , stdout
    )
import UnliftIO.Concurrent
    ( threadDelay )
import UnliftIO.Exception
    ( bracket )

import qualified Cardano.BM.Configuration.Model as CM
import qualified Cardano.BM.Data.BackendKind as CM
import qualified Cardano.BM.Data.Observable as Obs
import qualified Command.Key as Key
import qualified Command.RecoveryPhrase as RecoveryPhrase
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encode.Pretty as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.Bifunctor as Bi
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as TIO
import qualified UnliftIO.Async as Async

{-------------------------------------------------------------------------------
                                   CLI
-------------------------------------------------------------------------------}

-- | Construct a CLI from a list of a commands
--
-- >>> runCli $ cli $ cmdA <> cmdB <> cmdC
--
cli :: Mod CommandFields a -> ParserInfo a
cli :: Mod CommandFields a -> ParserInfo a
cli Mod CommandFields a
cmds = Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (a -> a)
forall a. Parser (a -> a)
helper Parser (a -> a) -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod CommandFields a -> Parser a
forall a. Mod CommandFields a -> Parser a
subparser Mod CommandFields a
cmds) (InfoMod a -> ParserInfo a) -> InfoMod a -> ParserInfo a
forall a b. (a -> b) -> a -> b
$ InfoMod a
forall a. Monoid a => a
mempty
    InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod a
forall a. String -> InfoMod a
progDesc String
"Cardano Wallet Command-Line Interface (CLI)"
    InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod a
forall a. String -> InfoMod a
header ([String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"The CLI is a proxy to the wallet server, which is required for most "
        , String
"commands. Commands are turned into corresponding API calls, and "
        , String
"submitted to an up-and-running server. Some commands do not require "
        , String
"an active server and can be run offline (e.g. 'recovery-phrase generate')."
        ])

-- | Runs a specific command parser using appropriate preferences
runCli :: ParserInfo (IO ()) -> IO ()
runCli :: ParserInfo (IO ()) -> IO ()
runCli = IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ())
-> (ParserInfo (IO ()) -> IO (IO ()))
-> ParserInfo (IO ())
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserPrefs -> ParserInfo (IO ()) -> IO (IO ())
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser ParserPrefs
preferences
  where
    preferences :: ParserPrefs
preferences = PrefsMod -> ParserPrefs
prefs PrefsMod
showHelpOnEmpty

{-------------------------------------------------------------------------------
                            Commands - 'key'
-------------------------------------------------------------------------------}

cmdKey :: Mod CommandFields (IO ())
cmdKey :: Mod CommandFields (IO ())
cmdKey = (Cmd -> IO ()) -> Mod CommandFields (IO ())
forall parent. (Cmd -> parent) -> Mod CommandFields parent
Key.mod Cmd -> IO ()
Key.run

{-------------------------------------------------------------------------------
                            Commands - 'recovery-phrase'
-------------------------------------------------------------------------------}

cmdMnemonic :: Mod CommandFields (IO ())
cmdMnemonic :: Mod CommandFields (IO ())
cmdMnemonic = (Cmd -> IO ()) -> Mod CommandFields (IO ())
forall parent. (Cmd -> parent) -> Mod CommandFields parent
RecoveryPhrase.mod Cmd -> IO ()
RecoveryPhrase.run

{-------------------------------------------------------------------------------
                            Commands - 'wallet'
-------------------------------------------------------------------------------}

type CmdWalletCreate wallet = WalletClient wallet -> Mod CommandFields (IO ())

cmdWallet
    :: (ToJSON wallet, CmdWalletUpdatePassphrase wallet)
    => CmdWalletCreate wallet
    -> WalletClient wallet
    -> Mod CommandFields (IO ())
cmdWallet :: CmdWalletCreate wallet -> CmdWalletCreate wallet
cmdWallet CmdWalletCreate wallet
cmdCreate WalletClient wallet
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"wallet" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmds) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"About wallets"
  where
    cmds :: Parser (IO ())
cmds = Mod CommandFields (IO ()) -> Parser (IO ())
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields (IO ()) -> Parser (IO ()))
-> Mod CommandFields (IO ()) -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Mod CommandFields (IO ())
forall a. Monoid a => a
mempty
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> CmdWalletCreate wallet
forall wallet.
ToJSON wallet =>
WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletList WalletClient wallet
mkClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> CmdWalletCreate wallet
cmdCreate WalletClient wallet
mkClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> CmdWalletCreate wallet
forall wallet.
ToJSON wallet =>
WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletGet WalletClient wallet
mkClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> CmdWalletCreate wallet
forall wallet.
(ToJSON wallet, CmdWalletUpdatePassphrase wallet) =>
WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletUpdate WalletClient wallet
mkClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> CmdWalletCreate wallet
forall wallet. WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletDelete WalletClient wallet
mkClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> CmdWalletCreate wallet
forall wallet.
ToJSON wallet =>
WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletGetUtxoStatistics WalletClient wallet
mkClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> CmdWalletCreate wallet
forall wallet.
ToJSON wallet =>
WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletGetUtxoSnapshot WalletClient wallet
mkClient

-- | Arguments for 'wallet list' command
newtype WalletListArgs = WalletListArgs
    { WalletListArgs -> Port "Wallet"
_port :: Port "Wallet"
    }

cmdWalletList
    :: ToJSON wallet
    => WalletClient wallet
    -> Mod CommandFields (IO ())
cmdWalletList :: WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletList WalletClient wallet
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"list" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"List all known wallets."
  where
    cmd :: Parser (IO ())
cmd = (WalletListArgs -> IO ())
-> Parser WalletListArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WalletListArgs -> IO ()
exec (Parser WalletListArgs -> Parser (IO ()))
-> Parser WalletListArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> WalletListArgs
WalletListArgs
        (Port "Wallet" -> WalletListArgs)
-> Parser (Port "Wallet") -> Parser WalletListArgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
    exec :: WalletListArgs -> IO ()
exec (WalletListArgs Port "Wallet"
wPort) = do
        Port "Wallet"
-> ([wallet] -> ByteString) -> ClientM [wallet] -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort [wallet] -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM [wallet] -> IO ()) -> ClientM [wallet] -> IO ()
forall a b. (a -> b) -> a -> b
$ WalletClient wallet -> ClientM [wallet]
forall wallet. WalletClient wallet -> ClientM [wallet]
listWallets WalletClient wallet
mkClient

cmdWalletCreate
    :: WalletClient ApiWallet
    -> Mod CommandFields (IO ())
cmdWalletCreate :: WalletClient ApiWallet -> Mod CommandFields (IO ())
cmdWalletCreate WalletClient ApiWallet
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"create" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmds) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Create a new wallet."
  where
    cmds :: Parser (IO ())
cmds = Mod CommandFields (IO ()) -> Parser (IO ())
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields (IO ()) -> Parser (IO ()))
-> Mod CommandFields (IO ()) -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Mod CommandFields (IO ())
forall a. Monoid a => a
mempty
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> WalletClient ApiWallet -> Mod CommandFields (IO ())
cmdWalletCreateFromMnemonic WalletClient ApiWallet
mkClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> WalletClient ApiWallet -> Mod CommandFields (IO ())
cmdWalletCreateFromPublicKey WalletClient ApiWallet
mkClient

cmdByronWalletCreate
    :: WalletClient ApiByronWallet
    -> Mod CommandFields (IO ())
cmdByronWalletCreate :: WalletClient ApiByronWallet -> Mod CommandFields (IO ())
cmdByronWalletCreate WalletClient ApiByronWallet
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"create" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmds) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Create a new Byron wallet."
  where
    cmds :: Parser (IO ())
cmds = Mod CommandFields (IO ()) -> Parser (IO ())
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields (IO ()) -> Parser (IO ()))
-> Mod CommandFields (IO ()) -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Mod CommandFields (IO ())
forall a. Monoid a => a
mempty
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> WalletClient ApiByronWallet -> Mod CommandFields (IO ())
cmdByronWalletCreateFromMnemonic WalletClient ApiByronWallet
mkClient

data ByronWalletCreateFromMnemonicArgs = ByronWalletCreateFromMnemonicArgs
    { ByronWalletCreateFromMnemonicArgs -> Port "Wallet"
_port :: Port "Wallet"
    , ByronWalletCreateFromMnemonicArgs -> WalletName
_name :: WalletName
    , ByronWalletCreateFromMnemonicArgs -> ByronWalletStyle
_style :: ByronWalletStyle
    }

cmdByronWalletCreateFromMnemonic
    :: WalletClient ApiByronWallet
    -> Mod CommandFields (IO ())
cmdByronWalletCreateFromMnemonic :: WalletClient ApiByronWallet -> Mod CommandFields (IO ())
cmdByronWalletCreateFromMnemonic WalletClient ApiByronWallet
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"from-recovery-phrase" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Create a new wallet using a recovery phrase."
  where
    cmd :: Parser (IO ())
cmd = (ByronWalletCreateFromMnemonicArgs -> IO ())
-> Parser ByronWalletCreateFromMnemonicArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByronWalletCreateFromMnemonicArgs -> IO ()
exec (Parser ByronWalletCreateFromMnemonicArgs -> Parser (IO ()))
-> Parser ByronWalletCreateFromMnemonicArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet"
-> WalletName
-> ByronWalletStyle
-> ByronWalletCreateFromMnemonicArgs
ByronWalletCreateFromMnemonicArgs
        (Port "Wallet"
 -> WalletName
 -> ByronWalletStyle
 -> ByronWalletCreateFromMnemonicArgs)
-> Parser (Port "Wallet")
-> Parser
     (WalletName
      -> ByronWalletStyle -> ByronWalletCreateFromMnemonicArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser
  (WalletName
   -> ByronWalletStyle -> ByronWalletCreateFromMnemonicArgs)
-> Parser WalletName
-> Parser (ByronWalletStyle -> ByronWalletCreateFromMnemonicArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletName
walletNameArgument
        Parser (ByronWalletStyle -> ByronWalletCreateFromMnemonicArgs)
-> Parser ByronWalletStyle
-> Parser ByronWalletCreateFromMnemonicArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByronWalletStyle -> [ByronWalletStyle] -> Parser ByronWalletStyle
walletStyleOption ByronWalletStyle
Icarus [ByronWalletStyle
Random,ByronWalletStyle
Icarus,ByronWalletStyle
Trezor,ByronWalletStyle
Ledger]
    exec :: ByronWalletCreateFromMnemonicArgs -> IO ()
exec (ByronWalletCreateFromMnemonicArgs Port "Wallet"
wPort WalletName
wName ByronWalletStyle
wStyle) = case ByronWalletStyle
wStyle of
        ByronWalletStyle
Random -> do
            SomeMnemonic
wSeed <- do
                let prompt :: String
prompt = String
"Please enter " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByronWalletStyle -> String
fmtAllowedWords ByronWalletStyle
wStyle String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : "
                let parser :: Text
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
parser = MkSomeMnemonic (AllowedMnemonics 'Random) =>
[Text]
-> Either
     (MkSomeMnemonicError (AllowedMnemonics 'Random)) SomeMnemonic
forall (sz :: [Nat]).
MkSomeMnemonic sz =>
[Text] -> Either (MkSomeMnemonicError sz) SomeMnemonic
mkSomeMnemonic @(AllowedMnemonics 'Random) ([Text]
 -> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic)
-> (Text -> [Text])
-> Text
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words
                (SomeMnemonic, Text) -> SomeMnemonic
forall a b. (a, b) -> a
fst ((SomeMnemonic, Text) -> SomeMnemonic)
-> IO (SomeMnemonic, Text) -> IO SomeMnemonic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (Text -> Either String SomeMnemonic) -> IO (SomeMnemonic, Text)
forall a. Text -> (Text -> Either String a) -> IO (a, Text)
getLine @SomeMnemonic (String -> Text
T.pack String
prompt) ((MkSomeMnemonicError '[12, 15, 18, 21, 24] -> String)
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
-> Either String SomeMnemonic
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left MkSomeMnemonicError '[12, 15, 18, 21, 24] -> String
forall a. Show a => a -> String
show (Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
 -> Either String SomeMnemonic)
-> (Text
    -> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic)
-> Text
-> Either String SomeMnemonic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
parser)
            Passphrase "user"
wPwd <- Text -> IO (Passphrase "user")
forall (a :: Symbol).
(PassphraseMinLength a, PassphraseMaxLength a) =>
Text -> IO (Passphrase a)
getPassphraseWithConfirm Text
"Please enter a passphrase: "
            Port "Wallet"
-> (ApiByronWallet -> ByteString)
-> ClientM ApiByronWallet
-> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort ApiByronWallet -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM ApiByronWallet -> IO ())
-> ClientM ApiByronWallet -> IO ()
forall a b. (a -> b) -> a -> b
$ WalletClient ApiByronWallet
-> PostData ApiByronWallet -> ClientM ApiByronWallet
forall wallet.
WalletClient wallet -> PostData wallet -> ClientM wallet
postWallet WalletClient ApiByronWallet
mkClient (PostData ApiByronWallet -> ClientM ApiByronWallet)
-> PostData ApiByronWallet -> ClientM ApiByronWallet
forall a b. (a -> b) -> a -> b
$
                ByronWalletPostData (AllowedMnemonics 'Random)
-> SomeByronWalletPostData
RandomWalletFromMnemonic (ByronWalletPostData (AllowedMnemonics 'Random)
 -> SomeByronWalletPostData)
-> ByronWalletPostData (AllowedMnemonics 'Random)
-> SomeByronWalletPostData
forall a b. (a -> b) -> a -> b
$ ApiMnemonicT '[12, 15, 18, 21, 24]
-> ApiT WalletName
-> ApiT (Passphrase "user")
-> ByronWalletPostData '[12, 15, 18, 21, 24]
forall (mw :: [Nat]).
ApiMnemonicT mw
-> ApiT WalletName
-> ApiT (Passphrase "user")
-> ByronWalletPostData mw
ByronWalletPostData
                    (SomeMnemonic -> ApiMnemonicT '[12, 15, 18, 21, 24]
forall (sizes :: [Nat]). SomeMnemonic -> ApiMnemonicT sizes
ApiMnemonicT SomeMnemonic
wSeed)
                    (WalletName -> ApiT WalletName
forall a. a -> ApiT a
ApiT WalletName
wName)
                    (Passphrase "user" -> ApiT (Passphrase "user")
forall a. a -> ApiT a
ApiT Passphrase "user"
wPwd)

        ByronWalletStyle
Icarus -> do
            SomeMnemonic
wSeed <- do
                let prompt :: String
prompt = String
"Please enter " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByronWalletStyle -> String
fmtAllowedWords ByronWalletStyle
wStyle String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : "
                let parser :: Text
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
parser = MkSomeMnemonic (AllowedMnemonics 'Icarus) =>
[Text]
-> Either
     (MkSomeMnemonicError (AllowedMnemonics 'Icarus)) SomeMnemonic
forall (sz :: [Nat]).
MkSomeMnemonic sz =>
[Text] -> Either (MkSomeMnemonicError sz) SomeMnemonic
mkSomeMnemonic @(AllowedMnemonics 'Icarus) ([Text]
 -> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic)
-> (Text -> [Text])
-> Text
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words
                (SomeMnemonic, Text) -> SomeMnemonic
forall a b. (a, b) -> a
fst ((SomeMnemonic, Text) -> SomeMnemonic)
-> IO (SomeMnemonic, Text) -> IO SomeMnemonic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (Text -> Either String SomeMnemonic) -> IO (SomeMnemonic, Text)
forall a. Text -> (Text -> Either String a) -> IO (a, Text)
getLine @SomeMnemonic (String -> Text
T.pack String
prompt) ((MkSomeMnemonicError '[12, 15, 18, 21, 24] -> String)
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
-> Either String SomeMnemonic
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left MkSomeMnemonicError '[12, 15, 18, 21, 24] -> String
forall a. Show a => a -> String
show (Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
 -> Either String SomeMnemonic)
-> (Text
    -> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic)
-> Text
-> Either String SomeMnemonic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
parser)
            Passphrase "user"
wPwd <- Text -> IO (Passphrase "user")
forall (a :: Symbol).
(PassphraseMinLength a, PassphraseMaxLength a) =>
Text -> IO (Passphrase a)
getPassphraseWithConfirm Text
"Please enter a passphrase: "
            Port "Wallet"
-> (ApiByronWallet -> ByteString)
-> ClientM ApiByronWallet
-> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort ApiByronWallet -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM ApiByronWallet -> IO ())
-> ClientM ApiByronWallet -> IO ()
forall a b. (a -> b) -> a -> b
$ WalletClient ApiByronWallet
-> PostData ApiByronWallet -> ClientM ApiByronWallet
forall wallet.
WalletClient wallet -> PostData wallet -> ClientM wallet
postWallet WalletClient ApiByronWallet
mkClient (PostData ApiByronWallet -> ClientM ApiByronWallet)
-> PostData ApiByronWallet -> ClientM ApiByronWallet
forall a b. (a -> b) -> a -> b
$
                ByronWalletPostData (AllowedMnemonics 'Icarus)
-> SomeByronWalletPostData
SomeIcarusWallet (ByronWalletPostData (AllowedMnemonics 'Icarus)
 -> SomeByronWalletPostData)
-> ByronWalletPostData (AllowedMnemonics 'Icarus)
-> SomeByronWalletPostData
forall a b. (a -> b) -> a -> b
$ ApiMnemonicT '[12, 15, 18, 21, 24]
-> ApiT WalletName
-> ApiT (Passphrase "user")
-> ByronWalletPostData '[12, 15, 18, 21, 24]
forall (mw :: [Nat]).
ApiMnemonicT mw
-> ApiT WalletName
-> ApiT (Passphrase "user")
-> ByronWalletPostData mw
ByronWalletPostData
                    (SomeMnemonic -> ApiMnemonicT '[12, 15, 18, 21, 24]
forall (sizes :: [Nat]). SomeMnemonic -> ApiMnemonicT sizes
ApiMnemonicT SomeMnemonic
wSeed)
                    (WalletName -> ApiT WalletName
forall a. a -> ApiT a
ApiT WalletName
wName)
                    (Passphrase "user" -> ApiT (Passphrase "user")
forall a. a -> ApiT a
ApiT Passphrase "user"
wPwd)

        ByronWalletStyle
Trezor -> do
            SomeMnemonic
wSeed <- do
                let prompt :: String
prompt = String
"Please enter " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByronWalletStyle -> String
fmtAllowedWords ByronWalletStyle
wStyle String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : "
                let parser :: Text
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
parser = MkSomeMnemonic (AllowedMnemonics 'Trezor) =>
[Text]
-> Either
     (MkSomeMnemonicError (AllowedMnemonics 'Trezor)) SomeMnemonic
forall (sz :: [Nat]).
MkSomeMnemonic sz =>
[Text] -> Either (MkSomeMnemonicError sz) SomeMnemonic
mkSomeMnemonic @(AllowedMnemonics 'Trezor) ([Text]
 -> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic)
-> (Text -> [Text])
-> Text
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words
                (SomeMnemonic, Text) -> SomeMnemonic
forall a b. (a, b) -> a
fst ((SomeMnemonic, Text) -> SomeMnemonic)
-> IO (SomeMnemonic, Text) -> IO SomeMnemonic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (Text -> Either String SomeMnemonic) -> IO (SomeMnemonic, Text)
forall a. Text -> (Text -> Either String a) -> IO (a, Text)
getLine @SomeMnemonic (String -> Text
T.pack String
prompt) ((MkSomeMnemonicError '[12, 15, 18, 21, 24] -> String)
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
-> Either String SomeMnemonic
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left MkSomeMnemonicError '[12, 15, 18, 21, 24] -> String
forall a. Show a => a -> String
show (Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
 -> Either String SomeMnemonic)
-> (Text
    -> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic)
-> Text
-> Either String SomeMnemonic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
parser)
            Passphrase "user"
wPwd <- Text -> IO (Passphrase "user")
forall (a :: Symbol).
(PassphraseMinLength a, PassphraseMaxLength a) =>
Text -> IO (Passphrase a)
getPassphraseWithConfirm Text
"Please enter a passphrase: "
            Port "Wallet"
-> (ApiByronWallet -> ByteString)
-> ClientM ApiByronWallet
-> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort ApiByronWallet -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM ApiByronWallet -> IO ())
-> ClientM ApiByronWallet -> IO ()
forall a b. (a -> b) -> a -> b
$ WalletClient ApiByronWallet
-> PostData ApiByronWallet -> ClientM ApiByronWallet
forall wallet.
WalletClient wallet -> PostData wallet -> ClientM wallet
postWallet WalletClient ApiByronWallet
mkClient (PostData ApiByronWallet -> ClientM ApiByronWallet)
-> PostData ApiByronWallet -> ClientM ApiByronWallet
forall a b. (a -> b) -> a -> b
$
                ByronWalletPostData (AllowedMnemonics 'Trezor)
-> SomeByronWalletPostData
SomeTrezorWallet (ByronWalletPostData (AllowedMnemonics 'Trezor)
 -> SomeByronWalletPostData)
-> ByronWalletPostData (AllowedMnemonics 'Trezor)
-> SomeByronWalletPostData
forall a b. (a -> b) -> a -> b
$ ApiMnemonicT '[12, 15, 18, 21, 24]
-> ApiT WalletName
-> ApiT (Passphrase "user")
-> ByronWalletPostData '[12, 15, 18, 21, 24]
forall (mw :: [Nat]).
ApiMnemonicT mw
-> ApiT WalletName
-> ApiT (Passphrase "user")
-> ByronWalletPostData mw
ByronWalletPostData
                    (SomeMnemonic -> ApiMnemonicT '[12, 15, 18, 21, 24]
forall (sizes :: [Nat]). SomeMnemonic -> ApiMnemonicT sizes
ApiMnemonicT SomeMnemonic
wSeed)
                    (WalletName -> ApiT WalletName
forall a. a -> ApiT a
ApiT WalletName
wName)
                    (Passphrase "user" -> ApiT (Passphrase "user")
forall a. a -> ApiT a
ApiT Passphrase "user"
wPwd)

        ByronWalletStyle
Ledger -> do
            SomeMnemonic
wSeed <- do
                let prompt :: String
prompt = String
"Please enter " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByronWalletStyle -> String
fmtAllowedWords ByronWalletStyle
wStyle String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : "
                let parser :: Text
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
parser = MkSomeMnemonic (AllowedMnemonics 'Ledger) =>
[Text]
-> Either
     (MkSomeMnemonicError (AllowedMnemonics 'Ledger)) SomeMnemonic
forall (sz :: [Nat]).
MkSomeMnemonic sz =>
[Text] -> Either (MkSomeMnemonicError sz) SomeMnemonic
mkSomeMnemonic @(AllowedMnemonics 'Ledger) ([Text]
 -> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic)
-> (Text -> [Text])
-> Text
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words
                (SomeMnemonic, Text) -> SomeMnemonic
forall a b. (a, b) -> a
fst ((SomeMnemonic, Text) -> SomeMnemonic)
-> IO (SomeMnemonic, Text) -> IO SomeMnemonic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (Text -> Either String SomeMnemonic) -> IO (SomeMnemonic, Text)
forall a. Text -> (Text -> Either String a) -> IO (a, Text)
getLine @SomeMnemonic (String -> Text
T.pack String
prompt) ((MkSomeMnemonicError '[12, 15, 18, 21, 24] -> String)
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
-> Either String SomeMnemonic
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left MkSomeMnemonicError '[12, 15, 18, 21, 24] -> String
forall a. Show a => a -> String
show (Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
 -> Either String SomeMnemonic)
-> (Text
    -> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic)
-> Text
-> Either String SomeMnemonic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
parser)
            Passphrase "user"
wPwd <- Text -> IO (Passphrase "user")
forall (a :: Symbol).
(PassphraseMinLength a, PassphraseMaxLength a) =>
Text -> IO (Passphrase a)
getPassphraseWithConfirm Text
"Please enter a passphrase: "
            Port "Wallet"
-> (ApiByronWallet -> ByteString)
-> ClientM ApiByronWallet
-> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort ApiByronWallet -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM ApiByronWallet -> IO ())
-> ClientM ApiByronWallet -> IO ()
forall a b. (a -> b) -> a -> b
$ WalletClient ApiByronWallet
-> PostData ApiByronWallet -> ClientM ApiByronWallet
forall wallet.
WalletClient wallet -> PostData wallet -> ClientM wallet
postWallet WalletClient ApiByronWallet
mkClient (PostData ApiByronWallet -> ClientM ApiByronWallet)
-> PostData ApiByronWallet -> ClientM ApiByronWallet
forall a b. (a -> b) -> a -> b
$
                ByronWalletPostData (AllowedMnemonics 'Ledger)
-> SomeByronWalletPostData
SomeLedgerWallet (ByronWalletPostData (AllowedMnemonics 'Ledger)
 -> SomeByronWalletPostData)
-> ByronWalletPostData (AllowedMnemonics 'Ledger)
-> SomeByronWalletPostData
forall a b. (a -> b) -> a -> b
$ ApiMnemonicT '[12, 15, 18, 21, 24]
-> ApiT WalletName
-> ApiT (Passphrase "user")
-> ByronWalletPostData '[12, 15, 18, 21, 24]
forall (mw :: [Nat]).
ApiMnemonicT mw
-> ApiT WalletName
-> ApiT (Passphrase "user")
-> ByronWalletPostData mw
ByronWalletPostData
                    (SomeMnemonic -> ApiMnemonicT '[12, 15, 18, 21, 24]
forall (sizes :: [Nat]). SomeMnemonic -> ApiMnemonicT sizes
ApiMnemonicT SomeMnemonic
wSeed)
                    (WalletName -> ApiT WalletName
forall a. a -> ApiT a
ApiT WalletName
wName)
                    (Passphrase "user" -> ApiT (Passphrase "user")
forall a. a -> ApiT a
ApiT Passphrase "user"
wPwd)

getMnemonics :: IO (SomeMnemonic, Maybe SomeMnemonic)
getMnemonics :: IO (SomeMnemonic, Maybe SomeMnemonic)
getMnemonics  = do
    SomeMnemonic
wSeed <- do
        let prompt :: Text
prompt = Text
"Please enter the 15–24 word recovery phrase: "
        let parser :: Text -> Either (MkSomeMnemonicError '[15, 18, 21, 24]) SomeMnemonic
parser = MkSomeMnemonic '[15, 18, 21, 24] =>
[Text]
-> Either (MkSomeMnemonicError '[15, 18, 21, 24]) SomeMnemonic
forall (sz :: [Nat]).
MkSomeMnemonic sz =>
[Text] -> Either (MkSomeMnemonicError sz) SomeMnemonic
mkSomeMnemonic @'[15,18,21,24] ([Text]
 -> Either (MkSomeMnemonicError '[15, 18, 21, 24]) SomeMnemonic)
-> (Text -> [Text])
-> Text
-> Either (MkSomeMnemonicError '[15, 18, 21, 24]) SomeMnemonic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words
        (SomeMnemonic, Text) -> SomeMnemonic
forall a b. (a, b) -> a
fst ((SomeMnemonic, Text) -> SomeMnemonic)
-> IO (SomeMnemonic, Text) -> IO SomeMnemonic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (Text -> Either String SomeMnemonic) -> IO (SomeMnemonic, Text)
forall a. Text -> (Text -> Either String a) -> IO (a, Text)
getLine @SomeMnemonic Text
prompt ((MkSomeMnemonicError '[15, 18, 21, 24] -> String)
-> Either (MkSomeMnemonicError '[15, 18, 21, 24]) SomeMnemonic
-> Either String SomeMnemonic
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left MkSomeMnemonicError '[15, 18, 21, 24] -> String
forall a. Show a => a -> String
show (Either (MkSomeMnemonicError '[15, 18, 21, 24]) SomeMnemonic
 -> Either String SomeMnemonic)
-> (Text
    -> Either (MkSomeMnemonicError '[15, 18, 21, 24]) SomeMnemonic)
-> Text
-> Either String SomeMnemonic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either (MkSomeMnemonicError '[15, 18, 21, 24]) SomeMnemonic
parser)
    Maybe SomeMnemonic
wSndFactor <- do
        let prompt :: Text
prompt =
                Text
"(Enter a blank line if you do not wish to use a second " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                Text
"factor.)\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                Text
"Please enter a 9–12 word second factor: "
        let parser :: Text -> Either (MkSomeMnemonicError '[9, 12]) (Maybe SomeMnemonic)
parser =
                ([Text] -> Either (MkSomeMnemonicError '[9, 12]) SomeMnemonic)
-> [Text]
-> Either (MkSomeMnemonicError '[9, 12]) (Maybe SomeMnemonic)
forall m e a.
(Monoid m, Eq m) =>
(m -> Either e a) -> m -> Either e (Maybe a)
optionalE (MkSomeMnemonic '[9, 12] =>
[Text] -> Either (MkSomeMnemonicError '[9, 12]) SomeMnemonic
forall (sz :: [Nat]).
MkSomeMnemonic sz =>
[Text] -> Either (MkSomeMnemonicError sz) SomeMnemonic
mkSomeMnemonic @'[9,12]) ([Text]
 -> Either (MkSomeMnemonicError '[9, 12]) (Maybe SomeMnemonic))
-> (Text -> [Text])
-> Text
-> Either (MkSomeMnemonicError '[9, 12]) (Maybe SomeMnemonic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words
        (Maybe SomeMnemonic, Text) -> Maybe SomeMnemonic
forall a b. (a, b) -> a
fst ((Maybe SomeMnemonic, Text) -> Maybe SomeMnemonic)
-> IO (Maybe SomeMnemonic, Text) -> IO (Maybe SomeMnemonic)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (Text -> Either String (Maybe SomeMnemonic))
-> IO (Maybe SomeMnemonic, Text)
forall a. Text -> (Text -> Either String a) -> IO (a, Text)
getLine @(Maybe SomeMnemonic) Text
prompt ((MkSomeMnemonicError '[9, 12] -> String)
-> Either (MkSomeMnemonicError '[9, 12]) (Maybe SomeMnemonic)
-> Either String (Maybe SomeMnemonic)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left MkSomeMnemonicError '[9, 12] -> String
forall a. Show a => a -> String
show (Either (MkSomeMnemonicError '[9, 12]) (Maybe SomeMnemonic)
 -> Either String (Maybe SomeMnemonic))
-> (Text
    -> Either (MkSomeMnemonicError '[9, 12]) (Maybe SomeMnemonic))
-> Text
-> Either String (Maybe SomeMnemonic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either (MkSomeMnemonicError '[9, 12]) (Maybe SomeMnemonic)
parser)
    pure (SomeMnemonic
wSeed, Maybe SomeMnemonic
wSndFactor)

-- | Arguments for 'wallet create' command
data WalletCreateArgs = WalletCreateArgs
    { WalletCreateArgs -> Port "Wallet"
_port :: Port "Wallet"
    , WalletCreateArgs -> WalletName
_name :: WalletName
    , WalletCreateArgs -> AddressPoolGap
_gap :: AddressPoolGap
    }

cmdWalletCreateFromMnemonic
    :: WalletClient ApiWallet
    -> Mod CommandFields (IO ())
cmdWalletCreateFromMnemonic :: WalletClient ApiWallet -> Mod CommandFields (IO ())
cmdWalletCreateFromMnemonic WalletClient ApiWallet
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"from-recovery-phrase" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Create a new wallet using a recovery phrase."
  where
    cmd :: Parser (IO ())
cmd = (WalletCreateArgs -> IO ())
-> Parser WalletCreateArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WalletCreateArgs -> IO ()
exec (Parser WalletCreateArgs -> Parser (IO ()))
-> Parser WalletCreateArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> WalletName -> AddressPoolGap -> WalletCreateArgs
WalletCreateArgs
        (Port "Wallet" -> WalletName -> AddressPoolGap -> WalletCreateArgs)
-> Parser (Port "Wallet")
-> Parser (WalletName -> AddressPoolGap -> WalletCreateArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser (WalletName -> AddressPoolGap -> WalletCreateArgs)
-> Parser WalletName -> Parser (AddressPoolGap -> WalletCreateArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletName
walletNameArgument
        Parser (AddressPoolGap -> WalletCreateArgs)
-> Parser AddressPoolGap -> Parser WalletCreateArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser AddressPoolGap
poolGapOption
    exec :: WalletCreateArgs -> IO ()
exec (WalletCreateArgs Port "Wallet"
wPort WalletName
wName AddressPoolGap
wGap) = do
        (SomeMnemonic
wSeed, Maybe SomeMnemonic
wSndFactor) <- IO (SomeMnemonic, Maybe SomeMnemonic)
getMnemonics
        Passphrase "user"
wPwd <- Text -> IO (Passphrase "user")
forall (a :: Symbol).
(PassphraseMinLength a, PassphraseMaxLength a) =>
Text -> IO (Passphrase a)
getPassphraseWithConfirm Text
"Please enter a passphrase: "
        Port "Wallet"
-> (ApiWallet -> ByteString) -> ClientM ApiWallet -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort ApiWallet -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM ApiWallet -> IO ()) -> ClientM ApiWallet -> IO ()
forall a b. (a -> b) -> a -> b
$ WalletClient ApiWallet -> PostData ApiWallet -> ClientM ApiWallet
forall wallet.
WalletClient wallet -> PostData wallet -> ClientM wallet
postWallet WalletClient ApiWallet
mkClient (PostData ApiWallet -> ClientM ApiWallet)
-> PostData ApiWallet -> ClientM ApiWallet
forall a b. (a -> b) -> a -> b
$
            Either WalletPostData AccountPostData -> WalletOrAccountPostData
WalletOrAccountPostData (Either WalletPostData AccountPostData -> WalletOrAccountPostData)
-> Either WalletPostData AccountPostData -> WalletOrAccountPostData
forall a b. (a -> b) -> a -> b
$ WalletPostData -> Either WalletPostData AccountPostData
forall a b. a -> Either a b
Left (WalletPostData -> Either WalletPostData AccountPostData)
-> WalletPostData -> Either WalletPostData AccountPostData
forall a b. (a -> b) -> a -> b
$ Maybe (ApiT AddressPoolGap)
-> ApiMnemonicT (AllowedMnemonics 'Shelley)
-> Maybe (ApiMnemonicT (AllowedMnemonics 'SndFactor))
-> ApiT WalletName
-> ApiT (Passphrase "user")
-> WalletPostData
WalletPostData
                (ApiT AddressPoolGap -> Maybe (ApiT AddressPoolGap)
forall a. a -> Maybe a
Just (ApiT AddressPoolGap -> Maybe (ApiT AddressPoolGap))
-> ApiT AddressPoolGap -> Maybe (ApiT AddressPoolGap)
forall a b. (a -> b) -> a -> b
$ AddressPoolGap -> ApiT AddressPoolGap
forall a. a -> ApiT a
ApiT AddressPoolGap
wGap)
                (SomeMnemonic -> ApiMnemonicT '[15, 18, 21, 24]
forall (sizes :: [Nat]). SomeMnemonic -> ApiMnemonicT sizes
ApiMnemonicT SomeMnemonic
wSeed)
                (SomeMnemonic -> ApiMnemonicT '[9, 12]
forall (sizes :: [Nat]). SomeMnemonic -> ApiMnemonicT sizes
ApiMnemonicT (SomeMnemonic -> ApiMnemonicT '[9, 12])
-> Maybe SomeMnemonic -> Maybe (ApiMnemonicT '[9, 12])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SomeMnemonic
wSndFactor)
                (WalletName -> ApiT WalletName
forall a. a -> ApiT a
ApiT WalletName
wName)
                (Passphrase "user" -> ApiT (Passphrase "user")
forall a. a -> ApiT a
ApiT Passphrase "user"
wPwd)

-- | Arguments for 'wallet create from-public-key' command
data WalletCreateFromPublicKeyArgs = WalletCreateFromPublicKeyArgs
    { WalletCreateFromPublicKeyArgs -> Port "Wallet"
_port :: Port "Wallet"
    , WalletCreateFromPublicKeyArgs -> WalletName
_name :: WalletName
    , WalletCreateFromPublicKeyArgs -> AddressPoolGap
_gap :: AddressPoolGap
    , WalletCreateFromPublicKeyArgs -> ApiAccountPublicKey
_key :: ApiAccountPublicKey
    }

cmdWalletCreateFromPublicKey
    :: WalletClient ApiWallet
    -> Mod CommandFields (IO ())
cmdWalletCreateFromPublicKey :: WalletClient ApiWallet -> Mod CommandFields (IO ())
cmdWalletCreateFromPublicKey WalletClient ApiWallet
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"from-public-key" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
    InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Create a wallet using a public account key."
  where
    cmd :: Parser (IO ())
cmd = (WalletCreateFromPublicKeyArgs -> IO ())
-> Parser WalletCreateFromPublicKeyArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WalletCreateFromPublicKeyArgs -> IO ()
exec (Parser WalletCreateFromPublicKeyArgs -> Parser (IO ()))
-> Parser WalletCreateFromPublicKeyArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet"
-> WalletName
-> AddressPoolGap
-> ApiAccountPublicKey
-> WalletCreateFromPublicKeyArgs
WalletCreateFromPublicKeyArgs
        (Port "Wallet"
 -> WalletName
 -> AddressPoolGap
 -> ApiAccountPublicKey
 -> WalletCreateFromPublicKeyArgs)
-> Parser (Port "Wallet")
-> Parser
     (WalletName
      -> AddressPoolGap
      -> ApiAccountPublicKey
      -> WalletCreateFromPublicKeyArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser
  (WalletName
   -> AddressPoolGap
   -> ApiAccountPublicKey
   -> WalletCreateFromPublicKeyArgs)
-> Parser WalletName
-> Parser
     (AddressPoolGap
      -> ApiAccountPublicKey -> WalletCreateFromPublicKeyArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletName
walletNameArgument
        Parser
  (AddressPoolGap
   -> ApiAccountPublicKey -> WalletCreateFromPublicKeyArgs)
-> Parser AddressPoolGap
-> Parser (ApiAccountPublicKey -> WalletCreateFromPublicKeyArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser AddressPoolGap
poolGapOption
        Parser (ApiAccountPublicKey -> WalletCreateFromPublicKeyArgs)
-> Parser ApiAccountPublicKey
-> Parser WalletCreateFromPublicKeyArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ApiAccountPublicKey
accPubKeyArgument
    exec :: WalletCreateFromPublicKeyArgs -> IO ()
exec (WalletCreateFromPublicKeyArgs Port "Wallet"
wPort WalletName
wName AddressPoolGap
wGap ApiAccountPublicKey
wAccPubKey) =
        Port "Wallet"
-> (ApiWallet -> ByteString) -> ClientM ApiWallet -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort ApiWallet -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM ApiWallet -> IO ()) -> ClientM ApiWallet -> IO ()
forall a b. (a -> b) -> a -> b
$ WalletClient ApiWallet -> PostData ApiWallet -> ClientM ApiWallet
forall wallet.
WalletClient wallet -> PostData wallet -> ClientM wallet
postWallet WalletClient ApiWallet
mkClient (PostData ApiWallet -> ClientM ApiWallet)
-> PostData ApiWallet -> ClientM ApiWallet
forall a b. (a -> b) -> a -> b
$
            Either WalletPostData AccountPostData -> WalletOrAccountPostData
WalletOrAccountPostData (Either WalletPostData AccountPostData -> WalletOrAccountPostData)
-> Either WalletPostData AccountPostData -> WalletOrAccountPostData
forall a b. (a -> b) -> a -> b
$ AccountPostData -> Either WalletPostData AccountPostData
forall a b. b -> Either a b
Right (AccountPostData -> Either WalletPostData AccountPostData)
-> AccountPostData -> Either WalletPostData AccountPostData
forall a b. (a -> b) -> a -> b
$ ApiT WalletName
-> ApiAccountPublicKey
-> Maybe (ApiT AddressPoolGap)
-> AccountPostData
AccountPostData
                (WalletName -> ApiT WalletName
forall a. a -> ApiT a
ApiT WalletName
wName)
                ApiAccountPublicKey
wAccPubKey
                (ApiT AddressPoolGap -> Maybe (ApiT AddressPoolGap)
forall a. a -> Maybe a
Just (ApiT AddressPoolGap -> Maybe (ApiT AddressPoolGap))
-> ApiT AddressPoolGap -> Maybe (ApiT AddressPoolGap)
forall a b. (a -> b) -> a -> b
$ AddressPoolGap -> ApiT AddressPoolGap
forall a. a -> ApiT a
ApiT AddressPoolGap
wGap)

-- | Arguments for 'wallet get' command
data WalletGetArgs = WalletGetArgs
    { WalletGetArgs -> Port "Wallet"
_port :: Port "Wallet"
    , WalletGetArgs -> WalletId
_id :: WalletId
    }

cmdWalletGet
    :: ToJSON wallet
    => WalletClient wallet
    -> Mod CommandFields (IO ())
cmdWalletGet :: WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletGet WalletClient wallet
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"get" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Fetch the wallet with specified id."
  where
    cmd :: Parser (IO ())
cmd = (WalletGetArgs -> IO ()) -> Parser WalletGetArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WalletGetArgs -> IO ()
exec (Parser WalletGetArgs -> Parser (IO ()))
-> Parser WalletGetArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> WalletId -> WalletGetArgs
WalletGetArgs
        (Port "Wallet" -> WalletId -> WalletGetArgs)
-> Parser (Port "Wallet") -> Parser (WalletId -> WalletGetArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser (WalletId -> WalletGetArgs)
-> Parser WalletId -> Parser WalletGetArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
    exec :: WalletGetArgs -> IO ()
exec (WalletGetArgs Port "Wallet"
wPort WalletId
wId) = do
        Port "Wallet" -> (wallet -> ByteString) -> ClientM wallet -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort wallet -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM wallet -> IO ()) -> ClientM wallet -> IO ()
forall a b. (a -> b) -> a -> b
$ WalletClient wallet -> ApiT WalletId -> ClientM wallet
forall wallet.
WalletClient wallet -> ApiT WalletId -> ClientM wallet
getWallet WalletClient wallet
mkClient (ApiT WalletId -> ClientM wallet)
-> ApiT WalletId -> ClientM wallet
forall a b. (a -> b) -> a -> b
$
            WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId

cmdWalletUpdate
    :: (ToJSON wallet, CmdWalletUpdatePassphrase wallet)
    => WalletClient wallet
    -> Mod CommandFields (IO ())
cmdWalletUpdate :: WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletUpdate WalletClient wallet
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"update" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmds) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Update a wallet."
  where
    cmds :: Parser (IO ())
cmds = Mod CommandFields (IO ()) -> Parser (IO ())
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields (IO ()) -> Parser (IO ()))
-> Mod CommandFields (IO ()) -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Mod CommandFields (IO ())
forall a. Monoid a => a
mempty
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> WalletClient wallet -> Mod CommandFields (IO ())
forall wallet.
ToJSON wallet =>
WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletUpdateName WalletClient wallet
mkClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> WalletClient wallet -> Mod CommandFields (IO ())
forall wallet.
(CmdWalletUpdatePassphrase wallet, ToJSON wallet) =>
WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletUpdatePassphrase WalletClient wallet
mkClient

-- | Arguments for 'wallet update name' command
data WalletUpdateNameArgs = WalletUpdateNameArgs
    { WalletUpdateNameArgs -> Port "Wallet"
_port :: Port "Wallet"
    , WalletUpdateNameArgs -> WalletId
_id :: WalletId
    , WalletUpdateNameArgs -> WalletName
_name :: WalletName
    }

cmdWalletUpdateName
    :: ToJSON wallet
    => WalletClient wallet
    -> Mod CommandFields (IO ())
cmdWalletUpdateName :: WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletUpdateName WalletClient wallet
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"name" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Update a wallet's name."
  where
    cmd :: Parser (IO ())
cmd = (WalletUpdateNameArgs -> IO ())
-> Parser WalletUpdateNameArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WalletUpdateNameArgs -> IO ()
exec (Parser WalletUpdateNameArgs -> Parser (IO ()))
-> Parser WalletUpdateNameArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> WalletId -> WalletName -> WalletUpdateNameArgs
WalletUpdateNameArgs
        (Port "Wallet" -> WalletId -> WalletName -> WalletUpdateNameArgs)
-> Parser (Port "Wallet")
-> Parser (WalletId -> WalletName -> WalletUpdateNameArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser (WalletId -> WalletName -> WalletUpdateNameArgs)
-> Parser WalletId -> Parser (WalletName -> WalletUpdateNameArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
        Parser (WalletName -> WalletUpdateNameArgs)
-> Parser WalletName -> Parser WalletUpdateNameArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletName
walletNameArgument
    exec :: WalletUpdateNameArgs -> IO ()
exec (WalletUpdateNameArgs Port "Wallet"
wPort WalletId
wId WalletName
wName) = do
        Port "Wallet" -> (wallet -> ByteString) -> ClientM wallet -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort wallet -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM wallet -> IO ()) -> ClientM wallet -> IO ()
forall a b. (a -> b) -> a -> b
$ WalletClient wallet
-> ApiT WalletId -> WalletPutData -> ClientM wallet
forall wallet.
WalletClient wallet
-> ApiT WalletId -> WalletPutData -> ClientM wallet
putWallet WalletClient wallet
mkClient
            (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId)
            (Maybe (ApiT WalletName) -> WalletPutData
WalletPutData (Maybe (ApiT WalletName) -> WalletPutData)
-> Maybe (ApiT WalletName) -> WalletPutData
forall a b. (a -> b) -> a -> b
$ ApiT WalletName -> Maybe (ApiT WalletName)
forall a. a -> Maybe a
Just (WalletName -> ApiT WalletName
forall a. a -> ApiT a
ApiT WalletName
wName))

data UpdatePassphraseCredential = MnemonicCredentials | OldPasswordCredentials
    deriving UpdatePassphraseCredential -> UpdatePassphraseCredential -> Bool
(UpdatePassphraseCredential -> UpdatePassphraseCredential -> Bool)
-> (UpdatePassphraseCredential
    -> UpdatePassphraseCredential -> Bool)
-> Eq UpdatePassphraseCredential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePassphraseCredential -> UpdatePassphraseCredential -> Bool
$c/= :: UpdatePassphraseCredential -> UpdatePassphraseCredential -> Bool
== :: UpdatePassphraseCredential -> UpdatePassphraseCredential -> Bool
$c== :: UpdatePassphraseCredential -> UpdatePassphraseCredential -> Bool
Eq

-- | Which json schema to use for output
useMnemonicOption :: Parser UpdatePassphraseCredential
useMnemonicOption :: Parser UpdatePassphraseCredential
useMnemonicOption = UpdatePassphraseCredential
-> UpdatePassphraseCredential
-> Mod FlagFields UpdatePassphraseCredential
-> Parser UpdatePassphraseCredential
forall a. a -> a -> Mod FlagFields a -> Parser a
flag UpdatePassphraseCredential
OldPasswordCredentials UpdatePassphraseCredential
MnemonicCredentials
    (Mod FlagFields UpdatePassphraseCredential
 -> Parser UpdatePassphraseCredential)
-> Mod FlagFields UpdatePassphraseCredential
-> Parser UpdatePassphraseCredential
forall a b. (a -> b) -> a -> b
$ String -> Mod FlagFields UpdatePassphraseCredential
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"mnemonic"
        Mod FlagFields UpdatePassphraseCredential
-> Mod FlagFields UpdatePassphraseCredential
-> Mod FlagFields UpdatePassphraseCredential
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields UpdatePassphraseCredential
forall (f :: * -> *) a. String -> Mod f a
help String
"use mnemonic to authorize the passphrase change"

-- | Arguments for 'wallet update passphrase' command
data WalletUpdatePassphraseArgs = WalletUpdatePassphraseArgs
    { WalletUpdatePassphraseArgs -> Port "Wallet"
_port :: Port "Wallet"
    , WalletUpdatePassphraseArgs -> WalletId
_id :: WalletId
    , WalletUpdatePassphraseArgs -> UpdatePassphraseCredential
_mnemonic :: UpdatePassphraseCredential
    }

class CmdWalletUpdatePassphrase wallet where
    cmdWalletUpdatePassphrase
        :: ToJSON wallet
        => WalletClient wallet
        -> Mod CommandFields (IO ())

instance CmdWalletUpdatePassphrase ApiWallet where
    cmdWalletUpdatePassphrase :: WalletClient ApiWallet -> Mod CommandFields (IO ())
cmdWalletUpdatePassphrase WalletClient ApiWallet
mkClient =
        String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"passphrase" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
            InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Update a wallet's passphrase."
        where
            cmd :: Parser (IO ())
cmd = (WalletUpdatePassphraseArgs -> IO ())
-> Parser WalletUpdatePassphraseArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WalletUpdatePassphraseArgs -> IO ()
exec (Parser WalletUpdatePassphraseArgs -> Parser (IO ()))
-> Parser WalletUpdatePassphraseArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet"
-> WalletId
-> UpdatePassphraseCredential
-> WalletUpdatePassphraseArgs
WalletUpdatePassphraseArgs
                (Port "Wallet"
 -> WalletId
 -> UpdatePassphraseCredential
 -> WalletUpdatePassphraseArgs)
-> Parser (Port "Wallet")
-> Parser
     (WalletId
      -> UpdatePassphraseCredential -> WalletUpdatePassphraseArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
                Parser
  (WalletId
   -> UpdatePassphraseCredential -> WalletUpdatePassphraseArgs)
-> Parser WalletId
-> Parser
     (UpdatePassphraseCredential -> WalletUpdatePassphraseArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
                Parser (UpdatePassphraseCredential -> WalletUpdatePassphraseArgs)
-> Parser UpdatePassphraseCredential
-> Parser WalletUpdatePassphraseArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UpdatePassphraseCredential
useMnemonicOption
            exec :: WalletUpdatePassphraseArgs -> IO ()
exec (WalletUpdatePassphraseArgs Port "Wallet"
wPort WalletId
wId UpdatePassphraseCredential
credentialOption) = do
                Either ClientError ApiWallet
res <- Port "Wallet"
-> ClientM ApiWallet -> IO (Either ClientError ApiWallet)
forall a. Port "Wallet" -> ClientM a -> IO (Either ClientError a)
sendRequest Port "Wallet"
wPort (ClientM ApiWallet -> IO (Either ClientError ApiWallet))
-> ClientM ApiWallet -> IO (Either ClientError ApiWallet)
forall a b. (a -> b) -> a -> b
$ WalletClient ApiWallet -> ApiT WalletId -> ClientM ApiWallet
forall wallet.
WalletClient wallet -> ApiT WalletId -> ClientM wallet
getWallet WalletClient ApiWallet
mkClient (ApiT WalletId -> ClientM ApiWallet)
-> ApiT WalletId -> ClientM ApiWallet
forall a b. (a -> b) -> a -> b
$ WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId
                case Either ClientError ApiWallet
res of
                    Right ApiWallet
_ -> do
                        Either (Passphrase "user") (SomeMnemonic, Maybe SomeMnemonic)
wCredentials <-
                            if UpdatePassphraseCredential
credentialOption UpdatePassphraseCredential -> UpdatePassphraseCredential -> Bool
forall a. Eq a => a -> a -> Bool
== UpdatePassphraseCredential
OldPasswordCredentials
                            then Passphrase "user"
-> Either (Passphrase "user") (SomeMnemonic, Maybe SomeMnemonic)
forall a b. a -> Either a b
Left (Passphrase "user"
 -> Either (Passphrase "user") (SomeMnemonic, Maybe SomeMnemonic))
-> IO (Passphrase "user")
-> IO
     (Either (Passphrase "user") (SomeMnemonic, Maybe SomeMnemonic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO (Passphrase "user")
forall (a :: Symbol).
(PassphraseMinLength a, PassphraseMaxLength a) =>
Text -> IO (Passphrase a)
getPassphrase
                                    Text
"Please enter your current passphrase: "
                            else (SomeMnemonic, Maybe SomeMnemonic)
-> Either (Passphrase "user") (SomeMnemonic, Maybe SomeMnemonic)
forall a b. b -> Either a b
Right ((SomeMnemonic, Maybe SomeMnemonic)
 -> Either (Passphrase "user") (SomeMnemonic, Maybe SomeMnemonic))
-> IO (SomeMnemonic, Maybe SomeMnemonic)
-> IO
     (Either (Passphrase "user") (SomeMnemonic, Maybe SomeMnemonic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (SomeMnemonic, Maybe SomeMnemonic)
getMnemonics
                        Passphrase "user"
wPassphraseNew <- Text -> IO (Passphrase "user")
forall (a :: Symbol).
(PassphraseMinLength a, PassphraseMaxLength a) =>
Text -> IO (Passphrase a)
getPassphraseWithConfirm
                            Text
"Please enter a new passphrase: "
                        Port "Wallet"
-> (NoContent -> ByteString) -> ClientM NoContent -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort (ByteString -> NoContent -> ByteString
forall a b. a -> b -> a
const ByteString
forall a. Monoid a => a
mempty) (ClientM NoContent -> IO ()) -> ClientM NoContent -> IO ()
forall a b. (a -> b) -> a -> b
$
                            WalletClient ApiWallet
-> ApiT WalletId
-> WalletPutPassphraseFormat ApiWallet
-> ClientM NoContent
forall wallet.
WalletClient wallet
-> ApiT WalletId
-> WalletPutPassphraseFormat wallet
-> ClientM NoContent
putWalletPassphrase WalletClient ApiWallet
mkClient (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId) (WalletPutPassphraseFormat ApiWallet -> ClientM NoContent)
-> WalletPutPassphraseFormat ApiWallet -> ClientM NoContent
forall a b. (a -> b) -> a -> b
$
                                Either
  WalletPutPassphraseOldPassphraseData
  WalletPutPassphraseMnemonicData
-> WalletPutPassphraseData
WalletPutPassphraseData (Either
   WalletPutPassphraseOldPassphraseData
   WalletPutPassphraseMnemonicData
 -> WalletPutPassphraseData)
-> Either
     WalletPutPassphraseOldPassphraseData
     WalletPutPassphraseMnemonicData
-> WalletPutPassphraseData
forall a b. (a -> b) -> a -> b
$
                                let oldPassA :: Passphrase "user" -> WalletPutPassphraseOldPassphraseData
oldPassA Passphrase "user"
wPassphraseOld =
                                        ApiT (Passphrase "user")
-> ApiT (Passphrase "user") -> WalletPutPassphraseOldPassphraseData
WalletPutPassphraseOldPassphraseData
                                            (Passphrase "user" -> ApiT (Passphrase "user")
forall a. a -> ApiT a
ApiT Passphrase "user"
wPassphraseOld)
                                            (Passphrase "user" -> ApiT (Passphrase "user")
forall a. a -> ApiT a
ApiT Passphrase "user"
wPassphraseNew)
                                    mnemonicA :: (SomeMnemonic, Maybe SomeMnemonic)
-> WalletPutPassphraseMnemonicData
mnemonicA (SomeMnemonic
wMnemonic, Maybe SomeMnemonic
wSndFactor) =
                                        ApiMnemonicT (AllowedMnemonics 'Shelley)
-> Maybe (ApiMnemonicT (AllowedMnemonics 'SndFactor))
-> ApiT (Passphrase "user")
-> WalletPutPassphraseMnemonicData
WalletPutPassphraseMnemonicData
                                            (SomeMnemonic -> ApiMnemonicT '[15, 18, 21, 24]
forall (sizes :: [Nat]). SomeMnemonic -> ApiMnemonicT sizes
ApiMnemonicT SomeMnemonic
wMnemonic)
                                            (SomeMnemonic -> ApiMnemonicT '[9, 12]
forall (sizes :: [Nat]). SomeMnemonic -> ApiMnemonicT sizes
ApiMnemonicT (SomeMnemonic -> ApiMnemonicT '[9, 12])
-> Maybe SomeMnemonic -> Maybe (ApiMnemonicT '[9, 12])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SomeMnemonic
wSndFactor)
                                            (Passphrase "user" -> ApiT (Passphrase "user")
forall a. a -> ApiT a
ApiT Passphrase "user"
wPassphraseNew)
                                in (Passphrase "user" -> WalletPutPassphraseOldPassphraseData)
-> ((SomeMnemonic, Maybe SomeMnemonic)
    -> WalletPutPassphraseMnemonicData)
-> Either (Passphrase "user") (SomeMnemonic, Maybe SomeMnemonic)
-> Either
     WalletPutPassphraseOldPassphraseData
     WalletPutPassphraseMnemonicData
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Passphrase "user" -> WalletPutPassphraseOldPassphraseData
oldPassA (SomeMnemonic, Maybe SomeMnemonic)
-> WalletPutPassphraseMnemonicData
mnemonicA Either (Passphrase "user") (SomeMnemonic, Maybe SomeMnemonic)
wCredentials
                    Left ClientError
_ ->
                        (ApiWallet -> ByteString) -> Either ClientError ApiWallet -> IO ()
forall a. (a -> ByteString) -> Either ClientError a -> IO ()
handleResponse ApiWallet -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty Either ClientError ApiWallet
res

data ByronWalletUpdatePassphraseArgs = ByronWalletUpdatePassphraseArgs
    { ByronWalletUpdatePassphraseArgs -> Port "Wallet"
_port :: Port "Wallet"
    , ByronWalletUpdatePassphraseArgs -> WalletId
_id :: WalletId
    }

instance CmdWalletUpdatePassphrase ApiByronWallet where
    cmdWalletUpdatePassphrase :: WalletClient ApiByronWallet -> Mod CommandFields (IO ())
cmdWalletUpdatePassphrase WalletClient ApiByronWallet
mkClient =
        String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"passphrase" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
            InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Update a wallet's passphrase."
        where
            cmd :: Parser (IO ())
cmd = (ByronWalletUpdatePassphraseArgs -> IO ())
-> Parser ByronWalletUpdatePassphraseArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByronWalletUpdatePassphraseArgs -> IO ()
exec (Parser ByronWalletUpdatePassphraseArgs -> Parser (IO ()))
-> Parser ByronWalletUpdatePassphraseArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> WalletId -> ByronWalletUpdatePassphraseArgs
ByronWalletUpdatePassphraseArgs
                (Port "Wallet" -> WalletId -> ByronWalletUpdatePassphraseArgs)
-> Parser (Port "Wallet")
-> Parser (WalletId -> ByronWalletUpdatePassphraseArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
                Parser (WalletId -> ByronWalletUpdatePassphraseArgs)
-> Parser WalletId -> Parser ByronWalletUpdatePassphraseArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
            exec :: ByronWalletUpdatePassphraseArgs -> IO ()
exec (ByronWalletUpdatePassphraseArgs Port "Wallet"
wPort WalletId
wId) = do
                Either ClientError ApiByronWallet
res <- Port "Wallet"
-> ClientM ApiByronWallet -> IO (Either ClientError ApiByronWallet)
forall a. Port "Wallet" -> ClientM a -> IO (Either ClientError a)
sendRequest Port "Wallet"
wPort (ClientM ApiByronWallet -> IO (Either ClientError ApiByronWallet))
-> ClientM ApiByronWallet -> IO (Either ClientError ApiByronWallet)
forall a b. (a -> b) -> a -> b
$ WalletClient ApiByronWallet
-> ApiT WalletId -> ClientM ApiByronWallet
forall wallet.
WalletClient wallet -> ApiT WalletId -> ClientM wallet
getWallet WalletClient ApiByronWallet
mkClient (ApiT WalletId -> ClientM ApiByronWallet)
-> ApiT WalletId -> ClientM ApiByronWallet
forall a b. (a -> b) -> a -> b
$ WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId
                case Either ClientError ApiByronWallet
res of
                    Right ApiByronWallet
_ -> do
                        Passphrase "lenient"
wPassphraseOld <- Text -> IO (Passphrase "lenient")
forall (a :: Symbol).
(PassphraseMinLength a, PassphraseMaxLength a) =>
Text -> IO (Passphrase a)
getPassphrase
                            Text
"Please enter your current passphrase: "
                        Passphrase "user"
wPassphraseNew <- Text -> IO (Passphrase "user")
forall (a :: Symbol).
(PassphraseMinLength a, PassphraseMaxLength a) =>
Text -> IO (Passphrase a)
getPassphraseWithConfirm
                            Text
"Please enter a new passphrase: "
                        Port "Wallet"
-> (NoContent -> ByteString) -> ClientM NoContent -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort (ByteString -> NoContent -> ByteString
forall a b. a -> b -> a
const ByteString
forall a. Monoid a => a
mempty) (ClientM NoContent -> IO ()) -> ClientM NoContent -> IO ()
forall a b. (a -> b) -> a -> b
$
                            WalletClient ApiByronWallet
-> ApiT WalletId
-> WalletPutPassphraseFormat ApiByronWallet
-> ClientM NoContent
forall wallet.
WalletClient wallet
-> ApiT WalletId
-> WalletPutPassphraseFormat wallet
-> ClientM NoContent
putWalletPassphrase WalletClient ApiByronWallet
mkClient (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId) (WalletPutPassphraseFormat ApiByronWallet -> ClientM NoContent)
-> WalletPutPassphraseFormat ApiByronWallet -> ClientM NoContent
forall a b. (a -> b) -> a -> b
$
                                Maybe (ApiT (Passphrase "lenient"))
-> ApiT (Passphrase "user") -> ByronWalletPutPassphraseData
ByronWalletPutPassphraseData
                                    (ApiT (Passphrase "lenient") -> Maybe (ApiT (Passphrase "lenient"))
forall a. a -> Maybe a
Just (ApiT (Passphrase "lenient")
 -> Maybe (ApiT (Passphrase "lenient")))
-> ApiT (Passphrase "lenient")
-> Maybe (ApiT (Passphrase "lenient"))
forall a b. (a -> b) -> a -> b
$ Passphrase "lenient" -> ApiT (Passphrase "lenient")
forall a. a -> ApiT a
ApiT Passphrase "lenient"
wPassphraseOld)
                                    (Passphrase "user" -> ApiT (Passphrase "user")
forall a. a -> ApiT a
ApiT Passphrase "user"
wPassphraseNew)

                    Left ClientError
_ ->
                        (ApiByronWallet -> ByteString)
-> Either ClientError ApiByronWallet -> IO ()
forall a. (a -> ByteString) -> Either ClientError a -> IO ()
handleResponse ApiByronWallet -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty Either ClientError ApiByronWallet
res

-- | Arguments for 'wallet delete' command
data WalletDeleteArgs = WalletDeleteArgs
    { WalletDeleteArgs -> Port "Wallet"
_port :: Port "Wallet"
    , WalletDeleteArgs -> WalletId
_id :: WalletId
    }

cmdWalletDelete
    :: WalletClient wallet
    -> Mod CommandFields (IO ())
cmdWalletDelete :: WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletDelete WalletClient wallet
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"delete" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Deletes wallet with specified wallet id."
  where
    cmd :: Parser (IO ())
cmd = (WalletDeleteArgs -> IO ())
-> Parser WalletDeleteArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WalletDeleteArgs -> IO ()
exec (Parser WalletDeleteArgs -> Parser (IO ()))
-> Parser WalletDeleteArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> WalletId -> WalletDeleteArgs
WalletDeleteArgs
        (Port "Wallet" -> WalletId -> WalletDeleteArgs)
-> Parser (Port "Wallet") -> Parser (WalletId -> WalletDeleteArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser (WalletId -> WalletDeleteArgs)
-> Parser WalletId -> Parser WalletDeleteArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
    exec :: WalletDeleteArgs -> IO ()
exec (WalletDeleteArgs Port "Wallet"
wPort WalletId
wId) = do
        Port "Wallet" -> (() -> ByteString) -> ClientM () -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort (ByteString -> () -> ByteString
forall a b. a -> b -> a
const ByteString
"") (ClientM () -> IO ()) -> ClientM () -> IO ()
forall a b. (a -> b) -> a -> b
$ WalletClient wallet -> ApiT WalletId -> ClientM ()
forall wallet. WalletClient wallet -> ApiT WalletId -> ClientM ()
deleteWallet WalletClient wallet
mkClient (ApiT WalletId -> ClientM ()) -> ApiT WalletId -> ClientM ()
forall a b. (a -> b) -> a -> b
$
            WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId

cmdWalletGetUtxoSnapshot
    :: ToJSON wallet
    => WalletClient wallet
    -> Mod CommandFields (IO ())
cmdWalletGetUtxoSnapshot :: WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletGetUtxoSnapshot WalletClient wallet
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"utxo-snapshot" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Get UTxO snapshot for wallet with specified id."
  where
    cmd :: Parser (IO ())
cmd = (WalletGetArgs -> IO ()) -> Parser WalletGetArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WalletGetArgs -> IO ()
exec (Parser WalletGetArgs -> Parser (IO ()))
-> Parser WalletGetArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> WalletId -> WalletGetArgs
WalletGetArgs
        (Port "Wallet" -> WalletId -> WalletGetArgs)
-> Parser (Port "Wallet") -> Parser (WalletId -> WalletGetArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser (WalletId -> WalletGetArgs)
-> Parser WalletId -> Parser WalletGetArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
    exec :: WalletGetArgs -> IO ()
exec (WalletGetArgs Port "Wallet"
wPort WalletId
wId) = do
        Either ClientError wallet
res <- Port "Wallet" -> ClientM wallet -> IO (Either ClientError wallet)
forall a. Port "Wallet" -> ClientM a -> IO (Either ClientError a)
sendRequest Port "Wallet"
wPort (ClientM wallet -> IO (Either ClientError wallet))
-> ClientM wallet -> IO (Either ClientError wallet)
forall a b. (a -> b) -> a -> b
$ WalletClient wallet -> ApiT WalletId -> ClientM wallet
forall wallet.
WalletClient wallet -> ApiT WalletId -> ClientM wallet
getWallet WalletClient wallet
mkClient (ApiT WalletId -> ClientM wallet)
-> ApiT WalletId -> ClientM wallet
forall a b. (a -> b) -> a -> b
$ WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId
        case Either ClientError wallet
res of
            Right wallet
_ -> do
                Port "Wallet"
-> (ApiWalletUtxoSnapshot -> ByteString)
-> ClientM ApiWalletUtxoSnapshot
-> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort ApiWalletUtxoSnapshot -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM ApiWalletUtxoSnapshot -> IO ())
-> ClientM ApiWalletUtxoSnapshot -> IO ()
forall a b. (a -> b) -> a -> b
$
                    WalletClient wallet
-> ApiT WalletId -> ClientM ApiWalletUtxoSnapshot
forall wallet.
WalletClient wallet
-> ApiT WalletId -> ClientM ApiWalletUtxoSnapshot
getWalletUtxoSnapshot WalletClient wallet
mkClient (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId)
            Left ClientError
_ ->
                (wallet -> ByteString) -> Either ClientError wallet -> IO ()
forall a. (a -> ByteString) -> Either ClientError a -> IO ()
handleResponse wallet -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty Either ClientError wallet
res

cmdWalletGetUtxoStatistics
    :: ToJSON wallet
    => WalletClient wallet
    -> Mod CommandFields (IO ())
cmdWalletGetUtxoStatistics :: WalletClient wallet -> Mod CommandFields (IO ())
cmdWalletGetUtxoStatistics WalletClient wallet
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"utxo" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Get UTxO statistics for the wallet with specified id."
  where
    cmd :: Parser (IO ())
cmd = (WalletGetArgs -> IO ()) -> Parser WalletGetArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WalletGetArgs -> IO ()
exec (Parser WalletGetArgs -> Parser (IO ()))
-> Parser WalletGetArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> WalletId -> WalletGetArgs
WalletGetArgs
        (Port "Wallet" -> WalletId -> WalletGetArgs)
-> Parser (Port "Wallet") -> Parser (WalletId -> WalletGetArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser (WalletId -> WalletGetArgs)
-> Parser WalletId -> Parser WalletGetArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
    exec :: WalletGetArgs -> IO ()
exec (WalletGetArgs Port "Wallet"
wPort WalletId
wId) = do
        Either ClientError wallet
res <- Port "Wallet" -> ClientM wallet -> IO (Either ClientError wallet)
forall a. Port "Wallet" -> ClientM a -> IO (Either ClientError a)
sendRequest Port "Wallet"
wPort (ClientM wallet -> IO (Either ClientError wallet))
-> ClientM wallet -> IO (Either ClientError wallet)
forall a b. (a -> b) -> a -> b
$ WalletClient wallet -> ApiT WalletId -> ClientM wallet
forall wallet.
WalletClient wallet -> ApiT WalletId -> ClientM wallet
getWallet WalletClient wallet
mkClient (ApiT WalletId -> ClientM wallet)
-> ApiT WalletId -> ClientM wallet
forall a b. (a -> b) -> a -> b
$ WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId
        case Either ClientError wallet
res of
            Right wallet
_ -> do
                Port "Wallet"
-> (ApiUtxoStatistics -> ByteString)
-> ClientM ApiUtxoStatistics
-> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort ApiUtxoStatistics -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM ApiUtxoStatistics -> IO ())
-> ClientM ApiUtxoStatistics -> IO ()
forall a b. (a -> b) -> a -> b
$
                    WalletClient wallet -> ApiT WalletId -> ClientM ApiUtxoStatistics
forall wallet.
WalletClient wallet -> ApiT WalletId -> ClientM ApiUtxoStatistics
getWalletUtxoStatistics WalletClient wallet
mkClient (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId)
            Left ClientError
_ ->
                (wallet -> ByteString) -> Either ClientError wallet -> IO ()
forall a. (a -> ByteString) -> Either ClientError a -> IO ()
handleResponse wallet -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty Either ClientError wallet
res

{-------------------------------------------------------------------------------
                            Commands - 'transaction'
-------------------------------------------------------------------------------}

data TransactionFeatures = NoShelleyFeatures | ShelleyFeatures
    deriving (Int -> TransactionFeatures -> String -> String
[TransactionFeatures] -> String -> String
TransactionFeatures -> String
(Int -> TransactionFeatures -> String -> String)
-> (TransactionFeatures -> String)
-> ([TransactionFeatures] -> String -> String)
-> Show TransactionFeatures
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TransactionFeatures] -> String -> String
$cshowList :: [TransactionFeatures] -> String -> String
show :: TransactionFeatures -> String
$cshow :: TransactionFeatures -> String
showsPrec :: Int -> TransactionFeatures -> String -> String
$cshowsPrec :: Int -> TransactionFeatures -> String -> String
Show, TransactionFeatures -> TransactionFeatures -> Bool
(TransactionFeatures -> TransactionFeatures -> Bool)
-> (TransactionFeatures -> TransactionFeatures -> Bool)
-> Eq TransactionFeatures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactionFeatures -> TransactionFeatures -> Bool
$c/= :: TransactionFeatures -> TransactionFeatures -> Bool
== :: TransactionFeatures -> TransactionFeatures -> Bool
$c== :: TransactionFeatures -> TransactionFeatures -> Bool
Eq)

-- | Which json schema to use for output
metadataSchemaOption :: Parser TxMetadataSchema
metadataSchemaOption :: Parser TxMetadataSchema
metadataSchemaOption = TxMetadataSchema
-> TxMetadataSchema
-> Mod FlagFields TxMetadataSchema
-> Parser TxMetadataSchema
forall a. a -> a -> Mod FlagFields a -> Parser a
flag TxMetadataSchema
TxMetadataDetailedSchema TxMetadataSchema
TxMetadataNoSchema
    (Mod FlagFields TxMetadataSchema -> Parser TxMetadataSchema)
-> Mod FlagFields TxMetadataSchema -> Parser TxMetadataSchema
forall a b. (a -> b) -> a -> b
$ String -> Mod FlagFields TxMetadataSchema
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"simple-metadata"
        Mod FlagFields TxMetadataSchema
-> Mod FlagFields TxMetadataSchema
-> Mod FlagFields TxMetadataSchema
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields TxMetadataSchema
forall (f :: * -> *) a. String -> Mod f a
help String
"output metadata json in no-schema encoding"

-- | cardano-wallet transaction
cmdTransaction
    :: ToJSON wallet
    => TransactionClient
    -> WalletClient wallet
    -> Mod CommandFields (IO ())
cmdTransaction :: TransactionClient
-> WalletClient wallet -> Mod CommandFields (IO ())
cmdTransaction = TransactionFeatures
-> TransactionClient
-> WalletClient wallet
-> Mod CommandFields (IO ())
forall wallet.
ToJSON wallet =>
TransactionFeatures
-> TransactionClient
-> WalletClient wallet
-> Mod CommandFields (IO ())
cmdTransactionBase TransactionFeatures
ShelleyFeatures

cmdTransactionBase
    :: ToJSON wallet
    => TransactionFeatures
    -> TransactionClient
    -> WalletClient wallet
    -> Mod CommandFields (IO ())
cmdTransactionBase :: TransactionFeatures
-> TransactionClient
-> WalletClient wallet
-> Mod CommandFields (IO ())
cmdTransactionBase TransactionFeatures
isShelley TransactionClient
mkTxClient WalletClient wallet
mkWalletClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"transaction" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmds) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"About transactions"
  where
    cmds :: Parser (IO ())
cmds = Mod CommandFields (IO ()) -> Parser (IO ())
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields (IO ()) -> Parser (IO ()))
-> Mod CommandFields (IO ()) -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Mod CommandFields (IO ())
forall a. Monoid a => a
mempty
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> TransactionFeatures
-> TransactionClient
-> WalletClient wallet
-> Mod CommandFields (IO ())
forall wallet.
ToJSON wallet =>
TransactionFeatures
-> TransactionClient
-> WalletClient wallet
-> Mod CommandFields (IO ())
cmdTransactionCreate TransactionFeatures
isShelley TransactionClient
mkTxClient WalletClient wallet
mkWalletClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> TransactionFeatures
-> TransactionClient
-> WalletClient wallet
-> Mod CommandFields (IO ())
forall wallet.
ToJSON wallet =>
TransactionFeatures
-> TransactionClient
-> WalletClient wallet
-> Mod CommandFields (IO ())
cmdTransactionFees TransactionFeatures
isShelley TransactionClient
mkTxClient WalletClient wallet
mkWalletClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> TransactionClient -> Mod CommandFields (IO ())
cmdTransactionList TransactionClient
mkTxClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> TransactionClient -> Mod CommandFields (IO ())
cmdTransactionSubmit TransactionClient
mkTxClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> TransactionClient -> Mod CommandFields (IO ())
cmdTransactionForget TransactionClient
mkTxClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> TransactionClient -> Mod CommandFields (IO ())
cmdTransactionGet TransactionClient
mkTxClient

-- | Arguments for 'transaction create' command
data TransactionCreateArgs t = TransactionCreateArgs
    { TransactionCreateArgs t -> Port "Wallet"
_port :: Port "Wallet"
    , TransactionCreateArgs t -> WalletId
_id :: WalletId
    , TransactionCreateArgs t -> NonEmpty Text
_payments :: NonEmpty Text
    , TransactionCreateArgs t -> Maybe TxMetadataWithSchema
_metadata :: Maybe TxMetadataWithSchema
    , TransactionCreateArgs t
-> Maybe (Quantity "second" NominalDiffTime)
_timeToLive :: Maybe (Quantity "second" NominalDiffTime)
    }

whenShelley :: a -> Parser a -> TransactionFeatures -> Parser a
whenShelley :: a -> Parser a -> TransactionFeatures -> Parser a
whenShelley a
j Parser a
s = \case
    TransactionFeatures
NoShelleyFeatures -> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
j
    TransactionFeatures
ShelleyFeatures -> Parser a
s

cmdTransactionCreate
    :: ToJSON wallet
    => TransactionFeatures
    -> TransactionClient
    -> WalletClient wallet
    -> Mod CommandFields (IO ())
cmdTransactionCreate :: TransactionFeatures
-> TransactionClient
-> WalletClient wallet
-> Mod CommandFields (IO ())
cmdTransactionCreate TransactionFeatures
isShelley TransactionClient
mkTxClient WalletClient wallet
mkWalletClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"create" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Create and submit a new transaction."
  where
    cmd :: Parser (IO ())
cmd = (TransactionCreateArgs Any -> IO ())
-> Parser (TransactionCreateArgs Any) -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TransactionCreateArgs Any -> IO ()
exec (Parser (TransactionCreateArgs Any) -> Parser (IO ()))
-> Parser (TransactionCreateArgs Any) -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet"
-> WalletId
-> NonEmpty Text
-> Maybe TxMetadataWithSchema
-> Maybe (Quantity "second" NominalDiffTime)
-> TransactionCreateArgs Any
forall t.
Port "Wallet"
-> WalletId
-> NonEmpty Text
-> Maybe TxMetadataWithSchema
-> Maybe (Quantity "second" NominalDiffTime)
-> TransactionCreateArgs t
TransactionCreateArgs
        (Port "Wallet"
 -> WalletId
 -> NonEmpty Text
 -> Maybe TxMetadataWithSchema
 -> Maybe (Quantity "second" NominalDiffTime)
 -> TransactionCreateArgs Any)
-> Parser (Port "Wallet")
-> Parser
     (WalletId
      -> NonEmpty Text
      -> Maybe TxMetadataWithSchema
      -> Maybe (Quantity "second" NominalDiffTime)
      -> TransactionCreateArgs Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser
  (WalletId
   -> NonEmpty Text
   -> Maybe TxMetadataWithSchema
   -> Maybe (Quantity "second" NominalDiffTime)
   -> TransactionCreateArgs Any)
-> Parser WalletId
-> Parser
     (NonEmpty Text
      -> Maybe TxMetadataWithSchema
      -> Maybe (Quantity "second" NominalDiffTime)
      -> TransactionCreateArgs Any)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
        Parser
  (NonEmpty Text
   -> Maybe TxMetadataWithSchema
   -> Maybe (Quantity "second" NominalDiffTime)
   -> TransactionCreateArgs Any)
-> Parser (NonEmpty Text)
-> Parser
     (Maybe TxMetadataWithSchema
      -> Maybe (Quantity "second" NominalDiffTime)
      -> TransactionCreateArgs Any)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Text] -> NonEmpty Text)
-> Parser [Text] -> Parser (NonEmpty Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> NonEmpty Text
forall a. [a] -> NonEmpty a
NE.fromList (Parser Text -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Text
paymentOption)
        Parser
  (Maybe TxMetadataWithSchema
   -> Maybe (Quantity "second" NominalDiffTime)
   -> TransactionCreateArgs Any)
-> Parser (Maybe TxMetadataWithSchema)
-> Parser
     (Maybe (Quantity "second" NominalDiffTime)
      -> TransactionCreateArgs Any)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe TxMetadataWithSchema
-> Parser (Maybe TxMetadataWithSchema)
-> TransactionFeatures
-> Parser (Maybe TxMetadataWithSchema)
forall a. a -> Parser a -> TransactionFeatures -> Parser a
whenShelley Maybe TxMetadataWithSchema
forall a. Maybe a
Nothing Parser (Maybe TxMetadataWithSchema)
metadataOption TransactionFeatures
isShelley
        Parser
  (Maybe (Quantity "second" NominalDiffTime)
   -> TransactionCreateArgs Any)
-> Parser (Maybe (Quantity "second" NominalDiffTime))
-> Parser (TransactionCreateArgs Any)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Quantity "second" NominalDiffTime)
-> Parser (Maybe (Quantity "second" NominalDiffTime))
-> TransactionFeatures
-> Parser (Maybe (Quantity "second" NominalDiffTime))
forall a. a -> Parser a -> TransactionFeatures -> Parser a
whenShelley Maybe (Quantity "second" NominalDiffTime)
forall a. Maybe a
Nothing Parser (Maybe (Quantity "second" NominalDiffTime))
timeToLiveOption TransactionFeatures
isShelley
    exec :: TransactionCreateArgs Any -> IO ()
exec (TransactionCreateArgs Port "Wallet"
wPort WalletId
wId NonEmpty Text
wAddressAmounts Maybe TxMetadataWithSchema
md Maybe (Quantity "second" NominalDiffTime)
ttl) = do
        NonEmpty (AddressAmount Text)
wPayments <- (TextDecodingError -> IO (NonEmpty (AddressAmount Text)))
-> (NonEmpty (AddressAmount Text)
    -> IO (NonEmpty (AddressAmount Text)))
-> Either TextDecodingError (NonEmpty (AddressAmount Text))
-> IO (NonEmpty (AddressAmount Text))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO (NonEmpty (AddressAmount Text))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (NonEmpty (AddressAmount Text)))
-> (TextDecodingError -> String)
-> TextDecodingError
-> IO (NonEmpty (AddressAmount Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextDecodingError -> String
getTextDecodingError) NonEmpty (AddressAmount Text) -> IO (NonEmpty (AddressAmount Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TextDecodingError (NonEmpty (AddressAmount Text))
 -> IO (NonEmpty (AddressAmount Text)))
-> Either TextDecodingError (NonEmpty (AddressAmount Text))
-> IO (NonEmpty (AddressAmount Text))
forall a b. (a -> b) -> a -> b
$
            (Text -> Either TextDecodingError (AddressAmount Text))
-> NonEmpty Text
-> Either TextDecodingError (NonEmpty (AddressAmount Text))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FromText (AddressAmount Text) =>
Text -> Either TextDecodingError (AddressAmount Text)
forall a. FromText a => Text -> Either TextDecodingError a
fromText @(AddressAmount Text)) NonEmpty Text
wAddressAmounts
        Either ClientError wallet
res <- Port "Wallet" -> ClientM wallet -> IO (Either ClientError wallet)
forall a. Port "Wallet" -> ClientM a -> IO (Either ClientError a)
sendRequest Port "Wallet"
wPort (ClientM wallet -> IO (Either ClientError wallet))
-> ClientM wallet -> IO (Either ClientError wallet)
forall a b. (a -> b) -> a -> b
$ WalletClient wallet -> ApiT WalletId -> ClientM wallet
forall wallet.
WalletClient wallet -> ApiT WalletId -> ClientM wallet
getWallet WalletClient wallet
mkWalletClient (ApiT WalletId -> ClientM wallet)
-> ApiT WalletId -> ClientM wallet
forall a b. (a -> b) -> a -> b
$ WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId
        case Either ClientError wallet
res of
            Right wallet
_ -> do
                Passphrase "user"
wPwd <- Text -> IO (Passphrase "user")
forall (a :: Symbol).
(PassphraseMinLength a, PassphraseMaxLength a) =>
Text -> IO (Passphrase a)
getPassphrase @"user" Text
"Please enter your passphrase: "
                Port "Wallet" -> (Value -> ByteString) -> ClientM Value -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM Value -> IO ()) -> ClientM Value -> IO ()
forall a b. (a -> b) -> a -> b
$ TransactionClient
-> ApiT WalletId
-> PostTransactionOldDataT Value
-> ClientM (ApiTransactionT Value)
postTransaction
                    TransactionClient
mkTxClient
                    (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId)
                    ([Pair] -> Value
Aeson.object
                        [ Key
"payments" Key -> NonEmpty (AddressAmount Text) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty (AddressAmount Text)
wPayments
                        , Key
"passphrase" Key -> ApiT (Passphrase "user") -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Passphrase "user" -> ApiT (Passphrase "user")
forall a. a -> ApiT a
ApiT Passphrase "user"
wPwd
                        , Key
"metadata" Key -> Maybe TxMetadataWithSchema -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TxMetadataWithSchema
md
                        , Key
"time_to_live" Key -> Maybe (Quantity "second" NominalDiffTime) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Quantity "second" NominalDiffTime)
ttl
                        ]
                    )
            Left ClientError
_ ->
                (wallet -> ByteString) -> Either ClientError wallet -> IO ()
forall a. (a -> ByteString) -> Either ClientError a -> IO ()
handleResponse wallet -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty Either ClientError wallet
res

cmdTransactionFees
    :: ToJSON wallet
    => TransactionFeatures
    -> TransactionClient
    -> WalletClient wallet
    -> Mod CommandFields (IO ())
cmdTransactionFees :: TransactionFeatures
-> TransactionClient
-> WalletClient wallet
-> Mod CommandFields (IO ())
cmdTransactionFees TransactionFeatures
isShelley TransactionClient
mkTxClient WalletClient wallet
mkWalletClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"fees" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Estimate fees for a transaction."
  where
    cmd :: Parser (IO ())
cmd = (TransactionCreateArgs Any -> IO ())
-> Parser (TransactionCreateArgs Any) -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TransactionCreateArgs Any -> IO ()
exec (Parser (TransactionCreateArgs Any) -> Parser (IO ()))
-> Parser (TransactionCreateArgs Any) -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet"
-> WalletId
-> NonEmpty Text
-> Maybe TxMetadataWithSchema
-> Maybe (Quantity "second" NominalDiffTime)
-> TransactionCreateArgs Any
forall t.
Port "Wallet"
-> WalletId
-> NonEmpty Text
-> Maybe TxMetadataWithSchema
-> Maybe (Quantity "second" NominalDiffTime)
-> TransactionCreateArgs t
TransactionCreateArgs
        (Port "Wallet"
 -> WalletId
 -> NonEmpty Text
 -> Maybe TxMetadataWithSchema
 -> Maybe (Quantity "second" NominalDiffTime)
 -> TransactionCreateArgs Any)
-> Parser (Port "Wallet")
-> Parser
     (WalletId
      -> NonEmpty Text
      -> Maybe TxMetadataWithSchema
      -> Maybe (Quantity "second" NominalDiffTime)
      -> TransactionCreateArgs Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser
  (WalletId
   -> NonEmpty Text
   -> Maybe TxMetadataWithSchema
   -> Maybe (Quantity "second" NominalDiffTime)
   -> TransactionCreateArgs Any)
-> Parser WalletId
-> Parser
     (NonEmpty Text
      -> Maybe TxMetadataWithSchema
      -> Maybe (Quantity "second" NominalDiffTime)
      -> TransactionCreateArgs Any)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
        Parser
  (NonEmpty Text
   -> Maybe TxMetadataWithSchema
   -> Maybe (Quantity "second" NominalDiffTime)
   -> TransactionCreateArgs Any)
-> Parser (NonEmpty Text)
-> Parser
     (Maybe TxMetadataWithSchema
      -> Maybe (Quantity "second" NominalDiffTime)
      -> TransactionCreateArgs Any)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Text] -> NonEmpty Text)
-> Parser [Text] -> Parser (NonEmpty Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> NonEmpty Text
forall a. [a] -> NonEmpty a
NE.fromList (Parser Text -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Text
paymentOption)
        Parser
  (Maybe TxMetadataWithSchema
   -> Maybe (Quantity "second" NominalDiffTime)
   -> TransactionCreateArgs Any)
-> Parser (Maybe TxMetadataWithSchema)
-> Parser
     (Maybe (Quantity "second" NominalDiffTime)
      -> TransactionCreateArgs Any)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe TxMetadataWithSchema
-> Parser (Maybe TxMetadataWithSchema)
-> TransactionFeatures
-> Parser (Maybe TxMetadataWithSchema)
forall a. a -> Parser a -> TransactionFeatures -> Parser a
whenShelley Maybe TxMetadataWithSchema
forall a. Maybe a
Nothing Parser (Maybe TxMetadataWithSchema)
metadataOption TransactionFeatures
isShelley
        Parser
  (Maybe (Quantity "second" NominalDiffTime)
   -> TransactionCreateArgs Any)
-> Parser (Maybe (Quantity "second" NominalDiffTime))
-> Parser (TransactionCreateArgs Any)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Quantity "second" NominalDiffTime)
-> Parser (Maybe (Quantity "second" NominalDiffTime))
-> TransactionFeatures
-> Parser (Maybe (Quantity "second" NominalDiffTime))
forall a. a -> Parser a -> TransactionFeatures -> Parser a
whenShelley Maybe (Quantity "second" NominalDiffTime)
forall a. Maybe a
Nothing Parser (Maybe (Quantity "second" NominalDiffTime))
timeToLiveOption TransactionFeatures
isShelley
    exec :: TransactionCreateArgs Any -> IO ()
exec (TransactionCreateArgs Port "Wallet"
wPort WalletId
wId NonEmpty Text
wAddressAmounts Maybe TxMetadataWithSchema
md Maybe (Quantity "second" NominalDiffTime)
ttl) = do
        NonEmpty (AddressAmount Text)
wPayments <- (TextDecodingError -> IO (NonEmpty (AddressAmount Text)))
-> (NonEmpty (AddressAmount Text)
    -> IO (NonEmpty (AddressAmount Text)))
-> Either TextDecodingError (NonEmpty (AddressAmount Text))
-> IO (NonEmpty (AddressAmount Text))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO (NonEmpty (AddressAmount Text))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (NonEmpty (AddressAmount Text)))
-> (TextDecodingError -> String)
-> TextDecodingError
-> IO (NonEmpty (AddressAmount Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextDecodingError -> String
getTextDecodingError) NonEmpty (AddressAmount Text) -> IO (NonEmpty (AddressAmount Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TextDecodingError (NonEmpty (AddressAmount Text))
 -> IO (NonEmpty (AddressAmount Text)))
-> Either TextDecodingError (NonEmpty (AddressAmount Text))
-> IO (NonEmpty (AddressAmount Text))
forall a b. (a -> b) -> a -> b
$
            (Text -> Either TextDecodingError (AddressAmount Text))
-> NonEmpty Text
-> Either TextDecodingError (NonEmpty (AddressAmount Text))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FromText (AddressAmount Text) =>
Text -> Either TextDecodingError (AddressAmount Text)
forall a. FromText a => Text -> Either TextDecodingError a
fromText @(AddressAmount Text)) NonEmpty Text
wAddressAmounts
        Either ClientError wallet
res <- Port "Wallet" -> ClientM wallet -> IO (Either ClientError wallet)
forall a. Port "Wallet" -> ClientM a -> IO (Either ClientError a)
sendRequest Port "Wallet"
wPort (ClientM wallet -> IO (Either ClientError wallet))
-> ClientM wallet -> IO (Either ClientError wallet)
forall a b. (a -> b) -> a -> b
$ WalletClient wallet -> ApiT WalletId -> ClientM wallet
forall wallet.
WalletClient wallet -> ApiT WalletId -> ClientM wallet
getWallet WalletClient wallet
mkWalletClient (ApiT WalletId -> ClientM wallet)
-> ApiT WalletId -> ClientM wallet
forall a b. (a -> b) -> a -> b
$ WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId
        case Either ClientError wallet
res of
            Right wallet
_ -> do
                Port "Wallet" -> (ApiFee -> ByteString) -> ClientM ApiFee -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort ApiFee -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM ApiFee -> IO ()) -> ClientM ApiFee -> IO ()
forall a b. (a -> b) -> a -> b
$ TransactionClient
-> ApiT WalletId
-> PostTransactionFeeOldDataT Value
-> ClientM ApiFee
postTransactionFee
                    TransactionClient
mkTxClient
                    (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId)
                    ([Pair] -> Value
Aeson.object
                        [ Key
"payments" Key -> NonEmpty (AddressAmount Text) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty (AddressAmount Text)
wPayments
                        , Key
"metadata" Key -> Maybe TxMetadataWithSchema -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe TxMetadataWithSchema
md
                        , Key
"time_to_live" Key -> Maybe (Quantity "second" NominalDiffTime) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Quantity "second" NominalDiffTime)
ttl
                        ])
            Left ClientError
_ ->
                (wallet -> ByteString) -> Either ClientError wallet -> IO ()
forall a. (a -> ByteString) -> Either ClientError a -> IO ()
handleResponse wallet -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty Either ClientError wallet
res

-- | Arguments for 'transaction list' command.
data TransactionListArgs = TransactionListArgs
    { TransactionListArgs -> Port "Wallet"
_port :: Port "Wallet"
    , TransactionListArgs -> WalletId
_walletId :: WalletId
    , TransactionListArgs -> Maybe Iso8601Time
_timeRangeStart :: Maybe Iso8601Time
    , TransactionListArgs -> Maybe Iso8601Time
_timeRangeEnd :: Maybe Iso8601Time
    , TransactionListArgs -> Maybe SortOrder
_sortOrder :: Maybe SortOrder
    , TransactionListArgs -> TxMetadataSchema
_schema :: TxMetadataSchema
    }

cmdTransactionList
    :: TransactionClient
    -> Mod CommandFields (IO ())
cmdTransactionList :: TransactionClient -> Mod CommandFields (IO ())
cmdTransactionList TransactionClient
mkTxClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"list" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"List the transactions associated with a wallet."
  where
    cmd :: Parser (IO ())
cmd = (TransactionListArgs -> IO ())
-> Parser TransactionListArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TransactionListArgs -> IO ()
exec (Parser TransactionListArgs -> Parser (IO ()))
-> Parser TransactionListArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet"
-> WalletId
-> Maybe Iso8601Time
-> Maybe Iso8601Time
-> Maybe SortOrder
-> TxMetadataSchema
-> TransactionListArgs
TransactionListArgs
        (Port "Wallet"
 -> WalletId
 -> Maybe Iso8601Time
 -> Maybe Iso8601Time
 -> Maybe SortOrder
 -> TxMetadataSchema
 -> TransactionListArgs)
-> Parser (Port "Wallet")
-> Parser
     (WalletId
      -> Maybe Iso8601Time
      -> Maybe Iso8601Time
      -> Maybe SortOrder
      -> TxMetadataSchema
      -> TransactionListArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser
  (WalletId
   -> Maybe Iso8601Time
   -> Maybe Iso8601Time
   -> Maybe SortOrder
   -> TxMetadataSchema
   -> TransactionListArgs)
-> Parser WalletId
-> Parser
     (Maybe Iso8601Time
      -> Maybe Iso8601Time
      -> Maybe SortOrder
      -> TxMetadataSchema
      -> TransactionListArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
        Parser
  (Maybe Iso8601Time
   -> Maybe Iso8601Time
   -> Maybe SortOrder
   -> TxMetadataSchema
   -> TransactionListArgs)
-> Parser (Maybe Iso8601Time)
-> Parser
     (Maybe Iso8601Time
      -> Maybe SortOrder -> TxMetadataSchema -> TransactionListArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Iso8601Time -> Parser (Maybe Iso8601Time)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Iso8601Time
timeRangeStartOption
        Parser
  (Maybe Iso8601Time
   -> Maybe SortOrder -> TxMetadataSchema -> TransactionListArgs)
-> Parser (Maybe Iso8601Time)
-> Parser
     (Maybe SortOrder -> TxMetadataSchema -> TransactionListArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Iso8601Time -> Parser (Maybe Iso8601Time)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Iso8601Time
timeRangeEndOption
        Parser (Maybe SortOrder -> TxMetadataSchema -> TransactionListArgs)
-> Parser (Maybe SortOrder)
-> Parser (TxMetadataSchema -> TransactionListArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser SortOrder -> Parser (Maybe SortOrder)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser SortOrder
sortOrderOption
        Parser (TxMetadataSchema -> TransactionListArgs)
-> Parser TxMetadataSchema -> Parser TransactionListArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxMetadataSchema
metadataSchemaOption
    exec :: TransactionListArgs -> IO ()
exec
        (TransactionListArgs
            Port "Wallet"
wPort WalletId
wId Maybe Iso8601Time
mTimeRangeStart Maybe Iso8601Time
mTimeRangeEnd Maybe SortOrder
mOrder TxMetadataSchema
metadataSchema) =
        Port "Wallet"
-> ([Value] -> ByteString) -> ClientM [Value] -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort [Value] -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM [Value] -> IO ()) -> ClientM [Value] -> IO ()
forall a b. (a -> b) -> a -> b
$ TransactionClient
-> ApiT WalletId
-> Maybe Iso8601Time
-> Maybe Iso8601Time
-> Maybe (ApiT SortOrder)
-> Bool
-> ClientM [ApiTransactionT Value]
listTransactions
            TransactionClient
mkTxClient
            (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId)
            Maybe Iso8601Time
mTimeRangeStart
            Maybe Iso8601Time
mTimeRangeEnd
            (SortOrder -> ApiT SortOrder
forall a. a -> ApiT a
ApiT (SortOrder -> ApiT SortOrder)
-> Maybe SortOrder -> Maybe (ApiT SortOrder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SortOrder
mOrder)
            (TxMetadataSchema
metadataSchema TxMetadataSchema -> TxMetadataSchema -> Bool
forall a. Eq a => a -> a -> Bool
== TxMetadataSchema
TxMetadataNoSchema)

-- | Arguments for 'transaction submit' command
data TransactionSubmitArgs = TransactionSubmitArgs
    { TransactionSubmitArgs -> Port "Wallet"
_port :: Port "Wallet"
    , TransactionSubmitArgs -> ApiBytesT 'Base16 SerialisedTx
_payload :: ApiBytesT 'Base16 SerialisedTx
    }

cmdTransactionSubmit
    :: TransactionClient
    -> Mod CommandFields (IO ())
cmdTransactionSubmit :: TransactionClient -> Mod CommandFields (IO ())
cmdTransactionSubmit TransactionClient
mkTxClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"submit" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Submit an externally-signed transaction."
  where
    cmd :: Parser (IO ())
cmd = (TransactionSubmitArgs -> IO ())
-> Parser TransactionSubmitArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TransactionSubmitArgs -> IO ()
exec (Parser TransactionSubmitArgs -> Parser (IO ()))
-> Parser TransactionSubmitArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet"
-> ApiBytesT 'Base16 SerialisedTx -> TransactionSubmitArgs
TransactionSubmitArgs
        (Port "Wallet"
 -> ApiBytesT 'Base16 SerialisedTx -> TransactionSubmitArgs)
-> Parser (Port "Wallet")
-> Parser (ApiBytesT 'Base16 SerialisedTx -> TransactionSubmitArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser (ApiBytesT 'Base16 SerialisedTx -> TransactionSubmitArgs)
-> Parser (ApiBytesT 'Base16 SerialisedTx)
-> Parser TransactionSubmitArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (ApiBytesT 'Base16 SerialisedTx)
transactionSubmitPayloadArgument
    exec :: TransactionSubmitArgs -> IO ()
exec (TransactionSubmitArgs Port "Wallet"
wPort ApiBytesT 'Base16 SerialisedTx
wPayload) = do
        Port "Wallet"
-> (ApiTxId -> ByteString) -> ClientM ApiTxId -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort ApiTxId -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM ApiTxId -> IO ()) -> ClientM ApiTxId -> IO ()
forall a b. (a -> b) -> a -> b
$
            TransactionClient
-> ApiBytesT 'Base64 SerialisedTx -> ClientM ApiTxId
postExternalTransaction TransactionClient
mkTxClient (ApiBytesT 'Base16 SerialisedTx -> ApiBytesT 'Base64 SerialisedTx
coerce ApiBytesT 'Base16 SerialisedTx
wPayload)

-- | Arguments for 'transaction forget' command
data TransactionForgetArgs = TransactionForgetArgs
    { TransactionForgetArgs -> Port "Wallet"
_port :: Port "Wallet"
    , TransactionForgetArgs -> WalletId
_wid :: WalletId
    , TransactionForgetArgs -> TxId
_txid :: TxId
    }

cmdTransactionForget
    :: TransactionClient
    -> Mod CommandFields (IO ())
cmdTransactionForget :: TransactionClient -> Mod CommandFields (IO ())
cmdTransactionForget TransactionClient
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"forget" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Forget a pending transaction with specified id."
  where
    cmd :: Parser (IO ())
cmd = (TransactionForgetArgs -> IO ())
-> Parser TransactionForgetArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TransactionForgetArgs -> IO ()
exec (Parser TransactionForgetArgs -> Parser (IO ()))
-> Parser TransactionForgetArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> WalletId -> TxId -> TransactionForgetArgs
TransactionForgetArgs
        (Port "Wallet" -> WalletId -> TxId -> TransactionForgetArgs)
-> Parser (Port "Wallet")
-> Parser (WalletId -> TxId -> TransactionForgetArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser (WalletId -> TxId -> TransactionForgetArgs)
-> Parser WalletId -> Parser (TxId -> TransactionForgetArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
        Parser (TxId -> TransactionForgetArgs)
-> Parser TxId -> Parser TransactionForgetArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxId
transactionIdArgument
    exec :: TransactionForgetArgs -> IO ()
exec (TransactionForgetArgs Port "Wallet"
wPort WalletId
wId TxId
txId) = do
        Port "Wallet"
-> (NoContent -> ByteString) -> ClientM NoContent -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort (ByteString -> NoContent -> ByteString
forall a b. a -> b -> a
const ByteString
forall a. Monoid a => a
mempty) (ClientM NoContent -> IO ()) -> ClientM NoContent -> IO ()
forall a b. (a -> b) -> a -> b
$ TransactionClient -> ApiT WalletId -> ApiTxId -> ClientM NoContent
deleteTransaction TransactionClient
mkClient
            (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId)
            (ApiT (Hash "Tx") -> ApiTxId
ApiTxId (ApiT (Hash "Tx") -> ApiTxId) -> ApiT (Hash "Tx") -> ApiTxId
forall a b. (a -> b) -> a -> b
$ Hash "Tx" -> ApiT (Hash "Tx")
forall a. a -> ApiT a
ApiT (Hash "Tx" -> ApiT (Hash "Tx")) -> Hash "Tx" -> ApiT (Hash "Tx")
forall a b. (a -> b) -> a -> b
$ TxId -> Hash "Tx"
getTxId TxId
txId)

-- | Arguments for 'transaction get' command
data TransactionGetArgs = TransactionGetArgs
    { TransactionGetArgs -> Port "Wallet"
_port :: Port "Wallet"
    , TransactionGetArgs -> WalletId
_wid :: WalletId
    , TransactionGetArgs -> TxId
_txid :: TxId
    , TransactionGetArgs -> TxMetadataSchema
_schema :: TxMetadataSchema
    }

cmdTransactionGet
    :: TransactionClient
    -> Mod CommandFields (IO ())
cmdTransactionGet :: TransactionClient -> Mod CommandFields (IO ())
cmdTransactionGet TransactionClient
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"get" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Get a transaction with specified id."
  where
    cmd :: Parser (IO ())
cmd = (TransactionGetArgs -> IO ())
-> Parser TransactionGetArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TransactionGetArgs -> IO ()
exec (Parser TransactionGetArgs -> Parser (IO ()))
-> Parser TransactionGetArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet"
-> WalletId -> TxId -> TxMetadataSchema -> TransactionGetArgs
TransactionGetArgs
        (Port "Wallet"
 -> WalletId -> TxId -> TxMetadataSchema -> TransactionGetArgs)
-> Parser (Port "Wallet")
-> Parser
     (WalletId -> TxId -> TxMetadataSchema -> TransactionGetArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser (WalletId -> TxId -> TxMetadataSchema -> TransactionGetArgs)
-> Parser WalletId
-> Parser (TxId -> TxMetadataSchema -> TransactionGetArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
        Parser (TxId -> TxMetadataSchema -> TransactionGetArgs)
-> Parser TxId -> Parser (TxMetadataSchema -> TransactionGetArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxId
transactionIdArgument
        Parser (TxMetadataSchema -> TransactionGetArgs)
-> Parser TxMetadataSchema -> Parser TransactionGetArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TxMetadataSchema
metadataSchemaOption
    exec :: TransactionGetArgs -> IO ()
exec (TransactionGetArgs Port "Wallet"
wPort WalletId
wId TxId
txId TxMetadataSchema
metadataSchema ) = do
        Port "Wallet" -> (Value -> ByteString) -> ClientM Value -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM Value -> IO ()) -> ClientM Value -> IO ()
forall a b. (a -> b) -> a -> b
$ TransactionClient
-> ApiT WalletId
-> ApiTxId
-> TxMetadataSchema
-> ClientM (ApiTransactionT Value)
getTransaction TransactionClient
mkClient
            (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId)
            (ApiT (Hash "Tx") -> ApiTxId
ApiTxId (ApiT (Hash "Tx") -> ApiTxId) -> ApiT (Hash "Tx") -> ApiTxId
forall a b. (a -> b) -> a -> b
$ Hash "Tx" -> ApiT (Hash "Tx")
forall a. a -> ApiT a
ApiT (Hash "Tx" -> ApiT (Hash "Tx")) -> Hash "Tx" -> ApiT (Hash "Tx")
forall a b. (a -> b) -> a -> b
$ TxId -> Hash "Tx"
getTxId TxId
txId)
            TxMetadataSchema
metadataSchema

{-------------------------------------------------------------------------------
                            Commands - 'address'
-------------------------------------------------------------------------------}

cmdAddress
    :: AddressClient
    -> Mod CommandFields (IO ())
cmdAddress :: AddressClient -> Mod CommandFields (IO ())
cmdAddress AddressClient
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"address" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmds) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"About addresses"
  where
    cmds :: Parser (IO ())
cmds = Mod CommandFields (IO ()) -> Parser (IO ())
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields (IO ()) -> Parser (IO ()))
-> Mod CommandFields (IO ()) -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Mod CommandFields (IO ())
forall a. Monoid a => a
mempty
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> AddressClient -> Mod CommandFields (IO ())
cmdAddressList AddressClient
mkClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> AddressClient -> Mod CommandFields (IO ())
cmdAddressCreate AddressClient
mkClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> AddressClient -> Mod CommandFields (IO ())
cmdAddressImport AddressClient
mkClient

-- | Arguments for 'address list' command
data AddressListArgs = AddressListArgs
    { AddressListArgs -> Port "Wallet"
_port :: Port "Wallet"
    , AddressListArgs -> Maybe AddressState
_state :: Maybe AddressState
    , AddressListArgs -> WalletId
_id :: WalletId
    }

cmdAddressList
    :: AddressClient
    -> Mod CommandFields (IO ())
cmdAddressList :: AddressClient -> Mod CommandFields (IO ())
cmdAddressList AddressClient
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"list" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"List all known addresses of a given wallet."
  where
    cmd :: Parser (IO ())
cmd = (AddressListArgs -> IO ())
-> Parser AddressListArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddressListArgs -> IO ()
exec (Parser AddressListArgs -> Parser (IO ()))
-> Parser AddressListArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> Maybe AddressState -> WalletId -> AddressListArgs
AddressListArgs
        (Port "Wallet"
 -> Maybe AddressState -> WalletId -> AddressListArgs)
-> Parser (Port "Wallet")
-> Parser (Maybe AddressState -> WalletId -> AddressListArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser (Maybe AddressState -> WalletId -> AddressListArgs)
-> Parser (Maybe AddressState)
-> Parser (WalletId -> AddressListArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser AddressState -> Parser (Maybe AddressState)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser AddressState
addressStateOption
        Parser (WalletId -> AddressListArgs)
-> Parser WalletId -> Parser AddressListArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
    exec :: AddressListArgs -> IO ()
exec (AddressListArgs Port "Wallet"
wPort Maybe AddressState
wState WalletId
wId) = do
        Port "Wallet"
-> ([Value] -> ByteString) -> ClientM [Value] -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort [Value] -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM [Value] -> IO ()) -> ClientM [Value] -> IO ()
forall a b. (a -> b) -> a -> b
$ AddressClient
-> ApiT WalletId -> Maybe (ApiT AddressState) -> ClientM [Value]
listAddresses AddressClient
mkClient
            (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId)
            (AddressState -> ApiT AddressState
forall a. a -> ApiT a
ApiT (AddressState -> ApiT AddressState)
-> Maybe AddressState -> Maybe (ApiT AddressState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AddressState
wState)

-- | Arguments for 'address create' command
data AddressCreateArgs = AddressCreateArgs
    { AddressCreateArgs -> Port "Wallet"
_port :: Port "Wallet"
    , AddressCreateArgs -> Maybe (Index 'Hardened 'AddressK)
_addressIndex :: Maybe (Index 'Hardened 'AddressK)
    , AddressCreateArgs -> WalletId
_id :: WalletId
    }

cmdAddressCreate
    :: AddressClient
    -> Mod CommandFields (IO ())
cmdAddressCreate :: AddressClient -> Mod CommandFields (IO ())
cmdAddressCreate AddressClient
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"create" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Create a new random address. Only available for random wallets. \
            \The address index is optional, give none to let the wallet generate \
            \a random one."
  where
    cmd :: Parser (IO ())
cmd = (AddressCreateArgs -> IO ())
-> Parser AddressCreateArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddressCreateArgs -> IO ()
exec (Parser AddressCreateArgs -> Parser (IO ()))
-> Parser AddressCreateArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet"
-> Maybe (Index 'Hardened 'AddressK)
-> WalletId
-> AddressCreateArgs
AddressCreateArgs
        (Port "Wallet"
 -> Maybe (Index 'Hardened 'AddressK)
 -> WalletId
 -> AddressCreateArgs)
-> Parser (Port "Wallet")
-> Parser
     (Maybe (Index 'Hardened 'AddressK)
      -> WalletId -> AddressCreateArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser
  (Maybe (Index 'Hardened 'AddressK)
   -> WalletId -> AddressCreateArgs)
-> Parser (Maybe (Index 'Hardened 'AddressK))
-> Parser (WalletId -> AddressCreateArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Index 'Hardened 'AddressK)
-> Parser (Maybe (Index 'Hardened 'AddressK))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (Index 'Hardened 'AddressK)
forall (derivation :: DerivationType) (level :: Depth).
FromText (Index derivation level) =>
Parser (Index derivation level)
addressIndexOption
        Parser (WalletId -> AddressCreateArgs)
-> Parser WalletId -> Parser AddressCreateArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
    exec :: AddressCreateArgs -> IO ()
exec (AddressCreateArgs Port "Wallet"
wPort Maybe (Index 'Hardened 'AddressK)
wIx WalletId
wId) = do
        Passphrase "lenient"
pwd <- Text -> IO (Passphrase "lenient")
forall (a :: Symbol).
(PassphraseMinLength a, PassphraseMaxLength a) =>
Text -> IO (Passphrase a)
getPassphrase Text
"Please enter your passphrase: "
        Port "Wallet" -> (Value -> ByteString) -> ClientM Value -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM Value -> IO ()) -> ClientM Value -> IO ()
forall a b. (a -> b) -> a -> b
$ AddressClient
-> ApiT WalletId
-> ApiPostRandomAddressData
-> ClientM (ApiAddressT Value)
postRandomAddress AddressClient
mkClient
            (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId)
            (ApiT (Passphrase "lenient")
-> Maybe (ApiT (Index 'Hardened 'AddressK))
-> ApiPostRandomAddressData
ApiPostRandomAddressData (Passphrase "lenient" -> ApiT (Passphrase "lenient")
forall a. a -> ApiT a
ApiT Passphrase "lenient"
pwd) (Index 'Hardened 'AddressK -> ApiT (Index 'Hardened 'AddressK)
forall a. a -> ApiT a
ApiT (Index 'Hardened 'AddressK -> ApiT (Index 'Hardened 'AddressK))
-> Maybe (Index 'Hardened 'AddressK)
-> Maybe (ApiT (Index 'Hardened 'AddressK))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Index 'Hardened 'AddressK)
wIx))

-- | Arguments for 'address import' command
data AddressImportArgs = AddressImportArgs
    { AddressImportArgs -> Port "Wallet"
_port :: Port "Wallet"
    , AddressImportArgs -> WalletId
_id :: WalletId
    , AddressImportArgs -> Text
_addr :: Text
    }

cmdAddressImport
    :: AddressClient
    -> Mod CommandFields (IO ())
cmdAddressImport :: AddressClient -> Mod CommandFields (IO ())
cmdAddressImport AddressClient
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"import" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Import a random address generated elsewhere. Only available \
            \for random wallets. The address must belong to the target wallet."
  where
    cmd :: Parser (IO ())
cmd = (AddressImportArgs -> IO ())
-> Parser AddressImportArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddressImportArgs -> IO ()
exec (Parser AddressImportArgs -> Parser (IO ()))
-> Parser AddressImportArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> WalletId -> Text -> AddressImportArgs
AddressImportArgs
        (Port "Wallet" -> WalletId -> Text -> AddressImportArgs)
-> Parser (Port "Wallet")
-> Parser (WalletId -> Text -> AddressImportArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser (WalletId -> Text -> AddressImportArgs)
-> Parser WalletId -> Parser (Text -> AddressImportArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WalletId
walletIdArgument
        Parser (Text -> AddressImportArgs)
-> Parser Text -> Parser AddressImportArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
addressIdArgument
    exec :: AddressImportArgs -> IO ()
exec (AddressImportArgs Port "Wallet"
wPort WalletId
wId Text
addr) = do
        Port "Wallet"
-> (NoContent -> ByteString) -> ClientM NoContent -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort (ByteString -> NoContent -> ByteString
forall a b. a -> b -> a
const ByteString
"") (ClientM NoContent -> IO ()) -> ClientM NoContent -> IO ()
forall a b. (a -> b) -> a -> b
$ AddressClient
-> ApiT WalletId -> ApiAddressIdT Value -> ClientM NoContent
putRandomAddress AddressClient
mkClient (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wId) Text
ApiAddressIdT Value
addr

{-------------------------------------------------------------------------------
                            Commands - 'version'
-------------------------------------------------------------------------------}

cmdVersion :: Mod CommandFields (IO ())
cmdVersion :: Mod CommandFields (IO ())
cmdVersion = String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"version" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser (IO ())
forall b. Parser (IO b)
cmd (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
    InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"Show the program's version."
  where
    cmd :: Parser (IO b)
cmd = IO b -> Parser (IO b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure IO b
forall b. IO b
exec
    exec :: IO b
exec = do
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Version -> GitRevision -> String
showFullVersion Version
version GitRevision
gitRevision
        IO b
forall b. IO b
exitSuccess

{-------------------------------------------------------------------------------
                            Commands - 'stake-pool'
-------------------------------------------------------------------------------}

cmdStakePool
    :: ToJSON apiPool
    => StakePoolClient apiPool
    -> Mod CommandFields (IO ())
cmdStakePool :: StakePoolClient apiPool -> Mod CommandFields (IO ())
cmdStakePool StakePoolClient apiPool
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"stake-pool" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmds) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"About stake pools"
  where
    cmds :: Parser (IO ())
cmds = Mod CommandFields (IO ()) -> Parser (IO ())
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields (IO ()) -> Parser (IO ()))
-> Mod CommandFields (IO ()) -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Mod CommandFields (IO ())
forall a. Monoid a => a
mempty
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> StakePoolClient apiPool -> Mod CommandFields (IO ())
forall apiPool.
ToJSON apiPool =>
StakePoolClient apiPool -> Mod CommandFields (IO ())
cmdStakePoolList StakePoolClient apiPool
mkClient

-- | Arguments for 'stake-pool list' command
data StakePoolListArgs = StakePoolListArgs
    { StakePoolListArgs -> Port "Wallet"
_port :: Port "Wallet"
    , StakePoolListArgs -> Maybe Coin
_stake :: Maybe Coin
    }

cmdStakePoolList
    :: ToJSON apiPool
    => StakePoolClient apiPool
    -> Mod CommandFields (IO ())
cmdStakePoolList :: StakePoolClient apiPool -> Mod CommandFields (IO ())
cmdStakePoolList StakePoolClient apiPool
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"list" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"List all known stake pools."
  where
    cmd :: Parser (IO ())
cmd = (StakePoolListArgs -> IO ())
-> Parser StakePoolListArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StakePoolListArgs -> IO ()
exec (Parser StakePoolListArgs -> Parser (IO ()))
-> Parser StakePoolListArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> Maybe Coin -> StakePoolListArgs
StakePoolListArgs
        (Port "Wallet" -> Maybe Coin -> StakePoolListArgs)
-> Parser (Port "Wallet")
-> Parser (Maybe Coin -> StakePoolListArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption Parser (Maybe Coin -> StakePoolListArgs)
-> Parser (Maybe Coin) -> Parser StakePoolListArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Coin)
stakeOption
    exec :: StakePoolListArgs -> IO ()
exec (StakePoolListArgs Port "Wallet"
wPort Maybe Coin
stake) = do
        Port "Wallet"
-> ([apiPool] -> ByteString) -> ClientM [apiPool] -> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort [apiPool] -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM [apiPool] -> IO ()) -> ClientM [apiPool] -> IO ()
forall a b. (a -> b) -> a -> b
$ StakePoolClient apiPool -> Maybe (ApiT Coin) -> ClientM [apiPool]
forall apiPool.
StakePoolClient apiPool -> Maybe (ApiT Coin) -> ClientM [apiPool]
listPools StakePoolClient apiPool
mkClient (Coin -> ApiT Coin
forall a. a -> ApiT a
ApiT (Coin -> ApiT Coin) -> Maybe Coin -> Maybe (ApiT Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Coin
stake)

{-------------------------------------------------------------------------------
                            Commands - 'network'
-------------------------------------------------------------------------------}

cmdNetwork
    :: NetworkClient
    -> Mod CommandFields (IO ())
cmdNetwork :: NetworkClient -> Mod CommandFields (IO ())
cmdNetwork NetworkClient
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"network" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmds) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"About the network"
  where
    cmds :: Parser (IO ())
cmds = Mod CommandFields (IO ()) -> Parser (IO ())
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields (IO ()) -> Parser (IO ()))
-> Mod CommandFields (IO ()) -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Mod CommandFields (IO ())
forall a. Monoid a => a
mempty
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> NetworkClient -> Mod CommandFields (IO ())
cmdNetworkInformation NetworkClient
mkClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> NetworkClient -> Mod CommandFields (IO ())
cmdNetworkParameters NetworkClient
mkClient
        Mod CommandFields (IO ())
-> Mod CommandFields (IO ()) -> Mod CommandFields (IO ())
forall a. Semigroup a => a -> a -> a
<> NetworkClient -> Mod CommandFields (IO ())
cmdNetworkClock NetworkClient
mkClient

-- | Arguments for 'network information' command
newtype NetworkInformationArgs = NetworkInformationArgs
    { NetworkInformationArgs -> Port "Wallet"
_port :: Port "Wallet"
    }

cmdNetworkInformation
    :: NetworkClient
    -> Mod CommandFields (IO ())
cmdNetworkInformation :: NetworkClient -> Mod CommandFields (IO ())
cmdNetworkInformation NetworkClient
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"information" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"View network information."
  where
    cmd :: Parser (IO ())
cmd = (NetworkInformationArgs -> IO ())
-> Parser NetworkInformationArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NetworkInformationArgs -> IO ()
exec (Parser NetworkInformationArgs -> Parser (IO ()))
-> Parser NetworkInformationArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> NetworkInformationArgs
NetworkInformationArgs
        (Port "Wallet" -> NetworkInformationArgs)
-> Parser (Port "Wallet") -> Parser NetworkInformationArgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
    exec :: NetworkInformationArgs -> IO ()
exec (NetworkInformationArgs Port "Wallet"
wPort) = do
        Port "Wallet"
-> (ApiNetworkInformation -> ByteString)
-> ClientM ApiNetworkInformation
-> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort ApiNetworkInformation -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (NetworkClient -> ClientM ApiNetworkInformation
networkInformation NetworkClient
mkClient)

-- | Arguments for 'network parameters' command
newtype NetworkParametersArgs = NetworkParametersArgs
    { NetworkParametersArgs -> Port "Wallet"
_port :: Port "Wallet"
    }

cmdNetworkParameters
    :: NetworkClient
    -> Mod CommandFields (IO ())
cmdNetworkParameters :: NetworkClient -> Mod CommandFields (IO ())
cmdNetworkParameters NetworkClient
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"parameters" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"View network parameters for the current epoch."
  where
    cmd :: Parser (IO ())
cmd = (NetworkParametersArgs -> IO ())
-> Parser NetworkParametersArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NetworkParametersArgs -> IO ()
exec (Parser NetworkParametersArgs -> Parser (IO ()))
-> Parser NetworkParametersArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> NetworkParametersArgs
NetworkParametersArgs
        (Port "Wallet" -> NetworkParametersArgs)
-> Parser (Port "Wallet") -> Parser NetworkParametersArgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
    exec :: NetworkParametersArgs -> IO ()
exec (NetworkParametersArgs Port "Wallet"
wPort) = do
        Port "Wallet"
-> (ApiNetworkParameters -> ByteString)
-> ClientM ApiNetworkParameters
-> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort ApiNetworkParameters -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM ApiNetworkParameters -> IO ())
-> ClientM ApiNetworkParameters -> IO ()
forall a b. (a -> b) -> a -> b
$ NetworkClient -> ClientM ApiNetworkParameters
networkParameters NetworkClient
mkClient

-- | Arguments for 'network clock' command
data NetworkClockArgs = NetworkClockArgs
    { NetworkClockArgs -> Port "Wallet"
_port :: Port "Wallet"
    , NetworkClockArgs -> Bool
_forceNtpCheck :: Bool
    }

cmdNetworkClock
    :: NetworkClient
    -> Mod CommandFields (IO ())
cmdNetworkClock :: NetworkClient -> Mod CommandFields (IO ())
cmdNetworkClock NetworkClient
mkClient =
    String -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"clock" (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (IO () -> IO ())
forall a. Parser (a -> a)
helper Parser (IO () -> IO ()) -> Parser (IO ()) -> Parser (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (IO ())
cmd) (InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ InfoMod (IO ())
forall a. Monoid a => a
mempty
        InfoMod (IO ()) -> InfoMod (IO ()) -> InfoMod (IO ())
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod (IO ())
forall a. String -> InfoMod a
progDesc String
"View NTP offset."
  where
    cmd :: Parser (IO ())
cmd = (NetworkClockArgs -> IO ())
-> Parser NetworkClockArgs -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NetworkClockArgs -> IO ()
exec (Parser NetworkClockArgs -> Parser (IO ()))
-> Parser NetworkClockArgs -> Parser (IO ())
forall a b. (a -> b) -> a -> b
$ Port "Wallet" -> Bool -> NetworkClockArgs
NetworkClockArgs
        (Port "Wallet" -> Bool -> NetworkClockArgs)
-> Parser (Port "Wallet") -> Parser (Bool -> NetworkClockArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption
        Parser (Bool -> NetworkClockArgs)
-> Parser Bool -> Parser NetworkClockArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
forceNtpCheckOption
    exec :: NetworkClockArgs -> IO ()
exec (NetworkClockArgs Port "Wallet"
wPort Bool
forceNtpCheck) = do
        Port "Wallet"
-> (ApiNetworkClock -> ByteString)
-> ClientM ApiNetworkClock
-> IO ()
forall a. Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
wPort ApiNetworkClock -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty (ClientM ApiNetworkClock -> IO ())
-> ClientM ApiNetworkClock -> IO ()
forall a b. (a -> b) -> a -> b
$ NetworkClient -> Bool -> ClientM ApiNetworkClock
networkClock NetworkClient
mkClient Bool
forceNtpCheck

{-------------------------------------------------------------------------------
                            Commands - 'launch'
-------------------------------------------------------------------------------}

-- | Initialize a directory to store data such as blocks or the wallet databases
setupDirectory :: (Text -> IO ()) -> FilePath -> IO ()
setupDirectory :: (Text -> IO ()) -> String -> IO ()
setupDirectory Text -> IO ()
logT String
dir = do
    Bool
exists <- String -> IO Bool
doesFileExist String
dir
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> IO ()
putErrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ String -> Text
T.pack String
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" must be a directory, but it is"
                , Text
" a file. Exiting."
                ]
        IO ()
forall b. IO b
exitFailure
    String -> IO Bool
doesDirectoryExist String
dir IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> Text -> IO ()
logT (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Using directory: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
dir
        Bool
False -> do
            Text -> IO ()
logT (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Creating directory: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
dir
            let createParentIfMissing :: Bool
createParentIfMissing = Bool
True
            Bool -> String -> IO ()
createDirectoryIfMissing Bool
createParentIfMissing String
dir

{-------------------------------------------------------------------------------
                              Options & Arguments
-------------------------------------------------------------------------------}

-- | --state=STRING
addressStateOption :: Parser AddressState
addressStateOption :: Parser AddressState
addressStateOption = Mod OptionFields AddressState -> Parser AddressState
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields AddressState -> Parser AddressState)
-> Mod OptionFields AddressState -> Parser AddressState
forall a b. (a -> b) -> a -> b
$ Mod OptionFields AddressState
forall a. Monoid a => a
mempty
    Mod OptionFields AddressState
-> Mod OptionFields AddressState -> Mod OptionFields AddressState
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AddressState
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"state"
    Mod OptionFields AddressState
-> Mod OptionFields AddressState -> Mod OptionFields AddressState
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AddressState
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING"
    Mod OptionFields AddressState
-> Mod OptionFields AddressState -> Mod OptionFields AddressState
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AddressState
forall (f :: * -> *) a. String -> Mod f a
help String
"only addresses with the given state: either 'used' or 'unused'."

-- | --database=DIR
databaseOption :: Parser FilePath
databaseOption :: Parser String
databaseOption = Mod OptionFields String -> Parser String
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ Mod OptionFields String
forall a. Monoid a => a
mempty
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"database"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIR"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"use this directory for storing wallets. Run in-memory otherwise."

-- | [--listen-address=HOSTSPEC], default: 127.0.0.1
hostPreferenceOption :: Parser HostPreference
hostPreferenceOption :: Parser HostPreference
hostPreferenceOption = ReadM HostPreference
-> Mod OptionFields HostPreference -> Parser HostPreference
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM HostPreference
forall s. IsString s => ReadM s
str (Mod OptionFields HostPreference -> Parser HostPreference)
-> Mod OptionFields HostPreference -> Parser HostPreference
forall a b. (a -> b) -> a -> b
$ Mod OptionFields HostPreference
forall a. Monoid a => a
mempty
    Mod OptionFields HostPreference
-> Mod OptionFields HostPreference
-> Mod OptionFields HostPreference
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields HostPreference
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"listen-address"
    Mod OptionFields HostPreference
-> Mod OptionFields HostPreference
-> Mod OptionFields HostPreference
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields HostPreference
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HOST"
    Mod OptionFields HostPreference
-> Mod OptionFields HostPreference
-> Mod OptionFields HostPreference
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields HostPreference
forall (f :: * -> *) a. String -> Mod f a
help
        (String
"Specification of which host to bind the API server to. " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
         String
"Can be an IPv[46] address, hostname, or '*'.")
    Mod OptionFields HostPreference
-> Mod OptionFields HostPreference
-> Mod OptionFields HostPreference
forall a. Semigroup a => a -> a -> a
<> HostPreference -> Mod OptionFields HostPreference
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value HostPreference
"127.0.0.1"
    Mod OptionFields HostPreference
-> Mod OptionFields HostPreference
-> Mod OptionFields HostPreference
forall a. Semigroup a => a -> a -> a
<> (HostPreference -> String) -> Mod OptionFields HostPreference
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith (String -> HostPreference -> String
forall a b. a -> b -> a
const String
"127.0.0.1")

-- | [--random-port|--port=INT]
listenOption :: Parser Listen
listenOption :: Parser Listen
listenOption =
    (Listen
ListenOnRandomPort Listen -> Parser Bool -> Parser Listen
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Bool
randomPortOption)
    Parser Listen -> Parser Listen -> Parser Listen
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (Int -> Listen
ListenOnPort (Int -> Listen)
-> (Port "Wallet" -> Int) -> Port "Wallet" -> Listen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port "Wallet" -> Int
forall (tag :: Symbol). Port tag -> Int
getPort (Port "Wallet" -> Listen)
-> Parser (Port "Wallet") -> Parser Listen
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Port "Wallet")
portOption)

-- | [--random-port]
randomPortOption :: Parser Bool
randomPortOption :: Parser Bool
randomPortOption = Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
False (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ Mod FlagFields Bool
forall a. Monoid a => a
mempty
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"random-port"
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"serve wallet API on any available port (conflicts with --port)"

-- | --payment=PAYMENT
paymentOption :: Parser Text
paymentOption :: Parser Text
paymentOption = Mod OptionFields Text -> Parser Text
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Mod OptionFields Text
forall a. Monoid a => a
mempty
    Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"payment"
    Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PAYMENT"
    Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help
        (String
"address to send to and amount to send separated by @" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
        String
", e.g. '<amount>@<address>'")

-- | [--address-pool-gap=INT], default: 20
poolGapOption :: Parser AddressPoolGap
poolGapOption :: Parser AddressPoolGap
poolGapOption = Mod OptionFields AddressPoolGap -> Parser AddressPoolGap
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields AddressPoolGap -> Parser AddressPoolGap)
-> Mod OptionFields AddressPoolGap -> Parser AddressPoolGap
forall a b. (a -> b) -> a -> b
$ Mod OptionFields AddressPoolGap
forall a. Monoid a => a
mempty
    Mod OptionFields AddressPoolGap
-> Mod OptionFields AddressPoolGap
-> Mod OptionFields AddressPoolGap
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AddressPoolGap
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"address-pool-gap"
    Mod OptionFields AddressPoolGap
-> Mod OptionFields AddressPoolGap
-> Mod OptionFields AddressPoolGap
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AddressPoolGap
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
    Mod OptionFields AddressPoolGap
-> Mod OptionFields AddressPoolGap
-> Mod OptionFields AddressPoolGap
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AddressPoolGap
forall (f :: * -> *) a. String -> Mod f a
help String
"number of unused consecutive addresses to keep track of."
    Mod OptionFields AddressPoolGap
-> Mod OptionFields AddressPoolGap
-> Mod OptionFields AddressPoolGap
forall a. Semigroup a => a -> a -> a
<> AddressPoolGap -> Mod OptionFields AddressPoolGap
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value AddressPoolGap
defaultAddressPoolGap
    Mod OptionFields AddressPoolGap
-> Mod OptionFields AddressPoolGap
-> Mod OptionFields AddressPoolGap
forall a. Semigroup a => a -> a -> a
<> (AddressPoolGap -> String) -> Mod OptionFields AddressPoolGap
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith AddressPoolGap -> String
forall a. ToText a => a -> String
showT

-- | [--port=INT], default: 8090
portOption :: Parser (Port "Wallet")
portOption :: Parser (Port "Wallet")
portOption = Mod OptionFields (Port "Wallet") -> Parser (Port "Wallet")
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields (Port "Wallet") -> Parser (Port "Wallet"))
-> Mod OptionFields (Port "Wallet") -> Parser (Port "Wallet")
forall a b. (a -> b) -> a -> b
$ Mod OptionFields (Port "Wallet")
forall a. Monoid a => a
mempty
    Mod OptionFields (Port "Wallet")
-> Mod OptionFields (Port "Wallet")
-> Mod OptionFields (Port "Wallet")
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Port "Wallet")
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"port"
    Mod OptionFields (Port "Wallet")
-> Mod OptionFields (Port "Wallet")
-> Mod OptionFields (Port "Wallet")
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Port "Wallet")
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
    Mod OptionFields (Port "Wallet")
-> Mod OptionFields (Port "Wallet")
-> Mod OptionFields (Port "Wallet")
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Port "Wallet")
forall (f :: * -> *) a. String -> Mod f a
help String
"port used for serving the wallet API."
    Mod OptionFields (Port "Wallet")
-> Mod OptionFields (Port "Wallet")
-> Mod OptionFields (Port "Wallet")
forall a. Semigroup a => a -> a -> a
<> Port "Wallet" -> Mod OptionFields (Port "Wallet")
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (Int -> Port "Wallet"
forall (tag :: Symbol). Int -> Port tag
Port Int
8090)
    Mod OptionFields (Port "Wallet")
-> Mod OptionFields (Port "Wallet")
-> Mod OptionFields (Port "Wallet")
forall a. Semigroup a => a -> a -> a
<> (Port "Wallet" -> String) -> Mod OptionFields (Port "Wallet")
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith Port "Wallet" -> String
forall a. ToText a => a -> String
showT

-- | [--shutdown-handler]
shutdownHandlerFlag :: Parser Bool
shutdownHandlerFlag :: Parser Bool
shutdownHandlerFlag = Mod FlagFields Bool -> Parser Bool
switch
    (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"shutdown-handler"
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Enable the clean shutdown handler (exits when stdin is closed)" )

-- | --state-dir=DIR, default: ~/.cardano-wallet/$backend/$network
stateDirOption :: FilePath -> Parser (Maybe FilePath)
stateDirOption :: String -> Parser (Maybe String)
stateDirOption String
backendDir = Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String -> Parser (Maybe String))
-> Parser String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ Mod OptionFields String
forall a. Monoid a => a
mempty
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"state-dir"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIR"
    Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help ([String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"write wallet state (blockchain and database) to this directory"
        , String
" (default: ", String
defaultDir, String
")"
        ])
  where
    defaultDir :: String
defaultDir = String
backendDir String -> String -> String
</> String
"NETWORK"

-- | --sync-tolerance=DURATION, default: 300s
syncToleranceOption :: Parser SyncTolerance
syncToleranceOption :: Parser SyncTolerance
syncToleranceOption = Mod OptionFields SyncTolerance -> Parser SyncTolerance
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields SyncTolerance -> Parser SyncTolerance)
-> Mod OptionFields SyncTolerance -> Parser SyncTolerance
forall a b. (a -> b) -> a -> b
$ Mod OptionFields SyncTolerance
forall a. Monoid a => a
mempty
    Mod OptionFields SyncTolerance
-> Mod OptionFields SyncTolerance -> Mod OptionFields SyncTolerance
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields SyncTolerance
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"sync-tolerance"
    Mod OptionFields SyncTolerance
-> Mod OptionFields SyncTolerance -> Mod OptionFields SyncTolerance
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields SyncTolerance
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DURATION"
    Mod OptionFields SyncTolerance
-> Mod OptionFields SyncTolerance -> Mod OptionFields SyncTolerance
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields SyncTolerance
forall (f :: * -> *) a. String -> Mod f a
help ([String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"time duration within which we consider being synced with the "
        , String
"network. Expressed in seconds with a trailing 's'."
        ])
    Mod OptionFields SyncTolerance
-> Mod OptionFields SyncTolerance -> Mod OptionFields SyncTolerance
forall a. Semigroup a => a -> a -> a
<> SyncTolerance -> Mod OptionFields SyncTolerance
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value SyncTolerance
fiveMinutes
    Mod OptionFields SyncTolerance
-> Mod OptionFields SyncTolerance -> Mod OptionFields SyncTolerance
forall a. Semigroup a => a -> a -> a
<> (SyncTolerance -> String) -> Mod OptionFields SyncTolerance
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith SyncTolerance -> String
forall a. ToText a => a -> String
showT
  where
    fiveMinutes :: SyncTolerance
fiveMinutes = NominalDiffTime -> SyncTolerance
SyncTolerance (NominalDiffTime
5NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
60)

-- | [--start=TIME]
timeRangeStartOption :: Parser Iso8601Time
timeRangeStartOption :: Parser Iso8601Time
timeRangeStartOption = Mod OptionFields Iso8601Time -> Parser Iso8601Time
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields Iso8601Time -> Parser Iso8601Time)
-> Mod OptionFields Iso8601Time -> Parser Iso8601Time
forall a b. (a -> b) -> a -> b
$ Mod OptionFields Iso8601Time
forall a. Monoid a => a
mempty
    Mod OptionFields Iso8601Time
-> Mod OptionFields Iso8601Time -> Mod OptionFields Iso8601Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Iso8601Time
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"start"
    Mod OptionFields Iso8601Time
-> Mod OptionFields Iso8601Time -> Mod OptionFields Iso8601Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Iso8601Time
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TIME"
    Mod OptionFields Iso8601Time
-> Mod OptionFields Iso8601Time -> Mod OptionFields Iso8601Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Iso8601Time
forall (f :: * -> *) a. String -> Mod f a
help ([String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"start time (ISO 8601 date-and-time format:"
        , String
" basic or extended, e.g. 2012-09-25T10:15:00Z)."
        ])
    Mod OptionFields Iso8601Time
-> Mod OptionFields Iso8601Time -> Mod OptionFields Iso8601Time
forall a. Semigroup a => a -> a -> a
<> (Iso8601Time -> String) -> Mod OptionFields Iso8601Time
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith Iso8601Time -> String
forall a. ToText a => a -> String
showT

-- | [--end=TIME]
timeRangeEndOption :: Parser Iso8601Time
timeRangeEndOption :: Parser Iso8601Time
timeRangeEndOption = Mod OptionFields Iso8601Time -> Parser Iso8601Time
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields Iso8601Time -> Parser Iso8601Time)
-> Mod OptionFields Iso8601Time -> Parser Iso8601Time
forall a b. (a -> b) -> a -> b
$ Mod OptionFields Iso8601Time
forall a. Monoid a => a
mempty
    Mod OptionFields Iso8601Time
-> Mod OptionFields Iso8601Time -> Mod OptionFields Iso8601Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Iso8601Time
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"end"
    Mod OptionFields Iso8601Time
-> Mod OptionFields Iso8601Time -> Mod OptionFields Iso8601Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Iso8601Time
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TIME"
    Mod OptionFields Iso8601Time
-> Mod OptionFields Iso8601Time -> Mod OptionFields Iso8601Time
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Iso8601Time
forall (f :: * -> *) a. String -> Mod f a
help ([String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"end time (ISO 8601 date-and-time format:"
        , String
" basic or extended, e.g. 2016-11-21T10:15:00Z)."
        ])
    Mod OptionFields Iso8601Time
-> Mod OptionFields Iso8601Time -> Mod OptionFields Iso8601Time
forall a. Semigroup a => a -> a -> a
<> (Iso8601Time -> String) -> Mod OptionFields Iso8601Time
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith Iso8601Time -> String
forall a. ToText a => a -> String
showT

-- | [--order=ORDER]
sortOrderOption :: Parser SortOrder
sortOrderOption :: Parser SortOrder
sortOrderOption = Mod OptionFields SortOrder -> Parser SortOrder
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields SortOrder -> Parser SortOrder)
-> Mod OptionFields SortOrder -> Parser SortOrder
forall a b. (a -> b) -> a -> b
$ Mod OptionFields SortOrder
forall a. Monoid a => a
mempty
    Mod OptionFields SortOrder
-> Mod OptionFields SortOrder -> Mod OptionFields SortOrder
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields SortOrder
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"order"
    Mod OptionFields SortOrder
-> Mod OptionFields SortOrder -> Mod OptionFields SortOrder
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields SortOrder
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"ORDER"
    Mod OptionFields SortOrder
-> Mod OptionFields SortOrder -> Mod OptionFields SortOrder
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields SortOrder
forall (f :: * -> *) a. String -> Mod f a
help String
"specifies a sort order, either 'ascending' or 'descending'."
    Mod OptionFields SortOrder
-> Mod OptionFields SortOrder -> Mod OptionFields SortOrder
forall a. Semigroup a => a -> a -> a
<> (SortOrder -> String) -> Mod OptionFields SortOrder
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith SortOrder -> String
forall a. ToText a => a -> String
showT

-- | [--force-ntp-check]
forceNtpCheckOption :: Parser Bool
forceNtpCheckOption :: Parser Bool
forceNtpCheckOption = Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ Mod FlagFields Bool
forall a. Monoid a => a
mempty
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"force-ntp-check"
    Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"When set, will block and force an NTP check with the server. \
            \Otherwise, uses an available cached result."

-- | The lower-case names of all 'Severity' values.
loggingSeverities :: [(String, Severity)]
loggingSeverities :: [(String, Severity)]
loggingSeverities = [(Char -> Char
toLower (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Severity -> String
forall a. Show a => a -> String
show Severity
s, Severity
s) | Severity
s <- [Severity
forall a. Bounded a => a
minBound .. Severity
forall a. Bounded a => a
maxBound]]

parseLoggingSeverity :: String -> Either String Severity
parseLoggingSeverity :: String -> Either String Severity
parseLoggingSeverity String
arg =
    case String -> [(String, Severity)] -> Maybe Severity
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
arg) [(String, Severity)]
loggingSeverities of
        Just Severity
sev -> Severity -> Either String Severity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Severity
sev
        Maybe Severity
Nothing -> String -> Either String Severity
forall a b. a -> Either a b
Left (String -> Either String Severity)
-> String -> Either String Severity
forall a b. (a -> b) -> a -> b
$ String
"unknown logging severity: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arg

loggingSeverityReader :: ReadM Severity
loggingSeverityReader :: ReadM Severity
loggingSeverityReader = (String -> Either String Severity) -> ReadM Severity
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String Severity
parseLoggingSeverity

loggingSeverityOrOffReader :: ReadM (Maybe Severity)
loggingSeverityOrOffReader :: ReadM (Maybe Severity)
loggingSeverityOrOffReader = do
    String
arg <- ReadM String
readerAsk
    case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
arg of
        String
"off" -> Maybe Severity -> ReadM (Maybe Severity)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Severity
forall a. Maybe a
Nothing
        String
_ -> Severity -> Maybe Severity
forall a. a -> Maybe a
Just (Severity -> Maybe Severity)
-> ReadM Severity -> ReadM (Maybe Severity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Severity
loggingSeverityReader

-- | [--wallet-style=WALLET_STYLE]
--
-- Note that we in the future might replace the type @ByronWalletStyle@ with
-- another type, to include Jormungandr keys.
walletStyleOption
    :: ByronWalletStyle
        -- ^ Default style
    -> [ByronWalletStyle]
        -- ^ Accepted styles
    -> Parser ByronWalletStyle
walletStyleOption :: ByronWalletStyle -> [ByronWalletStyle] -> Parser ByronWalletStyle
walletStyleOption ByronWalletStyle
defaultStyle [ByronWalletStyle]
accepted = ReadM ByronWalletStyle
-> Mod OptionFields ByronWalletStyle -> Parser ByronWalletStyle
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((String -> Either String ByronWalletStyle)
-> ReadM ByronWalletStyle
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String ByronWalletStyle
forall a. FromText a => String -> Either String a
fromTextS)
    ( String -> Mod OptionFields ByronWalletStyle
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"wallet-style"
    Mod OptionFields ByronWalletStyle
-> Mod OptionFields ByronWalletStyle
-> Mod OptionFields ByronWalletStyle
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ByronWalletStyle
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"WALLET_STYLE"
    Mod OptionFields ByronWalletStyle
-> Mod OptionFields ByronWalletStyle
-> Mod OptionFields ByronWalletStyle
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> Mod OptionFields ByronWalletStyle
forall (f :: * -> *) a. Maybe Doc -> Mod f a
helpDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just ([Doc] -> Doc
vsep [Doc]
typeOptions))
    Mod OptionFields ByronWalletStyle
-> Mod OptionFields ByronWalletStyle
-> Mod OptionFields ByronWalletStyle
forall a. Semigroup a => a -> a -> a
<> ByronWalletStyle -> Mod OptionFields ByronWalletStyle
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value ByronWalletStyle
defaultStyle
    )
  where
    typeOptions :: [Doc]
typeOptions = String -> Doc
string (String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ( String
"Any of the following (default: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ByronWalletStyle -> Text
forall a. ToText a => a -> Text
toText ByronWalletStyle
defaultStyle) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
        ) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (ByronWalletStyle -> String) -> [ByronWalletStyle] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByronWalletStyle -> String
prettyStyle [ByronWalletStyle]
accepted

    prettyStyle :: ByronWalletStyle -> String
prettyStyle ByronWalletStyle
s =
        String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (ByronWalletStyle -> Text
forall a. ToText a => a -> Text
toText ByronWalletStyle
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByronWalletStyle -> String
fmtAllowedWords ByronWalletStyle
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

addressIndexOption
    :: FromText (Index derivation level)
    => Parser (Index derivation level)
addressIndexOption :: Parser (Index derivation level)
addressIndexOption = Mod OptionFields (Index derivation level)
-> Parser (Index derivation level)
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields (Index derivation level)
 -> Parser (Index derivation level))
-> Mod OptionFields (Index derivation level)
-> Parser (Index derivation level)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields (Index derivation level)
forall a. Monoid a => a
mempty
    Mod OptionFields (Index derivation level)
-> Mod OptionFields (Index derivation level)
-> Mod OptionFields (Index derivation level)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Index derivation level)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"address-index"
    Mod OptionFields (Index derivation level)
-> Mod OptionFields (Index derivation level)
-> Mod OptionFields (Index derivation level)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Index derivation level)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INDEX"
    Mod OptionFields (Index derivation level)
-> Mod OptionFields (Index derivation level)
-> Mod OptionFields (Index derivation level)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Index derivation level)
forall (f :: * -> *) a. String -> Mod f a
help String
"A derivation index for the address"

tlsOption
    :: Parser TlsConfiguration
tlsOption :: Parser TlsConfiguration
tlsOption = String -> String -> String -> TlsConfiguration
TlsConfiguration
    (String -> String -> String -> TlsConfiguration)
-> Parser String -> Parser (String -> String -> TlsConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
tlsCaCertOption
    Parser (String -> String -> TlsConfiguration)
-> Parser String -> Parser (String -> TlsConfiguration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
tlsSvCertOption
    Parser (String -> TlsConfiguration)
-> Parser String -> Parser TlsConfiguration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
tlsSvKeyOption
  where
    tlsCaCertOption :: Parser String
tlsCaCertOption = Mod OptionFields String -> Parser String
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ Mod OptionFields String
forall a. Monoid a => a
mempty
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"tls-ca-cert"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"A x.509 Certificate Authority (CA) certificate."

    tlsSvCertOption :: Parser String
tlsSvCertOption = Mod OptionFields String -> Parser String
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ Mod OptionFields String
forall a. Monoid a => a
mempty
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"tls-sv-cert"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"A x.509 Server (SV) certificate."

    tlsSvKeyOption :: Parser String
tlsSvKeyOption = Mod OptionFields String -> Parser String
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ Mod OptionFields String
forall a. Monoid a => a
mempty
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"tls-sv-key"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"The RSA Server key which signed the x.509 server certificate."

poolMetadataSourceOption
    :: Parser PoolMetadataSource
poolMetadataSourceOption :: Parser PoolMetadataSource
poolMetadataSourceOption = ReadM PoolMetadataSource
-> Mod OptionFields PoolMetadataSource -> Parser PoolMetadataSource
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((String -> Either String PoolMetadataSource)
-> ReadM PoolMetadataSource
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String PoolMetadataSource
reader) (Mod OptionFields PoolMetadataSource -> Parser PoolMetadataSource)
-> Mod OptionFields PoolMetadataSource -> Parser PoolMetadataSource
forall a b. (a -> b) -> a -> b
$ Mod OptionFields PoolMetadataSource
forall a. Monoid a => a
mempty
    Mod OptionFields PoolMetadataSource
-> Mod OptionFields PoolMetadataSource
-> Mod OptionFields PoolMetadataSource
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PoolMetadataSource
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"pool-metadata-fetching"
    Mod OptionFields PoolMetadataSource
-> Mod OptionFields PoolMetadataSource
-> Mod OptionFields PoolMetadataSource
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PoolMetadataSource
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"( none | direct | SMASH-URL )"
    Mod OptionFields PoolMetadataSource
-> Mod OptionFields PoolMetadataSource
-> Mod OptionFields PoolMetadataSource
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PoolMetadataSource
forall (f :: * -> *) a. String -> Mod f a
help (String
"Sets the stake pool metadata fetching strategy. "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Provide a URL to specify a SMASH metadata proxy server, "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"use \"direct\" to fetch directly from the registered pool URLs,"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" or \"none\" to completely disable stake pool"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" metadata. The initial setting is \"none\" and changes by"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" either this option or the API will persist across restarts.")
  where
    reader :: String -> Either String PoolMetadataSource
    reader :: String -> Either String PoolMetadataSource
reader = FromText PoolMetadataSource =>
String -> Either String PoolMetadataSource
forall a. FromText a => String -> Either String a
fromTextS @PoolMetadataSource

-- | [--token-metadata-server=URL]
tokenMetadataSourceOption
    :: Parser TokenMetadataServer
tokenMetadataSourceOption :: Parser TokenMetadataServer
tokenMetadataSourceOption = Mod OptionFields TokenMetadataServer -> Parser TokenMetadataServer
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields TokenMetadataServer
 -> Parser TokenMetadataServer)
-> Mod OptionFields TokenMetadataServer
-> Parser TokenMetadataServer
forall a b. (a -> b) -> a -> b
$ Mod OptionFields TokenMetadataServer
forall a. Monoid a => a
mempty
    Mod OptionFields TokenMetadataServer
-> Mod OptionFields TokenMetadataServer
-> Mod OptionFields TokenMetadataServer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TokenMetadataServer
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"token-metadata-server"
    Mod OptionFields TokenMetadataServer
-> Mod OptionFields TokenMetadataServer
-> Mod OptionFields TokenMetadataServer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TokenMetadataServer
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"URL"
    Mod OptionFields TokenMetadataServer
-> Mod OptionFields TokenMetadataServer
-> Mod OptionFields TokenMetadataServer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TokenMetadataServer
forall (f :: * -> *) a. String -> Mod f a
help (String
"Sets the URL of the token metadata server. "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"If unset, metadata will not be fetched.\n"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"By using this option, you are fully trusting the operator of "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"the metadata server to provide authentic token metadata.")

-- | <wallet-id=WALLET_ID>
walletIdArgument :: Parser WalletId
walletIdArgument :: Parser WalletId
walletIdArgument = Mod ArgumentFields WalletId -> Parser WalletId
forall a. FromText a => Mod ArgumentFields a -> Parser a
argumentT (Mod ArgumentFields WalletId -> Parser WalletId)
-> Mod ArgumentFields WalletId -> Parser WalletId
forall a b. (a -> b) -> a -> b
$ Mod ArgumentFields WalletId
forall a. Monoid a => a
mempty
    Mod ArgumentFields WalletId
-> Mod ArgumentFields WalletId -> Mod ArgumentFields WalletId
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields WalletId
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"WALLET_ID"

-- | [--stake=STAKE]
stakeOption :: Parser (Maybe Coin)
stakeOption :: Parser (Maybe Coin)
stakeOption = Parser Coin -> Parser (Maybe Coin)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Coin -> Parser (Maybe Coin))
-> Parser Coin -> Parser (Maybe Coin)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields Coin -> Parser Coin
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields Coin -> Parser Coin)
-> Mod OptionFields Coin -> Parser Coin
forall a b. (a -> b) -> a -> b
$ Mod OptionFields Coin
forall a. Monoid a => a
mempty
    Mod OptionFields Coin
-> Mod OptionFields Coin -> Mod OptionFields Coin
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Coin
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"stake"
    Mod OptionFields Coin
-> Mod OptionFields Coin -> Mod OptionFields Coin
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Coin
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STAKE"
    Mod OptionFields Coin
-> Mod OptionFields Coin -> Mod OptionFields Coin
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Coin
forall (f :: * -> *) a. String -> Mod f a
help (String
"The stake you intend to delegate, which affects the rewards and "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"the ranking of pools.")

-- | <transaction-id=TX_ID>
transactionIdArgument :: Parser TxId
transactionIdArgument :: Parser TxId
transactionIdArgument = Mod ArgumentFields TxId -> Parser TxId
forall a. FromText a => Mod ArgumentFields a -> Parser a
argumentT (Mod ArgumentFields TxId -> Parser TxId)
-> Mod ArgumentFields TxId -> Parser TxId
forall a b. (a -> b) -> a -> b
$ Mod ArgumentFields TxId
forall a. Monoid a => a
mempty
    Mod ArgumentFields TxId
-> Mod ArgumentFields TxId -> Mod ArgumentFields TxId
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields TxId
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TRANSACTION_ID"

-- | <name=STRING>
walletNameArgument :: Parser WalletName
walletNameArgument :: Parser WalletName
walletNameArgument = Mod ArgumentFields WalletName -> Parser WalletName
forall a. FromText a => Mod ArgumentFields a -> Parser a
argumentT (Mod ArgumentFields WalletName -> Parser WalletName)
-> Mod ArgumentFields WalletName -> Parser WalletName
forall a b. (a -> b) -> a -> b
$ Mod ArgumentFields WalletName
forall a. Monoid a => a
mempty
    Mod ArgumentFields WalletName
-> Mod ArgumentFields WalletName -> Mod ArgumentFields WalletName
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields WalletName
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"WALLET_NAME"
    Mod ArgumentFields WalletName
-> Mod ArgumentFields WalletName -> Mod ArgumentFields WalletName
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields WalletName
forall (f :: * -> *) a. String -> Mod f a
help String
"Name of the wallet."

-- | <public-key=ACCOUNT_PUBLIC_KEY>
accPubKeyArgument :: Parser ApiAccountPublicKey
accPubKeyArgument :: Parser ApiAccountPublicKey
accPubKeyArgument = Mod ArgumentFields ApiAccountPublicKey
-> Parser ApiAccountPublicKey
forall a. FromText a => Mod ArgumentFields a -> Parser a
argumentT (Mod ArgumentFields ApiAccountPublicKey
 -> Parser ApiAccountPublicKey)
-> Mod ArgumentFields ApiAccountPublicKey
-> Parser ApiAccountPublicKey
forall a b. (a -> b) -> a -> b
$ Mod ArgumentFields ApiAccountPublicKey
forall a. Monoid a => a
mempty
    Mod ArgumentFields ApiAccountPublicKey
-> Mod ArgumentFields ApiAccountPublicKey
-> Mod ArgumentFields ApiAccountPublicKey
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields ApiAccountPublicKey
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"ACCOUNT_PUBLIC_KEY"
    Mod ArgumentFields ApiAccountPublicKey
-> Mod ArgumentFields ApiAccountPublicKey
-> Mod ArgumentFields ApiAccountPublicKey
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields ApiAccountPublicKey
forall (f :: * -> *) a. String -> Mod f a
help String
"64-byte (128-character) hex-encoded public account key."

-- | <payload=BINARY_BLOB>
transactionSubmitPayloadArgument :: Parser (ApiBytesT 'Base16 SerialisedTx)
transactionSubmitPayloadArgument :: Parser (ApiBytesT 'Base16 SerialisedTx)
transactionSubmitPayloadArgument = Mod ArgumentFields (ApiBytesT 'Base16 SerialisedTx)
-> Parser (ApiBytesT 'Base16 SerialisedTx)
forall a. FromText a => Mod ArgumentFields a -> Parser a
argumentT (Mod ArgumentFields (ApiBytesT 'Base16 SerialisedTx)
 -> Parser (ApiBytesT 'Base16 SerialisedTx))
-> Mod ArgumentFields (ApiBytesT 'Base16 SerialisedTx)
-> Parser (ApiBytesT 'Base16 SerialisedTx)
forall a b. (a -> b) -> a -> b
$ Mod ArgumentFields (ApiBytesT 'Base16 SerialisedTx)
forall a. Monoid a => a
mempty
    Mod ArgumentFields (ApiBytesT 'Base16 SerialisedTx)
-> Mod ArgumentFields (ApiBytesT 'Base16 SerialisedTx)
-> Mod ArgumentFields (ApiBytesT 'Base16 SerialisedTx)
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields (ApiBytesT 'Base16 SerialisedTx)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"BINARY_BLOB"
    Mod ArgumentFields (ApiBytesT 'Base16 SerialisedTx)
-> Mod ArgumentFields (ApiBytesT 'Base16 SerialisedTx)
-> Mod ArgumentFields (ApiBytesT 'Base16 SerialisedTx)
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields (ApiBytesT 'Base16 SerialisedTx)
forall (f :: * -> *) a. String -> Mod f a
help String
"hex-encoded binary blob of externally-signed transaction."

-- | [--metadata=JSON]
--
-- Note: we decode the JSON just so that we can validate more client-side.
metadataOption :: Parser (Maybe TxMetadataWithSchema)
metadataOption :: Parser (Maybe TxMetadataWithSchema)
metadataOption = ReadM (Maybe TxMetadataWithSchema)
-> Mod OptionFields (Maybe TxMetadataWithSchema)
-> Parser (Maybe TxMetadataWithSchema)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM (Maybe TxMetadataWithSchema)
txMetadataReader (Mod OptionFields (Maybe TxMetadataWithSchema)
 -> Parser (Maybe TxMetadataWithSchema))
-> Mod OptionFields (Maybe TxMetadataWithSchema)
-> Parser (Maybe TxMetadataWithSchema)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields (Maybe TxMetadataWithSchema)
forall a. Monoid a => a
mempty
    Mod OptionFields (Maybe TxMetadataWithSchema)
-> Mod OptionFields (Maybe TxMetadataWithSchema)
-> Mod OptionFields (Maybe TxMetadataWithSchema)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Maybe TxMetadataWithSchema)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"metadata"
    Mod OptionFields (Maybe TxMetadataWithSchema)
-> Mod OptionFields (Maybe TxMetadataWithSchema)
-> Mod OptionFields (Maybe TxMetadataWithSchema)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Maybe TxMetadataWithSchema)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"JSON"
    Mod OptionFields (Maybe TxMetadataWithSchema)
-> Mod OptionFields (Maybe TxMetadataWithSchema)
-> Mod OptionFields (Maybe TxMetadataWithSchema)
forall a. Semigroup a => a -> a -> a
<> Maybe TxMetadataWithSchema
-> Mod OptionFields (Maybe TxMetadataWithSchema)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Maybe TxMetadataWithSchema
forall a. Maybe a
Nothing
    Mod OptionFields (Maybe TxMetadataWithSchema)
-> Mod OptionFields (Maybe TxMetadataWithSchema)
-> Mod OptionFields (Maybe TxMetadataWithSchema)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Maybe TxMetadataWithSchema)
forall (f :: * -> *) a. String -> Mod f a
help (String
"Application-specific transaction metadata as a JSON object. "
             String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"The value must match the schema defined in the "
             String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"cardano-wallet OpenAPI specification.")

txMetadataReader :: ReadM (Maybe TxMetadataWithSchema)
txMetadataReader :: ReadM (Maybe TxMetadataWithSchema)
txMetadataReader = (String -> Either String (Maybe TxMetadataWithSchema))
-> ReadM (Maybe TxMetadataWithSchema)
forall a. (String -> Either String a) -> ReadM a
eitherReader (ByteString -> Either String (Maybe TxMetadataWithSchema)
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' (ByteString -> Either String (Maybe TxMetadataWithSchema))
-> (String -> ByteString)
-> String
-> Either String (Maybe TxMetadataWithSchema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BL8.pack)

-- | [--ttl=DURATION]
timeToLiveOption :: Parser (Maybe (Quantity "second" NominalDiffTime))
timeToLiveOption :: Parser (Maybe (Quantity "second" NominalDiffTime))
timeToLiveOption = Parser (Quantity "second" NominalDiffTime)
-> Parser (Maybe (Quantity "second" NominalDiffTime))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser (Quantity "second" NominalDiffTime)
 -> Parser (Maybe (Quantity "second" NominalDiffTime)))
-> Parser (Quantity "second" NominalDiffTime)
-> Parser (Maybe (Quantity "second" NominalDiffTime))
forall a b. (a -> b) -> a -> b
$ (NominalDiffTime -> Quantity "second" NominalDiffTime)
-> Parser NominalDiffTime
-> Parser (Quantity "second" NominalDiffTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NominalDiffTime -> Quantity "second" NominalDiffTime
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Parser NominalDiffTime
 -> Parser (Quantity "second" NominalDiffTime))
-> Parser NominalDiffTime
-> Parser (Quantity "second" NominalDiffTime)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields NominalDiffTime -> Parser NominalDiffTime
forall a. FromText a => Mod OptionFields a -> Parser a
optionT (Mod OptionFields NominalDiffTime -> Parser NominalDiffTime)
-> Mod OptionFields NominalDiffTime -> Parser NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Mod OptionFields NominalDiffTime
forall a. Monoid a => a
mempty
    Mod OptionFields NominalDiffTime
-> Mod OptionFields NominalDiffTime
-> Mod OptionFields NominalDiffTime
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields NominalDiffTime
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ttl"
    Mod OptionFields NominalDiffTime
-> Mod OptionFields NominalDiffTime
-> Mod OptionFields NominalDiffTime
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields NominalDiffTime
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DURATION"
    Mod OptionFields NominalDiffTime
-> Mod OptionFields NominalDiffTime
-> Mod OptionFields NominalDiffTime
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields NominalDiffTime
forall (f :: * -> *) a. String -> Mod f a
help (String
"Time-to-live value. "
             String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Expressed in seconds with a trailing 's'. "
             String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Default is 7200s (2 hours).")

-- | <address=ADDRESS>
addressIdArgument :: Parser Text
addressIdArgument :: Parser Text
addressIdArgument = Mod ArgumentFields Text -> Parser Text
forall a. FromText a => Mod ArgumentFields a -> Parser a
argumentT (Mod ArgumentFields Text -> Parser Text)
-> Mod ArgumentFields Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Mod ArgumentFields Text
forall a. Monoid a => a
mempty
    Mod ArgumentFields Text
-> Mod ArgumentFields Text -> Mod ArgumentFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"ADDRESS"

-- | Helper for writing an option 'Parser' using a 'FromText' instance.
optionT :: FromText a => Mod OptionFields a -> Parser a
optionT :: Mod OptionFields a -> Parser a
optionT = ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ((String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String a
forall a. FromText a => String -> Either String a
fromTextS)

-- | Helper for writing an argument 'Parser' using a 'FromText' instance.
argumentT :: FromText a => Mod ArgumentFields a -> Parser a
argumentT :: Mod ArgumentFields a -> Parser a
argumentT = ReadM a -> Mod ArgumentFields a -> Parser a
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ((String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String a
forall a. FromText a => String -> Either String a
fromTextS)

-- | Like 'fromText', but stringly-typed.
fromTextS :: FromText a => String -> Either String a
fromTextS :: String -> Either String a
fromTextS = (TextDecodingError -> String)
-> Either TextDecodingError a -> Either String a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left TextDecodingError -> String
getTextDecodingError (Either TextDecodingError a -> Either String a)
-> (String -> Either TextDecodingError a)
-> String
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError a
forall a. FromText a => Text -> Either TextDecodingError a
fromText (Text -> Either TextDecodingError a)
-> (String -> Text) -> String -> Either TextDecodingError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

runClient
    :: forall a. ()
    => Port "Wallet"
    -> (a -> BL.ByteString)
    -> ClientM a
    -> IO ()
runClient :: Port "Wallet" -> (a -> ByteString) -> ClientM a -> IO ()
runClient Port "Wallet"
p a -> ByteString
encode ClientM a
cmd = do
    Either ClientError a
res <- Port "Wallet" -> ClientM a -> IO (Either ClientError a)
forall a. Port "Wallet" -> ClientM a -> IO (Either ClientError a)
sendRequest Port "Wallet"
p ClientM a
cmd
    (a -> ByteString) -> Either ClientError a -> IO ()
forall a. (a -> ByteString) -> Either ClientError a -> IO ()
handleResponse a -> ByteString
encode Either ClientError a
res

sendRequest
    :: forall a. ()
    => Port "Wallet"
    -> ClientM a
    -> IO (Either ClientError a)
sendRequest :: Port "Wallet" -> ClientM a -> IO (Either ClientError a)
sendRequest (Port Int
p) ClientM a
cmd = do
    Manager
manager <- ManagerSettings -> IO Manager
newManager (ManagerSettings -> IO Manager) -> ManagerSettings -> IO Manager
forall a b. (a -> b) -> a -> b
$ ManagerSettings
defaultManagerSettings
        { managerResponseTimeout :: ResponseTimeout
managerResponseTimeout = ResponseTimeout
responseTimeoutNone }
    let env :: ClientEnv
env = Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
manager (Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Http String
"localhost" Int
p String
"")
    ClientM a -> ClientEnv -> IO (Either ClientError a)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM a
cmd ClientEnv
env

handleResponse
    :: forall a. ()
    => (a -> BL.ByteString)
    -> Either ClientError a
    -> IO ()
handleResponse :: (a -> ByteString) -> Either ClientError a -> IO ()
handleResponse a -> ByteString
encode Either ClientError a
res = do
    case Either ClientError a
res of
        Right a
a -> do
            Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr Text
"Ok."
            ByteString -> IO ()
BL8.putStrLn (a -> ByteString
encode a
a)
        Left ClientError
e -> do
            let msg :: Text
msg = case ClientError
e of
                    FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
r -> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe
                        (ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response -> ByteString
forall a. ResponseF a -> a
responseBody Response
r)
                        (ByteString -> Maybe Text
decodeError (ByteString -> Maybe Text) -> ByteString -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Response -> ByteString
forall a. ResponseF a -> a
responseBody Response
r)
                    ClientError
_ ->
                        String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ClientError -> String
forall a. Show a => a -> String
show ClientError
e
            Text -> IO ()
putErrLn Text
msg
            IO ()
forall b. IO b
exitFailure

{-------------------------------------------------------------------------------
                                Extra Types
-------------------------------------------------------------------------------}

-- | Port number with a tag for describing what it is used for
newtype Port (tag :: Symbol) = Port { Port tag -> Int
getPort :: Int }
    deriving stock (Port tag -> Port tag -> Bool
(Port tag -> Port tag -> Bool)
-> (Port tag -> Port tag -> Bool) -> Eq (Port tag)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (tag :: Symbol). Port tag -> Port tag -> Bool
/= :: Port tag -> Port tag -> Bool
$c/= :: forall (tag :: Symbol). Port tag -> Port tag -> Bool
== :: Port tag -> Port tag -> Bool
$c== :: forall (tag :: Symbol). Port tag -> Port tag -> Bool
Eq, (forall x. Port tag -> Rep (Port tag) x)
-> (forall x. Rep (Port tag) x -> Port tag) -> Generic (Port tag)
forall x. Rep (Port tag) x -> Port tag
forall x. Port tag -> Rep (Port tag) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (tag :: Symbol) x. Rep (Port tag) x -> Port tag
forall (tag :: Symbol) x. Port tag -> Rep (Port tag) x
$cto :: forall (tag :: Symbol) x. Rep (Port tag) x -> Port tag
$cfrom :: forall (tag :: Symbol) x. Port tag -> Rep (Port tag) x
Generic)
    deriving newtype (Int -> Port tag
Port tag -> Int
Port tag -> [Port tag]
Port tag -> Port tag
Port tag -> Port tag -> [Port tag]
Port tag -> Port tag -> Port tag -> [Port tag]
(Port tag -> Port tag)
-> (Port tag -> Port tag)
-> (Int -> Port tag)
-> (Port tag -> Int)
-> (Port tag -> [Port tag])
-> (Port tag -> Port tag -> [Port tag])
-> (Port tag -> Port tag -> [Port tag])
-> (Port tag -> Port tag -> Port tag -> [Port tag])
-> Enum (Port tag)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
forall (tag :: Symbol). Int -> Port tag
forall (tag :: Symbol). Port tag -> Int
forall (tag :: Symbol). Port tag -> [Port tag]
forall (tag :: Symbol). Port tag -> Port tag
forall (tag :: Symbol). Port tag -> Port tag -> [Port tag]
forall (tag :: Symbol).
Port tag -> Port tag -> Port tag -> [Port tag]
enumFromThenTo :: Port tag -> Port tag -> Port tag -> [Port tag]
$cenumFromThenTo :: forall (tag :: Symbol).
Port tag -> Port tag -> Port tag -> [Port tag]
enumFromTo :: Port tag -> Port tag -> [Port tag]
$cenumFromTo :: forall (tag :: Symbol). Port tag -> Port tag -> [Port tag]
enumFromThen :: Port tag -> Port tag -> [Port tag]
$cenumFromThen :: forall (tag :: Symbol). Port tag -> Port tag -> [Port tag]
enumFrom :: Port tag -> [Port tag]
$cenumFrom :: forall (tag :: Symbol). Port tag -> [Port tag]
fromEnum :: Port tag -> Int
$cfromEnum :: forall (tag :: Symbol). Port tag -> Int
toEnum :: Int -> Port tag
$ctoEnum :: forall (tag :: Symbol). Int -> Port tag
pred :: Port tag -> Port tag
$cpred :: forall (tag :: Symbol). Port tag -> Port tag
succ :: Port tag -> Port tag
$csucc :: forall (tag :: Symbol). Port tag -> Port tag
Enum, Eq (Port tag)
Eq (Port tag)
-> (Port tag -> Port tag -> Ordering)
-> (Port tag -> Port tag -> Bool)
-> (Port tag -> Port tag -> Bool)
-> (Port tag -> Port tag -> Bool)
-> (Port tag -> Port tag -> Bool)
-> (Port tag -> Port tag -> Port tag)
-> (Port tag -> Port tag -> Port tag)
-> Ord (Port tag)
Port tag -> Port tag -> Bool
Port tag -> Port tag -> Ordering
Port tag -> Port tag -> Port tag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (tag :: Symbol). Eq (Port tag)
forall (tag :: Symbol). Port tag -> Port tag -> Bool
forall (tag :: Symbol). Port tag -> Port tag -> Ordering
forall (tag :: Symbol). Port tag -> Port tag -> Port tag
min :: Port tag -> Port tag -> Port tag
$cmin :: forall (tag :: Symbol). Port tag -> Port tag -> Port tag
max :: Port tag -> Port tag -> Port tag
$cmax :: forall (tag :: Symbol). Port tag -> Port tag -> Port tag
>= :: Port tag -> Port tag -> Bool
$c>= :: forall (tag :: Symbol). Port tag -> Port tag -> Bool
> :: Port tag -> Port tag -> Bool
$c> :: forall (tag :: Symbol). Port tag -> Port tag -> Bool
<= :: Port tag -> Port tag -> Bool
$c<= :: forall (tag :: Symbol). Port tag -> Port tag -> Bool
< :: Port tag -> Port tag -> Bool
$c< :: forall (tag :: Symbol). Port tag -> Port tag -> Bool
compare :: Port tag -> Port tag -> Ordering
$ccompare :: forall (tag :: Symbol). Port tag -> Port tag -> Ordering
$cp1Ord :: forall (tag :: Symbol). Eq (Port tag)
Ord, Int -> Port tag -> String -> String
[Port tag] -> String -> String
Port tag -> String
(Int -> Port tag -> String -> String)
-> (Port tag -> String)
-> ([Port tag] -> String -> String)
-> Show (Port tag)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall (tag :: Symbol). Int -> Port tag -> String -> String
forall (tag :: Symbol). [Port tag] -> String -> String
forall (tag :: Symbol). Port tag -> String
showList :: [Port tag] -> String -> String
$cshowList :: forall (tag :: Symbol). [Port tag] -> String -> String
show :: Port tag -> String
$cshow :: forall (tag :: Symbol). Port tag -> String
showsPrec :: Int -> Port tag -> String -> String
$cshowsPrec :: forall (tag :: Symbol). Int -> Port tag -> String -> String
Show)

-- NOTE
-- TCP port ranges from [[-1;65535]] \ {0}
-- However, ports in [[-1; 1023]] \ {0} are well-known ports reserved
-- and only "bindable" through root privileges.
instance Bounded (Port tag) where
    minBound :: Port tag
minBound = Int -> Port tag
forall (tag :: Symbol). Int -> Port tag
Port Int
1024
    maxBound :: Port tag
maxBound = Int -> Port tag
forall (tag :: Symbol). Int -> Port tag
Port Int
65535

instance FromText (Port tag) where
    fromText :: Text -> Either TextDecodingError (Port tag)
fromText Text
t = do
        (Port tag
p, Text
unconsumed) <- (String -> TextDecodingError)
-> ((Int, Text) -> (Port tag, Text))
-> Either String (Int, Text)
-> Either TextDecodingError (Port tag, Text)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TextDecodingError -> String -> TextDecodingError
forall a b. a -> b -> a
const TextDecodingError
err) ((Int -> Port tag) -> (Int, Text) -> (Port tag, Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Int -> Port tag
forall (tag :: Symbol). Int -> Port tag
Port) (Reader Int
forall a. Integral a => Reader a
decimal Text
t)
        Bool -> Either TextDecodingError () -> Either TextDecodingError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
unconsumed Bool -> Bool -> Bool
&& Port tag
p Port tag -> Port tag -> Bool
forall a. Ord a => a -> a -> Bool
>= Port tag
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Port tag
p Port tag -> Port tag -> Bool
forall a. Ord a => a -> a -> Bool
<= Port tag
forall a. Bounded a => a
maxBound) (Either TextDecodingError () -> Either TextDecodingError ())
-> Either TextDecodingError () -> Either TextDecodingError ()
forall a b. (a -> b) -> a -> b
$ TextDecodingError -> Either TextDecodingError ()
forall a b. a -> Either a b
Left TextDecodingError
err
        return Port tag
p
      where
        err :: TextDecodingError
err = String -> TextDecodingError
TextDecodingError
            (String -> TextDecodingError) -> String -> TextDecodingError
forall a b. (a -> b) -> a -> b
$ String
"expected a TCP port number between "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Port Any -> Int
forall (tag :: Symbol). Port tag -> Int
getPort Port Any
forall a. Bounded a => a
minBound)
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" and "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Port Any -> Int
forall (tag :: Symbol). Port tag -> Int
getPort Port Any
forall a. Bounded a => a
maxBound)

instance ToText (Port tag) where
    toText :: Port tag -> Text
toText (Port Int
p) = Int -> Text
forall a. ToText a => a -> Text
toText Int
p

-- | Wrapper type around 'Text' to make its semantic more explicit
newtype Service = Service Text deriving newtype (String -> Service
(String -> Service) -> IsString Service
forall a. (String -> a) -> IsString a
fromString :: String -> Service
$cfromString :: String -> Service
IsString, Int -> Service -> String -> String
[Service] -> String -> String
Service -> String
(Int -> Service -> String -> String)
-> (Service -> String)
-> ([Service] -> String -> String)
-> Show Service
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Service] -> String -> String
$cshowList :: [Service] -> String -> String
show :: Service -> String
$cshow :: Service -> String
showsPrec :: Int -> Service -> String -> String
$cshowsPrec :: Int -> Service -> String -> String
Show, Service -> Service -> Bool
(Service -> Service -> Bool)
-> (Service -> Service -> Bool) -> Eq Service
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Service -> Service -> Bool
$c/= :: Service -> Service -> Bool
== :: Service -> Service -> Bool
$c== :: Service -> Service -> Bool
Eq)

newtype TxId = TxId { TxId -> Hash "Tx"
getTxId :: Hash "Tx" }
    deriving (TxId -> TxId -> Bool
(TxId -> TxId -> Bool) -> (TxId -> TxId -> Bool) -> Eq TxId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxId -> TxId -> Bool
$c/= :: TxId -> TxId -> Bool
== :: TxId -> TxId -> Bool
$c== :: TxId -> TxId -> Bool
Eq, Int -> TxId -> String -> String
[TxId] -> String -> String
TxId -> String
(Int -> TxId -> String -> String)
-> (TxId -> String) -> ([TxId] -> String -> String) -> Show TxId
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TxId] -> String -> String
$cshowList :: [TxId] -> String -> String
show :: TxId -> String
$cshow :: TxId -> String
showsPrec :: Int -> TxId -> String -> String
$cshowsPrec :: Int -> TxId -> String -> String
Show)

instance FromText TxId where
    fromText :: Text -> Either TextDecodingError TxId
fromText = (TextDecodingError -> TextDecodingError)
-> Either TextDecodingError TxId -> Either TextDecodingError TxId
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bi.first (TextDecodingError -> TextDecodingError -> TextDecodingError
forall a b. a -> b -> a
const TextDecodingError
err) (Either TextDecodingError TxId -> Either TextDecodingError TxId)
-> (Text -> Either TextDecodingError TxId)
-> Text
-> Either TextDecodingError TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hash "Tx" -> TxId)
-> Either TextDecodingError (Hash "Tx")
-> Either TextDecodingError TxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash "Tx" -> TxId
TxId (Either TextDecodingError (Hash "Tx")
 -> Either TextDecodingError TxId)
-> (Text -> Either TextDecodingError (Hash "Tx"))
-> Text
-> Either TextDecodingError TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError (Hash "Tx")
forall a. FromText a => Text -> Either TextDecodingError a
fromText
      where
        err :: TextDecodingError
err = String -> TextDecodingError
TextDecodingError
            String
"A transaction ID should be a hex-encoded string of 64 characters."

{-------------------------------------------------------------------------------
                                  Logging
-------------------------------------------------------------------------------}

-- | Controls how much information to include in log output.
data Verbosity
    = Default
        -- ^ The default level of verbosity.
    | Quiet
        -- ^ Include less information in the log output.
    | Verbose
        -- ^ Include more information in the log output.
    deriving (Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq, Int -> Verbosity -> String -> String
[Verbosity] -> String -> String
Verbosity -> String
(Int -> Verbosity -> String -> String)
-> (Verbosity -> String)
-> ([Verbosity] -> String -> String)
-> Show Verbosity
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Verbosity] -> String -> String
$cshowList :: [Verbosity] -> String -> String
show :: Verbosity -> String
$cshow :: Verbosity -> String
showsPrec :: Int -> Verbosity -> String -> String
$cshowsPrec :: Int -> Verbosity -> String -> String
Show)

data LogOutput
    = LogToStdStreams Severity
    -- ^ Log to console, with the given minimum 'Severity'.
    --
    -- Logs of Warning or higher severity will be output to stderr. Notice or
    -- lower severity logs will be output to stdout.
    | LogToFile FilePath Severity
    deriving (LogOutput -> LogOutput -> Bool
(LogOutput -> LogOutput -> Bool)
-> (LogOutput -> LogOutput -> Bool) -> Eq LogOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogOutput -> LogOutput -> Bool
$c/= :: LogOutput -> LogOutput -> Bool
== :: LogOutput -> LogOutput -> Bool
$c== :: LogOutput -> LogOutput -> Bool
Eq, Int -> LogOutput -> String -> String
[LogOutput] -> String -> String
LogOutput -> String
(Int -> LogOutput -> String -> String)
-> (LogOutput -> String)
-> ([LogOutput] -> String -> String)
-> Show LogOutput
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LogOutput] -> String -> String
$cshowList :: [LogOutput] -> String -> String
show :: LogOutput -> String
$cshow :: LogOutput -> String
showsPrec :: Int -> LogOutput -> String -> String
$cshowsPrec :: Int -> LogOutput -> String -> String
Show)


mkScribe :: LogOutput -> [ScribeDefinition]
mkScribe :: LogOutput -> [ScribeDefinition]
mkScribe (LogToFile String
path Severity
sev) = ScribeDefinition -> [ScribeDefinition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScribeDefinition -> [ScribeDefinition])
-> ScribeDefinition -> [ScribeDefinition]
forall a b. (a -> b) -> a -> b
$ ScribeDefinition :: ScribeKind
-> ScribeFormat
-> Text
-> ScribePrivacy
-> Maybe RotationParameters
-> Severity
-> Severity
-> ScribeDefinition
ScribeDefinition
    { scName :: Text
scName = String -> Text
T.pack String
path
    , scFormat :: ScribeFormat
scFormat = ScribeFormat
ScText
    , scKind :: ScribeKind
scKind = ScribeKind
FileSK
    , scMinSev :: Severity
scMinSev = Severity
sev
    , scMaxSev :: Severity
scMaxSev = Severity
Critical
    , scPrivacy :: ScribePrivacy
scPrivacy = ScribePrivacy
ScPublic
    , scRotation :: Maybe RotationParameters
scRotation = Maybe RotationParameters
forall a. Maybe a
Nothing
    }
mkScribe (LogToStdStreams Severity
sev) =
    [ (Severity, Severity, ScribeKind) -> ScribeDefinition
mkScribe' (Severity -> Severity -> Severity
forall a. Ord a => a -> a -> a
max Severity
errMin Severity
sev, Severity
forall a. Bounded a => a
maxBound, ScribeKind
StderrSK)
    , (Severity, Severity, ScribeKind) -> ScribeDefinition
mkScribe' (Severity
sev, Severity -> Severity
forall a. Enum a => a -> a
pred Severity
errMin, ScribeKind
StdoutSK)
    ]
  where
    errMin :: Severity
errMin = Severity
Warning
    mkScribe' :: (Severity, Severity, ScribeKind) -> ScribeDefinition
mkScribe' (Severity
minSev, Severity
maxSev, ScribeKind
kind) = ScribeDefinition :: ScribeKind
-> ScribeFormat
-> Text
-> ScribePrivacy
-> Maybe RotationParameters
-> Severity
-> Severity
-> ScribeDefinition
ScribeDefinition
        { scName :: Text
scName = Text
"text"
        , scFormat :: ScribeFormat
scFormat = ScribeFormat
ScText
        , scKind :: ScribeKind
scKind = ScribeKind
kind
        , scMinSev :: Severity
scMinSev = Severity
minSev
        , scMaxSev :: Severity
scMaxSev = Severity
maxSev
        , scPrivacy :: ScribePrivacy
scPrivacy = ScribePrivacy
ScPublic
        , scRotation :: Maybe RotationParameters
scRotation = Maybe RotationParameters
forall a. Maybe a
Nothing
        }


mkScribeId :: LogOutput -> [ScribeId]
mkScribeId :: LogOutput -> [Text]
mkScribeId (LogToStdStreams Severity
_) = [Text
"StdoutSK::text", Text
"StderrSK::text"]
mkScribeId (LogToFile String
file Severity
_) = Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"FileSK::" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
file

getPrometheusURL :: IO (Maybe (String, Port "Prometheus"))
getPrometheusURL :: IO (Maybe (String, Port "Prometheus"))
getPrometheusURL = do
    Maybe String
prometheus_port <- String -> IO (Maybe String)
lookupEnv String
"CARDANO_WALLET_PROMETHEUS_PORT"
    String
prometheus_host <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"127.0.0.1" (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"CARDANO_WALLET_PROMETHEUS_HOST"
    case (String
prometheus_host, Maybe String
prometheus_port) of
        (String
host, Just String
port) ->
            case FromText (Port "Prometheus") =>
Text -> Either TextDecodingError (Port "Prometheus")
forall a. FromText a => Text -> Either TextDecodingError a
fromText @(Port "Prometheus") (Text -> Either TextDecodingError (Port "Prometheus"))
-> Text -> Either TextDecodingError (Port "Prometheus")
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
port of
                Right Port "Prometheus"
port' -> Maybe (String, Port "Prometheus")
-> IO (Maybe (String, Port "Prometheus"))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (String, Port "Prometheus")
 -> IO (Maybe (String, Port "Prometheus")))
-> Maybe (String, Port "Prometheus")
-> IO (Maybe (String, Port "Prometheus"))
forall a b. (a -> b) -> a -> b
$ (String, Port "Prometheus") -> Maybe (String, Port "Prometheus")
forall a. a -> Maybe a
Just (String
host, Port "Prometheus"
port')
                Either TextDecodingError (Port "Prometheus")
_ -> do
                    Handle -> Text -> IO ()
TIO.hPutStr Handle
stderr
                        Text
"Port value for prometheus metrics invalid. Will be disabled."
                    pure Maybe (String, Port "Prometheus")
forall a. Maybe a
Nothing
        (String, Maybe String)
_ -> Maybe (String, Port "Prometheus")
-> IO (Maybe (String, Port "Prometheus"))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (String, Port "Prometheus")
forall a. Maybe a
Nothing

getEKGURL :: IO (Maybe (String, Port "EKG"))
getEKGURL :: IO (Maybe (String, Port "EKG"))
getEKGURL = do
    Maybe String
ekg_port <- String -> IO (Maybe String)
lookupEnv String
"CARDANO_WALLET_EKG_PORT"
    String
ekg_host <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"127.0.0.1" (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"CARDANO_WALLET_EKG_HOST"
    case (String
ekg_host, Maybe String
ekg_port) of
        (String
host, Just String
port) ->
            case FromText (Port "EKG") =>
Text -> Either TextDecodingError (Port "EKG")
forall a. FromText a => Text -> Either TextDecodingError a
fromText @(Port "EKG") (Text -> Either TextDecodingError (Port "EKG"))
-> Text -> Either TextDecodingError (Port "EKG")
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
port of
                Right Port "EKG"
port' -> Maybe (String, Port "EKG") -> IO (Maybe (String, Port "EKG"))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (String, Port "EKG") -> IO (Maybe (String, Port "EKG")))
-> Maybe (String, Port "EKG") -> IO (Maybe (String, Port "EKG"))
forall a b. (a -> b) -> a -> b
$ (String, Port "EKG") -> Maybe (String, Port "EKG")
forall a. a -> Maybe a
Just (String
host, Port "EKG"
port')
                Either TextDecodingError (Port "EKG")
_ -> do
                    Handle -> Text -> IO ()
TIO.hPutStr Handle
stderr
                        Text
"Port value for EKB metrics invalid. Will be disabled."
                    pure Maybe (String, Port "EKG")
forall a. Maybe a
Nothing
        (String, Maybe String)
_ -> Maybe (String, Port "EKG") -> IO (Maybe (String, Port "EKG"))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (String, Port "EKG")
forall a. Maybe a
Nothing

ekgEnabled :: IO Bool
ekgEnabled :: IO Bool
ekgEnabled = Maybe (String, Port "EKG") -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (String, Port "EKG") -> Bool)
-> IO (Maybe (String, Port "EKG")) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (String, Port "EKG"))
getEKGURL

-- | Initialize logging at the specified minimum 'Severity' level.
initTracer
    :: LoggerName
    -> [LogOutput]
    -> IO (Switchboard Text, (CM.Configuration, Trace IO Text))
initTracer :: Text
-> [LogOutput]
-> IO (Switchboard Text, (Configuration, Trace IO Text))
initTracer Text
loggerName [LogOutput]
outputs = do
    Maybe (String, Port "Prometheus")
prometheusHP <- IO (Maybe (String, Port "Prometheus"))
getPrometheusURL
    Maybe (String, Port "EKG")
ekgHP <- IO (Maybe (String, Port "EKG"))
getEKGURL
    Configuration
cfg <- do
        Configuration
c <- IO Configuration
defaultConfigStdout
        Configuration -> [BackendKind] -> IO ()
CM.setSetupBackends Configuration
c [BackendKind
CM.KatipBK, BackendKind
CM.AggregationBK, BackendKind
CM.EKGViewBK, BackendKind
CM.EditorBK]
        Configuration -> [BackendKind] -> IO ()
CM.setDefaultBackends Configuration
c [BackendKind
CM.KatipBK]
        Configuration -> [ScribeDefinition] -> IO ()
CM.setSetupScribes Configuration
c ([ScribeDefinition] -> IO ()) -> [ScribeDefinition] -> IO ()
forall a b. (a -> b) -> a -> b
$ [LogOutput]
outputs [LogOutput]
-> (LogOutput -> [ScribeDefinition]) -> [ScribeDefinition]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LogOutput -> [ScribeDefinition]
mkScribe
        Configuration -> [Text] -> IO ()
CM.setDefaultScribes Configuration
c ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ [LogOutput]
outputs [LogOutput] -> (LogOutput -> [Text]) -> [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LogOutput -> [Text]
mkScribeId
        Configuration -> Text -> Maybe [BackendKind] -> IO ()
CM.setBackends Configuration
c Text
"test-cluster.metrics" ([BackendKind] -> Maybe [BackendKind]
forall a. a -> Maybe a
Just [BackendKind
CM.EKGViewBK])
        Configuration -> Text -> Maybe [BackendKind] -> IO ()
CM.setBackends Configuration
c Text
"cardano-wallet.metrics" ([BackendKind] -> Maybe [BackendKind]
forall a. a -> Maybe a
Just [BackendKind
CM.EKGViewBK])
        Maybe (String, Port "EKG")
-> ((String, Port "EKG") -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (String, Port "EKG")
ekgHP (((String, Port "EKG") -> IO ()) -> IO ())
-> ((String, Port "EKG") -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
h, Port "EKG"
p) -> do
            Configuration -> Maybe Endpoint -> IO ()
CM.setEKGBindAddr Configuration
c (Maybe Endpoint -> IO ()) -> Maybe Endpoint -> IO ()
forall a b. (a -> b) -> a -> b
$ Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
Just (HostPort -> Endpoint
Endpoint (String
h, Port "EKG" -> Int
forall (tag :: Symbol). Port tag -> Int
getPort Port "EKG"
p))
        Maybe (String, Port "Prometheus")
-> ((String, Port "Prometheus") -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (String, Port "Prometheus")
prometheusHP (((String, Port "Prometheus") -> IO ()) -> IO ())
-> ((String, Port "Prometheus") -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
h, Port "Prometheus"
p) ->
            Configuration -> Maybe HostPort -> IO ()
CM.setPrometheusBindAddr Configuration
c (Maybe HostPort -> IO ()) -> Maybe HostPort -> IO ()
forall a b. (a -> b) -> a -> b
$ HostPort -> Maybe HostPort
forall a. a -> Maybe a
Just (String
h, Port "Prometheus" -> Int
forall (tag :: Symbol). Port tag -> Int
getPort Port "Prometheus"
p)
        pure Configuration
c
    (Trace IO Text
tr, Switchboard Text
sb) <- Configuration -> Text -> IO (Trace IO Text, Switchboard Text)
forall (m :: * -> *) a.
(MonadIO m, ToJSON a, FromJSON a, ToObject a) =>
Configuration -> Text -> m (Trace m a, Switchboard a)
setupTrace_ Configuration
cfg Text
loggerName
    IO Bool
ekgEnabled IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> IO () -> IO ()) -> IO () -> Bool -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Trace IO Text -> IO ()
startCapturingMetrics Trace IO Text
tr)
    pure (Switchboard Text
sb, (Configuration
cfg, Trace IO Text
tr))
  where
    -- https://github.com/input-output-hk/cardano-node/blob/f7d57e30c47028ba2aeb306a4f21b47bb41dec01/cardano-node/src/Cardano/Node/Configuration/Logging.hs#L224
    startCapturingMetrics :: Trace IO Text -> IO ()
    startCapturingMetrics :: Trace IO Text -> IO ()
startCapturingMetrics Trace IO Text
trace0 = do
      let trace :: Trace IO Text
trace = Text -> Trace IO Text -> Trace IO Text
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"metrics" Trace IO Text
trace0
          counters :: [ObservableInstance]
counters = [ObservableInstance
Obs.MemoryStats, ObservableInstance
Obs.ProcessStats
            , ObservableInstance
Obs.NetStats, ObservableInstance
Obs.IOStats, ObservableInstance
Obs.GhcRtsStats, ObservableInstance
Obs.SysStats]
      Async Any
_ <- IO Any -> IO (Async Any)
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
Async.async (IO Any -> IO (Async Any)) -> IO Any -> IO (Async Any)
forall a b. (a -> b) -> a -> b
$ IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO Any) -> IO () -> IO Any
forall a b. (a -> b) -> a -> b
$ do
        [Counter]
cts <- SubTrace -> IO [Counter]
readCounters ([ObservableInstance] -> SubTrace
ObservableTraceSelf [ObservableInstance]
counters)
        Trace IO Text -> [Counter] -> IO ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> [Counter] -> m ()
traceCounters Trace IO Text
trace [Counter]
cts
        Int -> IO ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay Int
30_000_000   -- 30 seconds
      pure ()
     where
       traceCounters :: forall m a. MonadIO m => Trace m a -> [Counter] -> m ()
       traceCounters :: Trace m a -> [Counter] -> m ()
traceCounters Trace m a
_tr [] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       traceCounters Trace m a
tr (c :: Counter
c@(Counter CounterType
_ct Text
cn Measurable
cv) : [Counter]
cs) = do
         LOMeta
mle <- Severity -> PrivacyAnnotation -> m LOMeta
forall (m :: * -> *).
MonadIO m =>
Severity -> PrivacyAnnotation -> m LOMeta
mkLOMeta Severity
Notice PrivacyAnnotation
Confidential
         Trace m a -> (LOMeta, LOContent a) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Trace m a -> (LOMeta, LOContent a) -> m ()
traceNamedObject Trace m a
tr (LOMeta
mle, Text -> Measurable -> LOContent a
forall a. Text -> Measurable -> LOContent a
LogValue (Counter -> Text
nameCounter Counter
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cn) Measurable
cv)
         Trace m a -> [Counter] -> m ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> [Counter] -> m ()
traceCounters Trace m a
tr [Counter]
cs

-- | See 'withLoggingNamed'
withLogging
    :: [LogOutput]
    -> ((Switchboard Text, (CM.Configuration, Trace IO Text)) -> IO a)
    -> IO a
withLogging :: [LogOutput]
-> ((Switchboard Text, (Configuration, Trace IO Text)) -> IO a)
-> IO a
withLogging =
    Text
-> [LogOutput]
-> ((Switchboard Text, (Configuration, Trace IO Text)) -> IO a)
-> IO a
forall a.
Text
-> [LogOutput]
-> ((Switchboard Text, (Configuration, Trace IO Text)) -> IO a)
-> IO a
withLoggingNamed Text
"cardano-wallet"

-- | Run an action with logging available and configured. When the action is
-- finished (normally or otherwise), log messages are flushed.
withLoggingNamed
    :: LoggerName
    -> [LogOutput]
    -> ((Switchboard Text, (CM.Configuration, Trace IO Text)) -> IO a)
    -- ^ The action to run with logging configured.
    -> IO a
withLoggingNamed :: Text
-> [LogOutput]
-> ((Switchboard Text, (Configuration, Trace IO Text)) -> IO a)
-> IO a
withLoggingNamed Text
loggerName [LogOutput]
outputs = IO (Switchboard Text, (Configuration, Trace IO Text))
-> ((Switchboard Text, (Configuration, Trace IO Text)) -> IO ())
-> ((Switchboard Text, (Configuration, Trace IO Text)) -> IO a)
-> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket IO (Switchboard Text, (Configuration, Trace IO Text))
before (Switchboard Text, (Configuration, Trace IO Text)) -> IO ()
forall a a a.
(IsString a, ToJSON a, FromJSON a, ToObject a) =>
(Switchboard a, (a, Trace IO a)) -> IO ()
after
  where
    before :: IO (Switchboard Text, (Configuration, Trace IO Text))
before = Text
-> [LogOutput]
-> IO (Switchboard Text, (Configuration, Trace IO Text))
initTracer Text
loggerName [LogOutput]
outputs
    after :: (Switchboard a, (a, Trace IO a)) -> IO ()
after (Switchboard a
sb, (a
_, Trace IO a
tr)) = do
        Trace IO a -> a -> IO ()
forall (m :: * -> *) a. MonadIO m => Trace m a -> a -> m ()
logDebug (Text -> Trace IO a -> Trace IO a
forall (m :: * -> *) a. Text -> Trace m a -> Trace m a
appendName Text
"main" Trace IO a
tr) a
"Logging shutdown."
        Switchboard a -> IO ()
forall a.
(ToJSON a, FromJSON a, ToObject a) =>
Switchboard a -> IO ()
shutdown Switchboard a
sb

data LoggingOptions tracers = LoggingOptions
    { LoggingOptions tracers -> Severity
loggingMinSeverity :: Severity
    , LoggingOptions tracers -> tracers
loggingTracers :: tracers
    , LoggingOptions tracers -> Maybe Void
loggingTracersDoc :: Maybe Void
    } deriving (Int -> LoggingOptions tracers -> String -> String
[LoggingOptions tracers] -> String -> String
LoggingOptions tracers -> String
(Int -> LoggingOptions tracers -> String -> String)
-> (LoggingOptions tracers -> String)
-> ([LoggingOptions tracers] -> String -> String)
-> Show (LoggingOptions tracers)
forall tracers.
Show tracers =>
Int -> LoggingOptions tracers -> String -> String
forall tracers.
Show tracers =>
[LoggingOptions tracers] -> String -> String
forall tracers. Show tracers => LoggingOptions tracers -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LoggingOptions tracers] -> String -> String
$cshowList :: forall tracers.
Show tracers =>
[LoggingOptions tracers] -> String -> String
show :: LoggingOptions tracers -> String
$cshow :: forall tracers. Show tracers => LoggingOptions tracers -> String
showsPrec :: Int -> LoggingOptions tracers -> String -> String
$cshowsPrec :: forall tracers.
Show tracers =>
Int -> LoggingOptions tracers -> String -> String
Show, LoggingOptions tracers -> LoggingOptions tracers -> Bool
(LoggingOptions tracers -> LoggingOptions tracers -> Bool)
-> (LoggingOptions tracers -> LoggingOptions tracers -> Bool)
-> Eq (LoggingOptions tracers)
forall tracers.
Eq tracers =>
LoggingOptions tracers -> LoggingOptions tracers -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoggingOptions tracers -> LoggingOptions tracers -> Bool
$c/= :: forall tracers.
Eq tracers =>
LoggingOptions tracers -> LoggingOptions tracers -> Bool
== :: LoggingOptions tracers -> LoggingOptions tracers -> Bool
$c== :: forall tracers.
Eq tracers =>
LoggingOptions tracers -> LoggingOptions tracers -> Bool
Eq)

loggingOptions :: Parser tracers -> Parser (LoggingOptions tracers)
loggingOptions :: Parser tracers -> Parser (LoggingOptions tracers)
loggingOptions Parser tracers
tracers = Severity -> tracers -> Maybe Void -> LoggingOptions tracers
forall tracers.
Severity -> tracers -> Maybe Void -> LoggingOptions tracers
LoggingOptions
    (Severity -> tracers -> Maybe Void -> LoggingOptions tracers)
-> Parser Severity
-> Parser (tracers -> Maybe Void -> LoggingOptions tracers)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Severity
minSev
    Parser (tracers -> Maybe Void -> LoggingOptions tracers)
-> Parser tracers -> Parser (Maybe Void -> LoggingOptions tracers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser tracers
tracers
    Parser (Maybe Void -> LoggingOptions tracers)
-> Parser (Maybe Void) -> Parser (LoggingOptions tracers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Void)
tracersDoc
  where
    -- Note: If the global log level is Info then there will be no Debug-level
    --   messages whatsoever.
    --   If the global log level is Debug then there will be Debug, Info, and
    --   higher-severity messages.
    --   So the default global log level is Debug.
    minSev :: Parser Severity
minSev = ReadM Severity -> Mod OptionFields Severity -> Parser Severity
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Severity
loggingSeverityReader (Mod OptionFields Severity -> Parser Severity)
-> Mod OptionFields Severity -> Parser Severity
forall a b. (a -> b) -> a -> b
$ Mod OptionFields Severity
forall a. Monoid a => a
mempty
        Mod OptionFields Severity
-> Mod OptionFields Severity -> Mod OptionFields Severity
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Severity
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"log-level"
        Mod OptionFields Severity
-> Mod OptionFields Severity -> Mod OptionFields Severity
forall a. Semigroup a => a -> a -> a
<> Severity -> Mod OptionFields Severity
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Severity
Debug
        Mod OptionFields Severity
-> Mod OptionFields Severity -> Mod OptionFields Severity
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Severity
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SEVERITY"
        Mod OptionFields Severity
-> Mod OptionFields Severity -> Mod OptionFields Severity
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Severity
forall (f :: * -> *) a. String -> Mod f a
help String
"Global minimum severity for a message to be logged. \
            \Individual tracers severities still need to be configured \
            \independently. Defaults to \"DEBUG\"."
        Mod OptionFields Severity
-> Mod OptionFields Severity -> Mod OptionFields Severity
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Severity
forall (f :: * -> *) a. Mod f a
hidden
    tracersDoc :: Parser (Maybe Void)
tracersDoc = Parser Void -> Parser (Maybe Void)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Void -> Parser (Maybe Void))
-> Parser Void -> Parser (Maybe Void)
forall a b. (a -> b) -> a -> b
$ ReadM Void -> Mod OptionFields Void -> Parser Void
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Void
forall a. Read a => ReadM a
auto (Mod OptionFields Void -> Parser Void)
-> Mod OptionFields Void -> Parser Void
forall a b. (a -> b) -> a -> b
$ Mod OptionFields Void
forall a. Monoid a => a
mempty
        Mod OptionFields Void
-> Mod OptionFields Void -> Mod OptionFields Void
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Void
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"trace-NAME"
        Mod OptionFields Void
-> Mod OptionFields Void -> Mod OptionFields Void
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Void
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SEVERITY"
        Mod OptionFields Void
-> Mod OptionFields Void -> Mod OptionFields Void
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Void
forall (f :: * -> *) a. String -> Mod f a
help String
"Individual component severity for 'NAME'. See --help-tracing \
            \for details and available tracers."

-- | A hidden "helper" option which always fails, but shows info about the
-- logging options.
helperTracing :: [(String, String)] -> Parser (a -> a)
helperTracing :: [(String, String)] -> Parser (a -> a)
helperTracing [(String, String)]
tracerDescriptions = ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a.
ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
abortOption (String -> ParseError
InfoMsg String
helpTxt) (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields (a -> a)
forall a. Monoid a => a
mempty
    Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"help-tracing"
    Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help String
"Show help for tracing options"
    Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (a -> a)
forall (f :: * -> *) a. Mod f a
hidden
  where
    helpTxt :: String
helpTxt = [(String, String)] -> String
helperTracingText [(String, String)]
tracerDescriptions

helperTracingText :: [(String, String)] -> String
helperTracingText :: [(String, String)] -> String
helperTracingText [(String, String)]
tracerDescriptions = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    [ String
"Additional tracing options:"
    , String
""
    , String
"  --log-level SEVERITY     Global minimum severity for a message to be logged."
    , String
"                           Defaults to \"DEBUG\"."
    , String
""
    , String
"  --trace-NAME=off         Disable logging on the given tracer."
    , String
"  --trace-NAME=SEVERITY    Minimum severity for a message to be logged, or"
    , String
"                           \"off\" to disable the tracer. Note that component"
    , String
"                           traces still abide by the global log-level. For"
    , String
"                           example, if the global log level is \"INFO\", then"
    , String
"                           there will be no \"DEBUG\" messages whatsoever."
    , String
"                           Defaults to \"INFO\"."
    , String
""
    , String
"The possible log levels (lowest to highest) are:"
    , String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (((String, Severity) -> String) -> [(String, Severity)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Severity) -> String
forall a b. (a, b) -> a
fst [(String, Severity)]
loggingSeverities)
    , String
""
    , String
"The possible tracers are:"
    ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String -> String -> String
pretty_ String
tracerName String
desc | (String
tracerName, String
desc) <- [(String, String)]
tracerDescriptions]
  where
    maxLength :: Int
maxLength = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((String, String) -> Int) -> [(String, String)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ((String, String) -> String) -> (String, String) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
tracerDescriptions
    pretty_ :: String -> String -> String
pretty_ String
tracerName String
desc =
        String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String -> String
forall a. Int -> a -> [a] -> [a]
padRight Int
maxLength Char
' ' String
tracerName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
desc
      where
        padRight :: Int -> a -> [a] -> [a]
padRight Int
n a
c [a]
cs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
cs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
n a
c

{-------------------------------------------------------------------------------
                            ANSI Terminal Helpers
-------------------------------------------------------------------------------}

-- | Print an error message in red
hPutErrLn :: Handle -> Text -> IO ()
hPutErrLn :: Handle -> Text -> IO ()
hPutErrLn Handle
h Text
msg = Handle -> SGR -> IO () -> IO ()
forall a. Handle -> SGR -> IO a -> IO a
withSGR Handle
h (ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Red) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Handle -> Text -> IO ()
TIO.hPutStrLn Handle
h Text
msg

-- | Like 'hPutErrLn' but with provided default 'Handle'
putErrLn :: Text -> IO ()
putErrLn :: Text -> IO ()
putErrLn = Handle -> Text -> IO ()
hPutErrLn Handle
stderr

-- | The IOHK logging framework prints out ANSI colour codes with its messages.
-- On Windows 10 and above it's possible to enable processing of these colour
-- codes. The 'hSupportsANSIWithoutEmulation' function does this as a side
-- effect. On older versions of Windows, special treatment is required (see:
-- 'System.Console.ANSI'). In this case, this function will achieve nothing, and
-- the ANSI control characters will be printed in grey (too bad).
enableWindowsANSI :: IO ()
enableWindowsANSI :: IO ()
enableWindowsANSI = do
    IO (Maybe Bool) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe Bool) -> IO ()) -> IO (Maybe Bool) -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO (Maybe Bool)
hSupportsANSIWithoutEmulation Handle
stdout
    IO (Maybe Bool) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe Bool) -> IO ()) -> IO (Maybe Bool) -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO (Maybe Bool)
hSupportsANSIWithoutEmulation Handle
stderr

{-------------------------------------------------------------------------------
                         Processing of Sensitive Data
-------------------------------------------------------------------------------}

getPassphrase
    :: forall a . (PassphraseMinLength a, PassphraseMaxLength a)
    => Text
    -> IO (Passphrase a)
getPassphrase :: Text -> IO (Passphrase a)
getPassphrase Text
prompt = do
    let parser :: Text -> Either TextDecodingError (Passphrase a)
parser = FromText (Passphrase a) =>
Text -> Either TextDecodingError (Passphrase a)
forall a. FromText a => Text -> Either TextDecodingError a
fromText @(Passphrase a)
    (Passphrase a, Text) -> Passphrase a
forall a b. (a, b) -> a
fst ((Passphrase a, Text) -> Passphrase a)
-> IO (Passphrase a, Text) -> IO (Passphrase a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (Text -> Either TextDecodingError (Passphrase a))
-> IO (Passphrase a, Text)
forall e a.
Buildable e =>
Text -> (Text -> Either e a) -> IO (a, Text)
getSensitiveLine Text
prompt Text -> Either TextDecodingError (Passphrase a)
parser

getPassphraseWithConfirm
    :: forall a . (PassphraseMinLength a, PassphraseMaxLength a)
    => Text
    -> IO (Passphrase a)
getPassphraseWithConfirm :: Text -> IO (Passphrase a)
getPassphraseWithConfirm Text
prompt = do
    Passphrase a
wPwd <- Text -> IO (Passphrase a)
forall (a :: Symbol).
(PassphraseMinLength a, PassphraseMaxLength a) =>
Text -> IO (Passphrase a)
getPassphrase Text
prompt
    (Passphrase a
wPwd', Text
_) <- do
        let promptRepeat :: Text
promptRepeat = Text
"Enter the passphrase a second time: "
        let parser :: Text -> Either TextDecodingError (Passphrase a)
parser = FromText (Passphrase a) =>
Text -> Either TextDecodingError (Passphrase a)
forall a. FromText a => Text -> Either TextDecodingError a
fromText @(Passphrase a)
        Text
-> (Text -> Either TextDecodingError (Passphrase a))
-> IO (Passphrase a, Text)
forall e a.
Buildable e =>
Text -> (Text -> Either e a) -> IO (a, Text)
getSensitiveLine Text
promptRepeat Text -> Either TextDecodingError (Passphrase a)
parser
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Passphrase a
wPwd Passphrase a -> Passphrase a -> Bool
forall a. Eq a => a -> a -> Bool
/= Passphrase a
wPwd') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> IO ()
putErrLn Text
"Passphrases don't match."
        IO ()
forall b. IO b
exitFailure
    pure Passphrase a
wPwd

-- | Prompt user and parse the input. Re-prompt on invalid inputs.
hGetLine
    :: Buildable e
    => (Handle, Handle)
    -> Text
    -> (Text -> Either e a)
    -> IO (a, Text)
hGetLine :: (Handle, Handle) -> Text -> (Text -> Either e a) -> IO (a, Text)
hGetLine (Handle
hstdin, Handle
hstderr) Text
prompt Text -> Either e a
fromT = do
    Handle -> Text -> IO ()
TIO.hPutStr Handle
hstderr Text
prompt
    Text
txt <- Handle -> IO Text
TIO.hGetLine Handle
hstdin
    case Text -> Either e a
fromT Text
txt of
        Right a
a ->
            (a, Text) -> IO (a, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Text
txt)
        Left e
e -> do
            Handle -> Text -> IO ()
hPutErrLn Handle
hstderr (e -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty e
e)
            (Handle, Handle) -> Text -> (Text -> Either e a) -> IO (a, Text)
forall e a.
Buildable e =>
(Handle, Handle) -> Text -> (Text -> Either e a) -> IO (a, Text)
hGetLine (Handle
hstdin, Handle
hstderr) Text
prompt Text -> Either e a
fromT

-- | Like 'hGetLine' but with default handles
getLine
    :: Text
    -> (Text -> Either String a)
    -> IO (a, Text)
getLine :: Text -> (Text -> Either String a) -> IO (a, Text)
getLine = (Handle, Handle)
-> Text -> (Text -> Either String a) -> IO (a, Text)
forall e a.
Buildable e =>
(Handle, Handle) -> Text -> (Text -> Either e a) -> IO (a, Text)
hGetLine (Handle
stdin, Handle
stderr)

-- | Gather user inputs until a newline is met, hiding what's typed with a
-- placeholder character.
hGetSensitiveLine
    :: Buildable e
    => (Handle, Handle)
    -> Text
    -> (Text -> Either e a)
    -> IO (a, Text)
hGetSensitiveLine :: (Handle, Handle) -> Text -> (Text -> Either e a) -> IO (a, Text)
hGetSensitiveLine (Handle
hstdin, Handle
hstderr) Text
prompt Text -> Either e a
fromT =
    Handle -> BufferMode -> IO (a, Text) -> IO (a, Text)
forall a. Handle -> BufferMode -> IO a -> IO a
withBuffering Handle
hstderr BufferMode
NoBuffering (IO (a, Text) -> IO (a, Text)) -> IO (a, Text) -> IO (a, Text)
forall a b. (a -> b) -> a -> b
$
    Handle -> BufferMode -> IO (a, Text) -> IO (a, Text)
forall a. Handle -> BufferMode -> IO a -> IO a
withBuffering Handle
hstdin BufferMode
NoBuffering (IO (a, Text) -> IO (a, Text)) -> IO (a, Text) -> IO (a, Text)
forall a b. (a -> b) -> a -> b
$
    Handle -> Bool -> IO (a, Text) -> IO (a, Text)
forall a. Handle -> Bool -> IO a -> IO a
withEcho Handle
hstdin Bool
False (IO (a, Text) -> IO (a, Text)) -> IO (a, Text) -> IO (a, Text)
forall a b. (a -> b) -> a -> b
$ do
        Handle -> Text -> IO ()
TIO.hPutStr Handle
hstderr Text
prompt
        Text
txt <- Char -> IO Text
getLineProtected Char
'*'
        case Text -> Either e a
fromT Text
txt of
            Right a
a ->
                (a, Text) -> IO (a, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Text
txt)
            Left e
e -> do
                Handle -> Text -> IO ()
hPutErrLn Handle
hstderr (e -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty e
e)
                (Handle, Handle) -> Text -> (Text -> Either e a) -> IO (a, Text)
forall e a.
Buildable e =>
(Handle, Handle) -> Text -> (Text -> Either e a) -> IO (a, Text)
hGetSensitiveLine (Handle
hstdin, Handle
hstderr) Text
prompt Text -> Either e a
fromT
  where
    getLineProtected :: Char -> IO Text
    getLineProtected :: Char -> IO Text
getLineProtected Char
placeholder =
        Text -> IO Text
getLineProtected' Text
forall a. Monoid a => a
mempty
      where
        backspace :: Char
backspace = Int -> Char
forall a. Enum a => Int -> a
toEnum Int
127
        getLineProtected' :: Text -> IO Text
getLineProtected' Text
line = do
            Handle -> IO Char
hGetChar Handle
hstdin IO Char -> (Char -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Char
'\n' -> do
                    Handle -> Char -> IO ()
hPutChar Handle
hstderr Char
'\n'
                    return Text
line
                Char
c | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
backspace ->
                    if Text -> Bool
T.null Text
line
                        then Text -> IO Text
getLineProtected' Text
line
                        else do
                            Handle -> Int -> IO ()
hCursorBackward Handle
hstderr  Int
1
                            Handle -> Char -> IO ()
hPutChar Handle
hstderr Char
' '
                            Handle -> Int -> IO ()
hCursorBackward Handle
hstderr Int
1
                            Text -> IO Text
getLineProtected' (Text -> Text
T.init Text
line)
                Char
c -> do
                    Handle -> Char -> IO ()
hPutChar Handle
hstderr Char
placeholder
                    Text -> IO Text
getLineProtected' (Text
line Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c)

-- | Like 'hGetSensitiveLine' but with default handles
getSensitiveLine
    :: Buildable e
    => Text
    -- ^ A message to prompt the user
    -> (Text -> Either e a)
    -- ^ An explicit parser from 'Text'
    -> IO (a, Text)
getSensitiveLine :: Text -> (Text -> Either e a) -> IO (a, Text)
getSensitiveLine = (Handle, Handle) -> Text -> (Text -> Either e a) -> IO (a, Text)
forall e a.
Buildable e =>
(Handle, Handle) -> Text -> (Text -> Either e a) -> IO (a, Text)
hGetSensitiveLine (Handle
stdin, Handle
stderr)

{-------------------------------------------------------------------------------
                                Internals
-------------------------------------------------------------------------------}

withBuffering :: Handle -> BufferMode -> IO a -> IO a
withBuffering :: Handle -> BufferMode -> IO a -> IO a
withBuffering Handle
h BufferMode
buffering IO a
action = IO BufferMode
-> (BufferMode -> IO ()) -> (BufferMode -> IO a) -> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket IO BufferMode
aFirst BufferMode -> IO ()
aLast BufferMode -> IO a
aBetween
  where
    aFirst :: IO BufferMode
aFirst = (Handle -> IO BufferMode
hGetBuffering Handle
h IO BufferMode -> IO () -> IO BufferMode
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
buffering)
    aLast :: BufferMode -> IO ()
aLast = Handle -> BufferMode -> IO ()
hSetBuffering Handle
h
    aBetween :: BufferMode -> IO a
aBetween = IO a -> BufferMode -> IO a
forall a b. a -> b -> a
const IO a
action

withEcho :: Handle -> Bool -> IO a -> IO a
withEcho :: Handle -> Bool -> IO a -> IO a
withEcho Handle
h Bool
echo IO a
action = IO Bool -> (Bool -> IO ()) -> (Bool -> IO a) -> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket IO Bool
aFirst Bool -> IO ()
aLast Bool -> IO a
aBetween
  where
    aFirst :: IO Bool
aFirst = (Handle -> IO Bool
hGetEcho Handle
h IO Bool -> IO () -> IO Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Handle -> Bool -> IO ()
hSetEcho Handle
h Bool
echo)
    aLast :: Bool -> IO ()
aLast = Handle -> Bool -> IO ()
hSetEcho Handle
h
    aBetween :: Bool -> IO a
aBetween = IO a -> Bool -> IO a
forall a b. a -> b -> a
const IO a
action

withSGR :: Handle -> SGR -> IO a -> IO a
withSGR :: Handle -> SGR -> IO a -> IO a
withSGR Handle
h SGR
sgr IO a
action = Handle -> IO Bool
hIsTerminalDevice Handle
h IO Bool -> (Bool -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> IO [SGR] -> ([SGR] -> IO ()) -> ([SGR] -> IO a) -> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket IO [SGR]
aFirst [SGR] -> IO ()
aLast [SGR] -> IO a
aBetween
    Bool
False -> IO a
action
  where
    aFirst :: IO [SGR]
aFirst = ([] [SGR] -> IO () -> IO [SGR]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Handle -> [SGR] -> IO ()
hSetSGR Handle
h [SGR
sgr])
    aLast :: [SGR] -> IO ()
aLast = Handle -> [SGR] -> IO ()
hSetSGR Handle
h
    aBetween :: [SGR] -> IO a
aBetween = IO a -> [SGR] -> IO a
forall a b. a -> b -> a
const IO a
action

{-------------------------------------------------------------------------------
                                 Helpers
-------------------------------------------------------------------------------}

-- | Decode API error messages and extract the corresponding message.
decodeError
    :: BL.ByteString
    -> Maybe Text
decodeError :: ByteString -> Maybe Text
decodeError ByteString
bytes = do
    Value
obj <- ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode ByteString
bytes
    (Value -> Parser Text) -> Value -> Maybe Text
forall a b. (a -> Parser b) -> a -> Maybe b
Aeson.parseMaybe (String -> (Object -> Parser Text) -> Value -> Parser Text
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Error" (Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message")) Value
obj

-- | Find the user data directory for a given node network backend.
getDataDir
    :: String -- ^ The network backend name.
    -> IO FilePath
getDataDir :: String -> IO String
getDataDir String
backendDir = do
    -- On Linux/MacOS, use the XDG data directory.
    -- On Windows, use the Local AppData (XdgCache) rather than one from the
    -- Roaming profile because we don't want to (potentially) transmit the
    -- wallet database to a network share.
    let dir :: XdgDirectory
dir = if String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"windows" then XdgDirectory
XdgData else XdgDirectory
XdgCache
    String
dataDir <- XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
dir String
"cardano-wallet"
    return $ String
dataDir String -> String -> String
</> String
backendDir

-- | Look whether a particular filepath is correctly resolved on the filesystem.
-- This makes for a better user experience when passing wrong filepaths via
-- options or arguments, especially when they get forwarded to other services.
requireFilePath :: FilePath -> IO ()
requireFilePath :: String -> IO ()
requireFilePath String
path = String -> IO Bool
doesFileExist String
path IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Bool
False -> do
        Text -> IO ()
putErrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"I couldn't find any file at the given location: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pathT
        IO ()
forall b. IO b
exitFailure
  where
    pathT :: Text
pathT = String -> Text
T.pack String
path

-- | Make a parser optional
optionalE
    :: (Monoid m, Eq m)
    => (m -> Either e a)
    -> (m -> Either e (Maybe a))
optionalE :: (m -> Either e a) -> m -> Either e (Maybe a)
optionalE m -> Either e a
parse = \case
    m
m | m
m m -> m -> Bool
forall a. Eq a => a -> a -> Bool
== m
forall a. Monoid a => a
mempty -> Maybe a -> Either e (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
    m
m  -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either e a -> Either e (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m -> Either e a
parse m
m