{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-| CLI interface for a wallet
-}
module Convex.Wallet.Cli(
  runMain
  ) where

import qualified Cardano.Api                            as C
import           Control.Concurrent                     (forkIO)
import           Control.Exception                      (bracket)
import           Control.Monad                          (void)
import           Control.Monad.Except                   (MonadError (..))
import           Control.Monad.IO.Class                 (MonadIO (..))
import           Control.Monad.Trans.Except             (runExceptT)
import           Convex.MonadLog                        (MonadLog,
                                                         MonadLogKatipT (..),
                                                         logInfo, logInfoS,
                                                         logWarnS)
import           Convex.NodeClient.Types                (runNodeClient)
import           Convex.NodeQueries                     (loadConnectInfo)
import           Convex.Utxos                           (PrettyBalance (..))
import qualified Convex.Wallet                          as Wallet
import qualified Convex.Wallet.API                      as API
import           Convex.Wallet.Cli.Command              (CliCommand (..),
                                                         commandParser)
import           Convex.Wallet.Cli.Config               (Config (..))
import qualified Convex.Wallet.NodeClient.BalanceClient as NC
import           Convex.Wallet.Operator                 (OperatorConfigVerification,
                                                         loadOperatorFilesVerification,
                                                         operatorAddress,
                                                         operatorPaymentCredential)
import qualified Convex.Wallet.WalletState              as WalletState
import           Data.Maybe                             (fromMaybe)
import qualified Data.Text                              as Text
import qualified Katip                                  as K
import           Options.Applicative                    (customExecParser,
                                                         disambiguate, helper,
                                                         idm, info, prefs,
                                                         showHelpOnEmpty,
                                                         showHelpOnError)
import           System.IO                              (stdout)

runMain :: IO ()
runMain :: IO ()
runMain = do
  Scribe
mainScribe <- ColorStrategy -> Handle -> PermitFunc -> Verbosity -> IO Scribe
K.mkHandleScribe (Bool -> ColorStrategy
K.ColorLog Bool
True) Handle
stdout (forall (m :: * -> *) a. Monad m => Severity -> Item a -> m Bool
K.permitItem Severity
K.InfoS) Verbosity
K.V2
  LogEnv
initLogEnv <- Namespace -> Environment -> IO LogEnv
K.initLogEnv Namespace
"wallet" Environment
"cli"
  let makeLogEnv :: IO LogEnv
makeLogEnv = Text -> Scribe -> ScribeSettings -> LogEnv -> IO LogEnv
K.registerScribe Text
"stdout-main" Scribe
mainScribe ScribeSettings
K.defaultScribeSettings LogEnv
initLogEnv
  forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO LogEnv
makeLogEnv LogEnv -> IO LogEnv
K.closeScribes forall a b. (a -> b) -> a -> b
$ \LogEnv
le -> forall c (m :: * -> *) a.
LogItem c =>
LogEnv -> c -> Namespace -> KatipContextT m a -> m a
K.runKatipContextT LogEnv
le () Namespace
"main" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadLogKatipT m a -> KatipContextT m a
runMonadLogKatipT forall a b. (a -> b) -> a -> b
$ do
    CliCommand
command <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser
                        (PrefsMod -> ParserPrefs
prefs forall a b. (a -> b) -> a -> b
$ PrefsMod
disambiguate forall a. Semigroup a => a -> a -> a
<> PrefsMod
showHelpOnEmpty forall a. Semigroup a => a -> a -> a
<> PrefsMod
showHelpOnError)
                        (forall a. Parser a -> InfoMod a -> ParserInfo a
info (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CliCommand
commandParser) forall m. Monoid m => m
idm))
    Either InitialLedgerStateError ()
result <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
      case CliCommand
command of
        CliCommand
GenerateWallet            -> forall (m :: * -> *). (MonadIO m, MonadLog m) => m ()
generateWallet
        GenerateSigningKey{FilePath
verificationKeyFile :: CliCommand -> FilePath
verificationKeyFile :: FilePath
verificationKeyFile, FilePath
signingKeyFile :: CliCommand -> FilePath
signingKeyFile :: FilePath
signingKeyFile} -> forall (m :: * -> *).
(MonadIO m, MonadLog m) =>
FilePath -> FilePath -> m ()
generateSigningKey FilePath
verificationKeyFile FilePath
signingKeyFile
        RunWallet Config
config OperatorConfigVerification
op Int
port  -> forall (m :: * -> *).
(MonadLog m, MonadError InitialLedgerStateError m, MonadIO m) =>
LogEnv -> Int -> Config -> OperatorConfigVerification -> m ()
runWallet LogEnv
le Int
port Config
config OperatorConfigVerification
op
        ShowAddress Config
config OperatorConfigVerification
op     -> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *).
(MonadLog m, MonadError InitialLedgerStateError m, MonadIO m) =>
Config
-> OperatorConfigVerification
-> m (LocalNodeConnectInfo CardanoMode)
showAddress Config
config OperatorConfigVerification
op)
    case Either InitialLedgerStateError ()
result of
      Left InitialLedgerStateError
err -> do
        forall (m :: * -> *). MonadLog m => FilePath -> m ()
logWarnS FilePath
"Error in runMain"
        forall (m :: * -> *). MonadLog m => FilePath -> m ()
logWarnS (Text -> FilePath
Text.unpack forall a b. (a -> b) -> a -> b
$ InitialLedgerStateError -> Text
C.renderInitialLedgerStateError InitialLedgerStateError
err)
      Right () -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

generateWallet :: (MonadIO m, MonadLog m) => m ()
generateWallet :: forall (m :: * -> *). (MonadIO m, MonadLog m) => m ()
generateWallet = do
  forall (m :: * -> *). MonadLog m => FilePath -> m ()
logInfoS FilePath
"Generating wallet key..."
  Wallet
key <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Wallet
Wallet.generateWallet
  forall a (m :: * -> *). (Pretty a, MonadLog m) => a -> m ()
logInfo (Wallet -> Text
Wallet.privateKey Wallet
key)

generateSigningKey :: (MonadIO m, MonadLog m) => FilePath -> FilePath -> m ()
generateSigningKey :: forall (m :: * -> *).
(MonadIO m, MonadLog m) =>
FilePath -> FilePath -> m ()
generateSigningKey FilePath
verificationKeyFile FilePath
signingKeyFile = do
  forall (m :: * -> *). MonadLog m => FilePath -> m ()
logInfoS FilePath
"Generating signing key"
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    SigningKey PaymentKey
signingKey <- forall keyrole.
Key keyrole =>
AsType keyrole -> IO (SigningKey keyrole)
C.generateSigningKey AsType PaymentKey
C.AsPaymentKey
    forall a content.
HasTextEnvelope a =>
File content 'Out
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
C.writeFileTextEnvelope (forall content (direction :: FileDirection).
FilePath -> File content direction
C.File FilePath
signingKeyFile) forall a. Maybe a
Nothing SigningKey PaymentKey
signingKey forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => FilePath -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall a content.
HasTextEnvelope a =>
File content 'Out
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
C.writeFileTextEnvelope (forall content (direction :: FileDirection).
FilePath -> File content direction
C.File FilePath
verificationKeyFile) forall a. Maybe a
Nothing (forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
C.getVerificationKey SigningKey PaymentKey
signingKey) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => FilePath -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure

showAddress :: (MonadLog m, MonadError C.InitialLedgerStateError m, MonadIO m) => Config -> OperatorConfigVerification -> m (C.LocalNodeConnectInfo C.CardanoMode)
showAddress :: forall (m :: * -> *).
(MonadLog m, MonadError InitialLedgerStateError m, MonadIO m) =>
Config
-> OperatorConfigVerification
-> m (LocalNodeConnectInfo CardanoMode)
showAddress Config{FilePath
cardanoNodeConfigFile :: Config -> FilePath
cardanoNodeConfigFile :: FilePath
cardanoNodeConfigFile, FilePath
cardanoNodeSocket :: Config -> FilePath
cardanoNodeSocket :: FilePath
cardanoNodeSocket} OperatorConfigVerification
operatorConfig = do
  Operator Verification
op <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (OperatorConfigVerification -> IO (Operator Verification)
loadOperatorFilesVerification OperatorConfigVerification
operatorConfig)
  (info_ :: LocalNodeConnectInfo CardanoMode
info_@C.LocalNodeConnectInfo{NetworkId
localNodeNetworkId :: forall mode. LocalNodeConnectInfo mode -> NetworkId
localNodeNetworkId :: NetworkId
C.localNodeNetworkId}, Env
_) <- forall (m :: * -> *).
(MonadError InitialLedgerStateError m, MonadIO m) =>
FilePath -> FilePath -> m (LocalNodeConnectInfo CardanoMode, Env)
loadConnectInfo FilePath
cardanoNodeConfigFile FilePath
cardanoNodeSocket
  forall a (m :: * -> *). (Pretty a, MonadLog m) => a -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Text
"Operator address: " forall a. Semigroup a => a -> a -> a
<> forall a. SerialiseAsBech32 a => a -> Text
C.serialiseToBech32 (forall k. NetworkId -> Operator k -> Address ShelleyAddr
operatorAddress NetworkId
localNodeNetworkId Operator Verification
op)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalNodeConnectInfo CardanoMode
info_

runWallet :: (MonadLog m, MonadError C.InitialLedgerStateError m, MonadIO m) => K.LogEnv -> Int -> Config -> OperatorConfigVerification -> m ()
runWallet :: forall (m :: * -> *).
(MonadLog m, MonadError InitialLedgerStateError m, MonadIO m) =>
LogEnv -> Int -> Config -> OperatorConfigVerification -> m ()
runWallet LogEnv
logEnv Int
port Config{FilePath
cardanoNodeConfigFile :: FilePath
cardanoNodeConfigFile :: Config -> FilePath
cardanoNodeConfigFile, FilePath
cardanoNodeSocket :: FilePath
cardanoNodeSocket :: Config -> FilePath
cardanoNodeSocket, FilePath
walletFile :: Config -> FilePath
walletFile :: FilePath
walletFile} OperatorConfigVerification
operatorConfig = do
  WalletState
initialState <- forall a. a -> Maybe a -> a
fromMaybe WalletState
WalletState.initialWalletState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe WalletState)
WalletState.readFromFile FilePath
walletFile)
  Operator Verification
op <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (OperatorConfigVerification -> IO (Operator Verification)
loadOperatorFilesVerification OperatorConfigVerification
operatorConfig)
  forall (m :: * -> *). MonadLog m => FilePath -> m ()
logInfoS forall a b. (a -> b) -> a -> b
$ FilePath
"Resuming from " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show (WalletState -> ChainPoint
WalletState.chainPoint WalletState
initialState)
  forall a (m :: * -> *). (Pretty a, MonadLog m) => a -> m ()
logInfo (forall ctx a. UtxoSet ctx a -> PrettyBalance ctx a
PrettyBalance forall a b. (a -> b) -> a -> b
$ WalletState -> UtxoSet CtxTx ()
WalletState.utxoSet WalletState
initialState)
  BalanceClientEnv
e <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> WalletState -> IO BalanceClientEnv
NC.balanceClientEnv FilePath
walletFile WalletState
initialState)
  forall (m :: * -> *). MonadLog m => FilePath -> m ()
logInfoS forall a b. (a -> b) -> a -> b
$ FilePath
"Starting wallet server on port " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Int
port
  ThreadId
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (TVar WalletState -> Int -> IO ()
API.startServer (BalanceClientEnv -> TVar WalletState
NC.bceState BalanceClientEnv
e) Int
port)
  let client :: p -> Env -> f PipelinedLedgerStateClient
client p
_ Env
env = do
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (LogEnv
-> Namespace
-> BalanceClientEnv
-> WalletState
-> PaymentCredential
-> Env
-> PipelinedLedgerStateClient
NC.balanceClient LogEnv
logEnv Namespace
"wallet" BalanceClientEnv
e WalletState
initialState (forall k. Operator k -> PaymentCredential
operatorPaymentCredential Operator Verification
op) Env
env)
  Either InitialLedgerStateError ()
result <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (FilePath
-> FilePath
-> (LocalNodeConnectInfo CardanoMode
    -> Env -> IO PipelinedLedgerStateClient)
-> ExceptT InitialLedgerStateError IO ()
runNodeClient FilePath
cardanoNodeConfigFile FilePath
cardanoNodeSocket forall {f :: * -> *} {p}.
Applicative f =>
p -> Env -> f PipelinedLedgerStateClient
client)
  case Either InitialLedgerStateError ()
result of
    Left InitialLedgerStateError
err -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError InitialLedgerStateError
err
    Right () -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()