{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE NumericUnderscores #-}
{-| Start a wallet / operator server
-}
module Convex.Devnet.WalletServer(
  RunningWalletServer(..),
  WalletLog(..),
  withWallet,
  getUTxOs,
  waitUntilAvailable,
  sendFundsToOperator
) where

import           Cardano.Api                 (BabbageEra, CtxTx, Lovelace, Tx)
import qualified Cardano.Api                 as C
import           Control.Concurrent          (threadDelay)
import           Control.Tracer              (Tracer, contramap, traceWith)
import           Convex.Devnet.CardanoNode   (RunningNode (..))
import qualified Convex.Devnet.NodeQueries   as NodeQueries
import           Convex.Devnet.Utils         (failure, withLogFile)
import qualified Convex.Devnet.Wallet        as Wallet
import           Convex.Utxos                (UtxoSet)
import qualified Convex.Wallet.API           as API
import           Convex.Wallet.Cli.Command   (CliCommand (..))
import           Convex.Wallet.Cli.Config    (Config (..))
import           Convex.Wallet.Operator      (Operator,
                                              OperatorConfigSigning (..),
                                              OperatorConfigVerification (..),
                                              Signing, loadOperatorFiles,
                                              operatorAddress)
import           Data.Aeson                  (FromJSON, ToJSON)
import           Data.Text                   (Text)
import           GHC.Generics                (Generic)
import           GHC.IO.Handle.Types         (Handle)
import           Network.HTTP.Client         (Manager, defaultManagerSettings,
                                              newManager)
import           Servant.Client              (ClientEnv, ClientError (..),
                                              mkClientEnv)
import           Servant.Client.Core.BaseUrl (BaseUrl (..), Scheme (..))
import           System.FilePath             ((</>))
import           System.IO                   (BufferMode (NoBuffering),
                                              hSetBuffering)
import           System.Process              (CreateProcess (..), ProcessHandle,
                                              StdStream (UseHandle), proc,
                                              readCreateProcess,
                                              withCreateProcess)

data WalletLog =
  WMsgText{ WalletLog -> Text
wmsgText :: Text}
  | WMsgWaiting String
  | WCreatingKey{ WalletLog -> String
keyFile :: FilePath }
  | WWallet Wallet.WalletLog
  deriving stock (Int -> WalletLog -> ShowS
[WalletLog] -> ShowS
WalletLog -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletLog] -> ShowS
$cshowList :: [WalletLog] -> ShowS
show :: WalletLog -> String
$cshow :: WalletLog -> String
showsPrec :: Int -> WalletLog -> ShowS
$cshowsPrec :: Int -> WalletLog -> ShowS
Show, forall x. Rep WalletLog x -> WalletLog
forall x. WalletLog -> Rep WalletLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WalletLog x -> WalletLog
$cfrom :: forall x. WalletLog -> Rep WalletLog x
Generic)
  deriving anyclass ([WalletLog] -> Encoding
[WalletLog] -> Value
WalletLog -> Encoding
WalletLog -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WalletLog] -> Encoding
$ctoEncodingList :: [WalletLog] -> Encoding
toJSONList :: [WalletLog] -> Value
$ctoJSONList :: [WalletLog] -> Value
toEncoding :: WalletLog -> Encoding
$ctoEncoding :: WalletLog -> Encoding
toJSON :: WalletLog -> Value
$ctoJSON :: WalletLog -> Value
ToJSON, Value -> Parser [WalletLog]
Value -> Parser WalletLog
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WalletLog]
$cparseJSONList :: Value -> Parser [WalletLog]
parseJSON :: Value -> Parser WalletLog
$cparseJSON :: Value -> Parser WalletLog
FromJSON)

data RunningWalletServer =
  RunningWalletServer
    { RunningWalletServer -> Operator Signing
rwsOperator             :: Operator Signing
    , RunningWalletServer -> OperatorConfigVerification
rwsOpConfigVerification :: OperatorConfigVerification
    , RunningWalletServer -> OperatorConfigSigning
rwsOpConfigSigning      :: OperatorConfigSigning
    , RunningWalletServer -> ClientEnv
rwsClient               :: ClientEnv
    , RunningWalletServer -> Manager
rwsManager              :: Manager
    , RunningWalletServer
-> (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
rwsHandle               :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    }

withWallet :: Tracer IO WalletLog -> FilePath -> RunningNode -> (RunningWalletServer -> IO a) -> IO a
withWallet :: forall a.
Tracer IO WalletLog
-> String -> RunningNode -> (RunningWalletServer -> IO a) -> IO a
withWallet Tracer IO WalletLog
tracer String
stateDirectory rn :: RunningNode
rn@RunningNode{String
rnNodeSocket :: RunningNode -> String
rnNodeSocket :: String
rnNodeSocket, String
rnNodeConfigFile :: RunningNode -> String
rnNodeConfigFile :: String
rnNodeConfigFile, NetworkId
rnNetworkId :: RunningNode -> NetworkId
rnNetworkId :: NetworkId
rnNetworkId} RunningWalletServer -> IO a
action = do
  let logFilePath :: String
logFilePath = String
stateDirectory String -> ShowS
</> String
"wallet-server.log"
      signingKeyFile :: String
signingKeyFile = String
stateDirectory String -> ShowS
</> String
"operator-signing-key.vkey"
      verificationKeyFile :: String
verificationKeyFile = String
stateDirectory String -> ShowS
</> String
"operator-verification-key.vkey"
      walletFile :: String
walletFile = String
stateDirectory String -> ShowS
</> String
"wallet-state.json"
      mkProc :: CliCommand -> CreateProcess
mkProc = Maybe String -> CliCommand -> CreateProcess
walletCliProcess (forall a. a -> Maybe a
Just String
stateDirectory)
      signingConf :: OperatorConfigSigning
signingConf = OperatorConfigSigning{ocSigningKeyFile :: String
ocSigningKeyFile = String
signingKeyFile, ocStakeVerificationKeyFile :: Maybe String
ocStakeVerificationKeyFile = forall a. Maybe a
Nothing}
      verificationConf :: OperatorConfigVerification
verificationConf = OperatorConfigVerification{ocvPaymentKeyFile :: String
ocvPaymentKeyFile = String
verificationKeyFile, ocvStakeVerificationKeyFile :: Maybe String
ocvStakeVerificationKeyFile = forall a. Maybe a
Nothing}
      walletCfg :: Config
walletCfg = Config{String
walletFile :: String
walletFile :: String
walletFile, cardanoNodeConfigFile :: String
cardanoNodeConfigFile=String
rnNodeConfigFile, cardanoNodeSocket :: String
cardanoNodeSocket=String
rnNodeSocket}

      walletPort :: Int
walletPort = Int
9988

  -- TODO
  -- 1. Generate key
  -- 2. start wallet server
  Manager
rwsManager <- ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings
  let rwsClient :: ClientEnv
rwsClient = Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
rwsManager (Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Http String
"localhost" Int
walletPort String
"")
  forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO WalletLog
tracer WCreatingKey{keyFile :: String
keyFile = String
signingKeyFile}
  String
_ <- CreateProcess -> String -> IO String
readCreateProcess (CliCommand -> CreateProcess
mkProc GenerateSigningKey{String
verificationKeyFile :: String
verificationKeyFile :: String
verificationKeyFile, String
signingKeyFile :: String
signingKeyFile :: String
signingKeyFile}) String
""
  Operator Signing
op <- OperatorConfigSigning -> IO (Operator Signing)
loadOperatorFiles OperatorConfigSigning
signingConf
  forall a. String -> (Handle -> IO a) -> IO a
withLogFile String
logFilePath forall a b. (a -> b) -> a -> b
$ \Handle
out -> do
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
out BufferMode
NoBuffering
    let p :: CreateProcess
p = CliCommand -> CreateProcess
mkProc forall a b. (a -> b) -> a -> b
$ Config -> OperatorConfigVerification -> Int -> CliCommand
RunWallet Config
walletCfg OperatorConfigVerification
verificationConf Int
walletPort
    forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess CreateProcess
p{std_out :: StdStream
std_out = Handle -> StdStream
UseHandle Handle
out, std_err :: StdStream
std_err = Handle -> StdStream
UseHandle Handle
out} forall a b. (a -> b) -> a -> b
$
      \Maybe Handle
stdin Maybe Handle
stdout Maybe Handle
stderr ProcessHandle
processHandle -> do
        let rws :: RunningWalletServer
rws = RunningWalletServer
                { rwsHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
rwsHandle = (Maybe Handle
stdin, Maybe Handle
stdout, Maybe Handle
stderr, ProcessHandle
processHandle)
                , rwsOpConfigVerification :: OperatorConfigVerification
rwsOpConfigVerification = OperatorConfigVerification
verificationConf
                , rwsOpConfigSigning :: OperatorConfigSigning
rwsOpConfigSigning = OperatorConfigSigning
signingConf
                , rwsOperator :: Operator Signing
rwsOperator = Operator Signing
op
                , Manager
rwsManager :: Manager
rwsManager :: Manager
rwsManager
                , ClientEnv
rwsClient :: ClientEnv
rwsClient :: ClientEnv
rwsClient
                }
        ()
_ <- forall k.
Tracer IO WalletLog
-> RunningNode -> Operator k -> Lovelace -> IO (Tx BabbageEra)
sendFundsToOperator Tracer IO WalletLog
tracer RunningNode
rn Operator Signing
op (Integer -> Lovelace
C.Lovelace Integer
100_000_000) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NetworkId -> String -> Tx BabbageEra -> IO ()
NodeQueries.waitForTxn NetworkId
rnNetworkId String
rnNodeSocket
        Tracer IO WalletLog -> RunningWalletServer -> IO ()
waitUntilAvailable Tracer IO WalletLog
tracer RunningWalletServer
rws
        RunningWalletServer -> IO a
action RunningWalletServer
rws

walletCliProcess :: Maybe FilePath -> CliCommand -> CreateProcess
walletCliProcess :: Maybe String -> CliCommand -> CreateProcess
walletCliProcess Maybe String
cwd CliCommand
com = (String -> [String] -> CreateProcess
proc String
walletExecutable [String]
strArgs){Maybe String
cwd :: Maybe String
cwd :: Maybe String
cwd} where
  comString :: CliCommand -> String
comString = \case
    CliCommand
GenerateWallet       -> String
"generate-wallet"
    GenerateSigningKey{} -> String
"generate-signing-key"
    RunWallet{}          -> String
"run-wallet"
    ShowAddress{}        -> String
"show-address"

  keyFiles :: CliCommand -> [String]
keyFiles = \case
    GenerateSigningKey{String
verificationKeyFile :: String
verificationKeyFile :: CliCommand -> String
verificationKeyFile, String
signingKeyFile :: String
signingKeyFile :: CliCommand -> String
signingKeyFile} ->
      [ String
"--verification.file", String
verificationKeyFile
      , String
"--signing.file", String
signingKeyFile
      ]
    CliCommand
_ -> []

  config :: CliCommand -> [String]
config = \case
    RunWallet Config
cfg OperatorConfigVerification
_ Int
_ -> Config -> [String]
configArgs Config
cfg
    ShowAddress Config
cfg OperatorConfigVerification
_ -> Config -> [String]
configArgs Config
cfg
    CliCommand
_ -> []

  opConfig :: CliCommand -> [String]
opConfig = \case
    RunWallet Config
_ OperatorConfigVerification
opCfg Int
_ -> OperatorConfigVerification -> [String]
opConfigArgs OperatorConfigVerification
opCfg
    ShowAddress Config
_ OperatorConfigVerification
opCfg -> OperatorConfigVerification -> [String]
opConfigArgs OperatorConfigVerification
opCfg
    CliCommand
_ -> []

  portConfig :: CliCommand -> [String]
portConfig = \case
    RunWallet Config
_ OperatorConfigVerification
_ Int
port -> [String
"--http.port", forall a. Show a => a -> String
show Int
port]
    CliCommand
_ -> []

  strArgs :: [String]
strArgs =
    forall a. Monoid a => [a] -> a
mconcat
      [ [CliCommand -> String
comString CliCommand
com]
      , CliCommand -> [String]
keyFiles CliCommand
com
      , CliCommand -> [String]
config CliCommand
com
      , CliCommand -> [String]
opConfig CliCommand
com
      , CliCommand -> [String]
portConfig CliCommand
com
      ]

walletExecutable :: String
walletExecutable :: String
walletExecutable = String
"convex-wallet"

configArgs :: Config -> [String]
configArgs :: Config -> [String]
configArgs Config{String
cardanoNodeConfigFile :: String
cardanoNodeConfigFile :: Config -> String
cardanoNodeConfigFile, String
cardanoNodeSocket :: String
cardanoNodeSocket :: Config -> String
cardanoNodeSocket, String
walletFile :: String
walletFile :: Config -> String
walletFile} =
  [ String
"--node-config", String
cardanoNodeConfigFile
  , String
"--node-socket", String
cardanoNodeSocket
  , String
"--wallet-file", String
walletFile
  ]

opConfigArgs :: OperatorConfigVerification -> [String]
opConfigArgs :: OperatorConfigVerification -> [String]
opConfigArgs OperatorConfigVerification{String
ocvPaymentKeyFile :: String
ocvPaymentKeyFile :: OperatorConfigVerification -> String
ocvPaymentKeyFile, Maybe String
ocvStakeVerificationKeyFile :: Maybe String
ocvStakeVerificationKeyFile :: OperatorConfigVerification -> Maybe String
ocvStakeVerificationKeyFile} =
  [ String
"--verification-key-file", String
ocvPaymentKeyFile
  ] forall a. [a] -> [a] -> [a]
++
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
f -> [String
"--stake-verification-key-file", String
f]) Maybe String
ocvStakeVerificationKeyFile

getUTxOs :: RunningWalletServer -> IO (UtxoSet CtxTx ())
getUTxOs :: RunningWalletServer -> IO (UtxoSet CtxTx ())
getUTxOs RunningWalletServer{ClientEnv
rwsClient :: ClientEnv
rwsClient :: RunningWalletServer -> ClientEnv
rwsClient} = ClientEnv -> IO (Either ClientError (UtxoSet CtxTx ()))
API.getUTxOs ClientEnv
rwsClient forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left ClientError
err -> forall a. HasCallStack => String -> a
error (String
"getUTxOs failed: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ClientError
err)
  Right UtxoSet CtxTx ()
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure UtxoSet CtxTx ()
x

{-| Wait until the service is online (healthcheck route respons with 200)
-}
waitUntilAvailable :: Tracer IO WalletLog -> RunningWalletServer -> IO ()
waitUntilAvailable :: Tracer IO WalletLog -> RunningWalletServer -> IO ()
waitUntilAvailable Tracer IO WalletLog
tr RunningWalletServer{ClientEnv
rwsClient :: ClientEnv
rwsClient :: RunningWalletServer -> ClientEnv
rwsClient} =
  let go :: t -> IO ()
go t
n | t
n forall a. Ord a => a -> a -> Bool
> t
0 = ClientEnv -> IO (Either ClientError NoContent)
API.getHealth ClientEnv
rwsClient forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left (ConnectionError SomeException
_err) -> do
          forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO WalletLog
tr (String -> WalletLog
WMsgWaiting String
"waitUntilAvailable")
          Int -> IO ()
threadDelay Int
2_000_000
          t -> IO ()
go (t
n forall a. Num a => a -> a -> a
- t
1)
        Left ClientError
err -> forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String
"waitUntilAvailable: Failed with unexpected error: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ClientError
err)
        Right{}  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          | Bool
otherwise = forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure String
"waitUntilAvailable: Number of retries exceeded"
  in forall {t}. (Ord t, Num t) => t -> IO ()
go (Integer
20 :: Integer)

{-| Send faucet funds to the operator
-}
sendFundsToOperator :: Tracer IO WalletLog -> RunningNode -> Operator k -> Lovelace -> IO (Tx BabbageEra)
sendFundsToOperator :: forall k.
Tracer IO WalletLog
-> RunningNode -> Operator k -> Lovelace -> IO (Tx BabbageEra)
sendFundsToOperator Tracer IO WalletLog
tr node :: RunningNode
node@RunningNode{NetworkId
rnNetworkId :: NetworkId
rnNetworkId :: RunningNode -> NetworkId
rnNetworkId} Operator k
op Lovelace
lvl = do
  let opAddress :: Address ShelleyAddr
opAddress = forall k. NetworkId -> Operator k -> Address ShelleyAddr
operatorAddress NetworkId
rnNetworkId Operator k
op
  Tracer IO WalletLog
-> RunningNode
-> AddressInEra BabbageEra
-> Int
-> Lovelace
-> IO (Tx BabbageEra)
Wallet.sendFaucetFundsTo (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap WalletLog -> WalletLog
WWallet Tracer IO WalletLog
tr) RunningNode
node (forall addrtype era.
AddressTypeInEra addrtype era
-> Address addrtype -> AddressInEra era
C.AddressInEra (forall era. ShelleyBasedEra era -> AddressTypeInEra ShelleyAddr era
C.ShelleyAddressInEra ShelleyBasedEra BabbageEra
C.ShelleyBasedEraBabbage) Address ShelleyAddr
opAddress) Int
10 Lovelace
lvl