{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DerivingStrategies  #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE NumericUnderscores  #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeApplications    #-}
-- | Start a local cluster of cardano nodes and PAB(s)
module Plutus.PAB.LocalCluster.Run where

import Cardano.Api qualified as CAPI
import Cardano.Api.NetworkId.Extra (NetworkIdWrapper (NetworkIdWrapper))
import Cardano.BM.Backend.EKGView qualified as EKG
import Cardano.BM.Data.Severity (Severity (Notice))
import Cardano.BM.Data.Tracer (HasPrivacyAnnotation, HasSeverityAnnotation)
import Cardano.BM.Plugin (loadPlugin)
import Cardano.BM.Tracing (HasSeverityAnnotation (getSeverityAnnotation), Severity (Debug, Info))
import Cardano.CLI (LogOutput (LogToFile, LogToStdStreams), Port, ekgEnabled, getEKGURL, getPrometheusURL,
                    withLoggingNamed)
import Cardano.ChainIndex.Types qualified as PAB.CI
import Cardano.Launcher.Node (nodeSocketFile)
import Cardano.Mnemonic (SomeMnemonic (SomeMnemonic))
import Cardano.Node.Emulator.TimeSlot (SlotConfig (SlotConfig))
import Cardano.Node.Emulator.TimeSlot qualified as TimeSlot
import Cardano.Node.Types (NodeMode (AlonzoNode),
                           PABServerConfig (pscKeptBlocks, pscNetworkId, pscNodeMode, pscSlotConfig, pscSocketPath))
import Cardano.Startup (installSignalHandlers, setDefaultFilePermissions, withUtf8Encoding)
import Cardano.Wallet.Api.Client qualified as WalletClient
import Cardano.Wallet.Api.Server (Listen (ListenOnPort))
import Cardano.Wallet.Api.Types (ApiMnemonicT (ApiMnemonicT), ApiT (ApiT), ApiWallet (ApiWallet),
                                 EncodeAddress (encodeAddress), WalletOrAccountPostData (WalletOrAccountPostData),
                                 postData)
import Cardano.Wallet.Api.Types qualified as Wallet.Types
import Cardano.Wallet.Logging (stdoutTextTracer, trMessageText)
import Cardano.Wallet.Primitive.AddressDerivation (NetworkDiscriminant (Mainnet))
import Cardano.Wallet.Primitive.Passphrase.Types (Passphrase (Passphrase))
import Cardano.Wallet.Primitive.SyncProgress (SyncTolerance (SyncTolerance))
import Cardano.Wallet.Primitive.Types (GenesisParameters (GenesisParameters),
                                       NetworkParameters (NetworkParameters, slottingParameters),
                                       SlotLength (SlotLength),
                                       SlottingParameters (SlottingParameters, getSecurityParameter),
                                       StartTime (StartTime), WalletName (WalletName))
import Cardano.Wallet.Primitive.Types.Coin (Coin (Coin))
import Cardano.Wallet.Shelley (SomeNetworkDiscriminant (SomeNetworkDiscriminant), serveWallet, setupTracers,
                               tracerSeverities)
import Cardano.Wallet.Shelley.BlockchainSource (BlockchainSource (NodeSource))
import Cardano.Wallet.Shelley.Launch (withSystemTempDir)
import Cardano.Wallet.Shelley.Launch.Cluster (ClusterLog, Credential (KeyCredential), RunningNode (RunningNode),
                                              localClusterConfigFromEnv, moveInstantaneousRewardsTo, oneMillionAda,
                                              sendFaucetAssetsTo, testMinSeverityFromEnv, tokenMetadataServerFromEnv,
                                              walletMinSeverityFromEnv, withCluster)
import Cardano.Wallet.Types (WalletUrl (WalletUrl))
import Cardano.Wallet.Types qualified as Wallet.Config
import Control.Arrow (first)
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (async)
import Control.Lens (contramap, set, (&), (.~), (^.))
import Control.Monad (void, when)
import Control.Monad.Freer.Extras.Beam.Sqlite (DbConfig (dbConfigFile))
import Control.Tracer (traceWith)
import Data.Aeson (FromJSON, ToJSON)
import Data.Default (Default (def))
import Data.OpenApi.Schema qualified as OpenApi
import Data.Proxy (Proxy (Proxy))
import Data.Quantity (Quantity (getQuantity))
import Data.String (IsString (fromString))
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Class (ToText (toText))
import Data.Time.Clock (nominalDiffTimeToSeconds)
import Network.HTTP.Client (defaultManagerSettings, newManager)
import Ouroboros.Network.Client.Wallet (tunedForMainnetPipeliningStrategy)
import Plutus.ChainIndex.App qualified as ChainIndex
import Plutus.ChainIndex.Config qualified as CI
import Plutus.ChainIndex.Logging qualified as ChainIndex.Logging
import Plutus.ChainIndex.Types (Point (..))
import Plutus.PAB.App (StorageBackend (BeamBackend))
import Plutus.PAB.Effects.Contract.Builtin (BuiltinHandler, HasDefinitions)
import Plutus.PAB.Run qualified as PAB.Run
import Plutus.PAB.Run.Command (ConfigCommand (Migrate, PABWebserver))
import Plutus.PAB.Run.CommandParser (AppOpts (AppOpts, cmd, configPath, logConfigPath, minLogLevel, resumeFrom, rollbackHistory, runEkgServer, storageBackend))
import Plutus.PAB.Run.CommandParser qualified as PAB.Command
import Plutus.PAB.Types (ChainQueryConfig (ChainIndexConfig),
                         Config (chainQueryConfig, dbConfig, nodeServerConfig, walletServerConfig), DbConfig (SqliteDB))
import Plutus.PAB.Types qualified as PAB.Config
import Prettyprinter (Pretty)
import Servant qualified
import Servant.Client (BaseUrl (BaseUrl, baseUrlHost, baseUrlPath, baseUrlPort, baseUrlScheme), Scheme (Http),
                       mkClientEnv, runClientM)
import System.Directory (createDirectory)
import System.FilePath ((</>))
import Test.Integration.Faucet (genRewardAccounts, maryIntegrationTestAssets, mirMnemonics, shelleyIntegrationTestFunds)
import Test.Integration.Faucet qualified as Faucet
import Test.Integration.Framework.DSL (fixturePassphrase)

data LogOutputs =
    LogOutputs
        { LogOutputs -> [LogOutput]
loCluster :: [LogOutput]
        , LogOutputs -> [LogOutput]
loWallet  :: [LogOutput]
        }

-- Do all the program setup required for running the local cluster, create a
-- temporary directory, log output configurations, and pass these to the given
-- main action.
withLocalClusterSetup
    :: (FilePath -> LogOutputs -> IO a)
    -> IO a
withLocalClusterSetup :: (FilePath -> LogOutputs -> IO a) -> IO a
withLocalClusterSetup FilePath -> LogOutputs -> IO a
action = do
    FilePath -> IO ()
putStrLn FilePath
"Starting PAB local cluster. Please make sure the SHELLEY_TEST_DATA environment variable is set to 'plutus-pab/local-cluster/cluster-data/cardano-node-shelley' in the plutus-apps repository."

    -- Handle SIGTERM properly
    IO () -> IO ()
installSignalHandlers (FilePath -> IO ()
putStrLn FilePath
"Terminated")

    -- Ensure key files have correct permissions for cardano-cli
    IO ()
setDefaultFilePermissions

    -- Set UTF-8, regardless of user locale
    IO a -> IO a
forall a. IO a -> IO a
withUtf8Encoding (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
        -- This temporary directory will contain logs, and all other data
        -- produced by the local test cluster.
        Tracer IO TempDirLog -> FilePath -> (FilePath -> IO a) -> IO a
forall (m :: * -> *) a.
MonadUnliftIO m =>
Tracer m TempDirLog -> FilePath -> (FilePath -> m a) -> m a
withSystemTempDir Tracer IO TempDirLog
forall (m :: * -> *) a. (MonadIO m, ToText a) => Tracer m a
stdoutTextTracer FilePath
"test-cluster" ((FilePath -> IO a) -> IO a) -> (FilePath -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FilePath
dir -> do
            let logOutputs :: FilePath -> Severity -> [LogOutput]
logOutputs FilePath
name Severity
minSev =
                    [ FilePath -> Severity -> LogOutput
LogToFile (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
name) (Severity -> Severity -> Severity
forall a. Ord a => a -> a -> a
min Severity
minSev Severity
Info)
                    , Severity -> LogOutput
LogToStdStreams Severity
minSev ]

            LogOutputs
lops <-
                [LogOutput] -> [LogOutput] -> LogOutputs
LogOutputs
                    ([LogOutput] -> [LogOutput] -> LogOutputs)
-> IO [LogOutput] -> IO ([LogOutput] -> LogOutputs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> Severity -> [LogOutput]
logOutputs FilePath
"cluster.log" (Severity -> [LogOutput]) -> IO Severity -> IO [LogOutput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Severity
testMinSeverityFromEnv)
                    IO ([LogOutput] -> LogOutputs) -> IO [LogOutput] -> IO LogOutputs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FilePath -> Severity -> [LogOutput]
logOutputs FilePath
"wallet.log" (Severity -> [LogOutput]) -> IO Severity -> IO [LogOutput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Severity
walletMinSeverityFromEnv)

            FilePath -> LogOutputs -> IO a
action FilePath
dir LogOutputs
lops

runWith :: forall a.
    ( Show a
    , Ord a
    , FromJSON a
    , ToJSON a
    , Pretty a
    , Servant.MimeUnrender Servant.JSON a
    , HasDefinitions a
    , OpenApi.ToSchema a
    )
    => BuiltinHandler a
    -> IO ()
runWith :: BuiltinHandler a -> IO ()
runWith BuiltinHandler a
userContractHandler = (FilePath -> LogOutputs -> IO ()) -> IO ()
forall a. (FilePath -> LogOutputs -> IO a) -> IO a
withLocalClusterSetup ((FilePath -> LogOutputs -> IO ()) -> IO ())
-> (FilePath -> LogOutputs -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
dir lo :: LogOutputs
lo@LogOutputs{[LogOutput]
loCluster :: [LogOutput]
loCluster :: LogOutputs -> [LogOutput]
loCluster} ->
    LoggerName
-> [LogOutput]
-> ((Switchboard LoggerName, (Configuration, Trace IO LoggerName))
    -> IO ())
-> IO ()
forall a.
LoggerName
-> [LogOutput]
-> ((Switchboard LoggerName, (Configuration, Trace IO LoggerName))
    -> IO a)
-> IO a
withLoggingNamed LoggerName
"cluster" [LogOutput]
loCluster (((Switchboard LoggerName, (Configuration, Trace IO LoggerName))
  -> IO ())
 -> IO ())
-> ((Switchboard LoggerName, (Configuration, Trace IO LoggerName))
    -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(Switchboard LoggerName
_, (Configuration
_, Trace IO LoggerName
trCluster)) -> do
        let tr' :: Tracer IO ClusterLog
tr' = (ClusterLog -> TestsLog)
-> Tracer IO TestsLog -> Tracer IO ClusterLog
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ClusterLog -> TestsLog
MsgCluster (Tracer IO TestsLog -> Tracer IO ClusterLog)
-> Tracer IO TestsLog -> Tracer IO ClusterLog
forall a b. (a -> b) -> a -> b
$ Trace IO LoggerName -> Tracer IO TestsLog
forall (m :: * -> *) a.
(MonadIO m, ToText a, HasPrivacyAnnotation a,
 HasSeverityAnnotation a) =>
Tracer m (LoggerName, LogObject LoggerName) -> Tracer m a
trMessageText Trace IO LoggerName
trCluster
        LocalClusterConfig
clusterCfg <- IO LocalClusterConfig
localClusterConfigFromEnv
        let initialFunds :: [(Address, Coin)]
initialFunds = [(Address, Coin)]
shelleyIntegrationTestFunds
        Tracer IO ClusterLog
-> FilePath
-> LocalClusterConfig
-> [(Address, Coin)]
-> (RunningNode -> IO ())
-> IO ()
forall a.
Tracer IO ClusterLog
-> FilePath
-> LocalClusterConfig
-> [(Address, Coin)]
-> (RunningNode -> IO a)
-> IO a
withCluster Tracer IO ClusterLog
tr' FilePath
dir LocalClusterConfig
clusterCfg [(Address, Coin)]
initialFunds
            (FilePath
-> Tracer IO TestsLog -> LogOutputs -> RunningNode -> IO ()
whenReady FilePath
dir (Trace IO LoggerName -> Tracer IO TestsLog
forall (m :: * -> *) a.
(MonadIO m, ToText a, HasPrivacyAnnotation a,
 HasSeverityAnnotation a) =>
Tracer m (LoggerName, LogObject LoggerName) -> Tracer m a
trMessageText Trace IO LoggerName
trCluster) LogOutputs
lo)
  where
    setupFaucet :: FilePath -> Tracer IO TestsLog -> RunningNode -> IO ()
setupFaucet FilePath
dir Tracer IO TestsLog
trCluster (RunningNode CardanoNodeConn
socketPath Block
_ (NetworkParameters, NodeToClientVersionData)
_ [PoolCertificate]
_) = do
        Tracer IO TestsLog -> TestsLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO TestsLog
trCluster TestsLog
MsgSettingUpFaucet
        let trCluster' :: Tracer IO ClusterLog
trCluster' = (ClusterLog -> TestsLog)
-> Tracer IO TestsLog -> Tracer IO ClusterLog
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ClusterLog -> TestsLog
MsgCluster Tracer IO TestsLog
trCluster
        let encodeAddresses :: [(Address, d)] -> [(FilePath, d)]
encodeAddresses = ((Address, d) -> (FilePath, d))
-> [(Address, d)] -> [(FilePath, d)]
forall a b. (a -> b) -> [a] -> [b]
map ((Address -> FilePath) -> (Address, d) -> (FilePath, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (LoggerName -> FilePath
T.unpack (LoggerName -> FilePath)
-> (Address -> LoggerName) -> Address -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodeAddress 'Mainnet => Address -> LoggerName
forall (n :: NetworkDiscriminant).
EncodeAddress n =>
Address -> LoggerName
encodeAddress @'Mainnet))
        let accts :: [Credential]
accts = XPub -> Credential
KeyCredential (XPub -> Credential) -> [XPub] -> [Credential]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Mnemonic 24 -> [XPub]) -> [Mnemonic 24] -> [XPub]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Mnemonic 24 -> [XPub]
genRewardAccounts [Mnemonic 24]
mirMnemonics
        let rewards :: [(Credential, Coin)]
rewards = (, Natural -> Coin
Coin (Natural -> Coin) -> Natural -> Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
oneMillionAda) (Credential -> (Credential, Coin))
-> [Credential] -> [(Credential, Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Credential]
accts

        Tracer IO ClusterLog
-> CardanoNodeConn
-> FilePath
-> Int
-> [(FilePath, (TokenBundle, [(FilePath, FilePath)]))]
-> IO ()
sendFaucetAssetsTo Tracer IO ClusterLog
trCluster' CardanoNodeConn
socketPath FilePath
dir Int
20 ([(FilePath, (TokenBundle, [(FilePath, FilePath)]))] -> IO ())
-> [(FilePath, (TokenBundle, [(FilePath, FilePath)]))] -> IO ()
forall a b. (a -> b) -> a -> b
$ [(Address, (TokenBundle, [(FilePath, FilePath)]))]
-> [(FilePath, (TokenBundle, [(FilePath, FilePath)]))]
forall d. [(Address, d)] -> [(FilePath, d)]
encodeAddresses ([(Address, (TokenBundle, [(FilePath, FilePath)]))]
 -> [(FilePath, (TokenBundle, [(FilePath, FilePath)]))])
-> [(Address, (TokenBundle, [(FilePath, FilePath)]))]
-> [(FilePath, (TokenBundle, [(FilePath, FilePath)]))]
forall a b. (a -> b) -> a -> b
$
            Coin -> [(Address, (TokenBundle, [(FilePath, FilePath)]))]
maryIntegrationTestAssets (Natural -> Coin
Coin Natural
1_000_000_000)
        Tracer IO ClusterLog
-> CardanoNodeConn -> FilePath -> [(Credential, Coin)] -> IO ()
moveInstantaneousRewardsTo Tracer IO ClusterLog
trCluster' CardanoNodeConn
socketPath FilePath
dir [(Credential, Coin)]
rewards

    whenReady :: FilePath
-> Tracer IO TestsLog -> LogOutputs -> RunningNode -> IO ()
whenReady FilePath
dir Tracer IO TestsLog
trCluster LogOutputs{[LogOutput]
loWallet :: [LogOutput]
loWallet :: LogOutputs -> [LogOutput]
loWallet} rn :: RunningNode
rn@(RunningNode CardanoNodeConn
socketPath Block
block0 (NetworkParameters
gp, NodeToClientVersionData
vData) [PoolCertificate]
poolCertificates) = do
        LoggerName
-> [LogOutput]
-> ((Switchboard LoggerName, (Configuration, Trace IO LoggerName))
    -> IO ())
-> IO ()
forall a.
LoggerName
-> [LogOutput]
-> ((Switchboard LoggerName, (Configuration, Trace IO LoggerName))
    -> IO a)
-> IO a
withLoggingNamed LoggerName
"cardano-wallet" [LogOutput]
loWallet (((Switchboard LoggerName, (Configuration, Trace IO LoggerName))
  -> IO ())
 -> IO ())
-> ((Switchboard LoggerName, (Configuration, Trace IO LoggerName))
    -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(Switchboard LoggerName
sb, (Configuration
cfg, Trace IO LoggerName
tr)) -> do
            FilePath -> Tracer IO TestsLog -> RunningNode -> IO ()
setupFaucet FilePath
dir Tracer IO TestsLog
trCluster RunningNode
rn
            let walletHost :: FilePath
walletHost = FilePath
"127.0.0.1"
                walletPort :: Int
walletPort = Int
46493

            BuiltinHandler a
-> FilePath -> Int -> FilePath -> RunningNode -> IO ()
forall a.
(Show a, Ord a, FromJSON a, ToJSON a, Pretty a,
 MimeUnrender JSON a, HasDefinitions a, ToSchema a) =>
BuiltinHandler a
-> FilePath -> Int -> FilePath -> RunningNode -> IO ()
setupPABServices BuiltinHandler a
userContractHandler FilePath
walletHost Int
walletPort FilePath
dir RunningNode
rn

            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 (Configuration
-> Trace IO LoggerName
-> Switchboard LoggerName
-> IO (Plugin LoggerName)
forall (s :: * -> *) a.
(IsEffectuator s a, ToJSON a, FromJSON a) =>
Configuration -> Trace IO a -> s a -> IO (Plugin a)
EKG.plugin Configuration
cfg Trace IO LoggerName
tr Switchboard LoggerName
sb IO (Plugin LoggerName) -> (Plugin LoggerName -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Switchboard LoggerName -> Plugin LoggerName -> IO ()
forall a. Switchboard a -> Plugin a -> IO ()
loadPlugin Switchboard LoggerName
sb)

            let tracers :: Tracers IO
tracers = TracerSeverities -> Trace IO LoggerName -> Tracers IO
setupTracers (Maybe Severity -> TracerSeverities
tracerSeverities (Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
Debug)) Trace IO LoggerName
tr
            let db :: FilePath
db = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"wallets"
            FilePath -> IO ()
createDirectory FilePath
db
            Maybe TokenMetadataServer
tokenMetadataServer <- IO (Maybe TokenMetadataServer)
tokenMetadataServerFromEnv

            LoggerName
prometheusUrl <- LoggerName
-> ((FilePath, Port "Prometheus") -> LoggerName)
-> Maybe (FilePath, Port "Prometheus")
-> LoggerName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LoggerName
"none"
                    (\(FilePath
h, Port "Prometheus"
p) -> FilePath -> LoggerName
T.pack FilePath
h LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
":" LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> Port "Prometheus" -> LoggerName
forall a. ToText a => a -> LoggerName
toText @(Port "Prometheus") Port "Prometheus"
p)
                (Maybe (FilePath, Port "Prometheus") -> LoggerName)
-> IO (Maybe (FilePath, Port "Prometheus")) -> IO LoggerName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (FilePath, Port "Prometheus"))
getPrometheusURL
            LoggerName
ekgUrl <- LoggerName
-> ((FilePath, Port "EKG") -> LoggerName)
-> Maybe (FilePath, Port "EKG")
-> LoggerName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LoggerName
"none"
                    (\(FilePath
h, Port "EKG"
p) -> FilePath -> LoggerName
T.pack FilePath
h LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> LoggerName
":" LoggerName -> LoggerName -> LoggerName
forall a. Semigroup a => a -> a -> a
<> Port "EKG" -> LoggerName
forall a. ToText a => a -> LoggerName
toText @(Port "EKG") Port "EKG"
p)
                (Maybe (FilePath, Port "EKG") -> LoggerName)
-> IO (Maybe (FilePath, Port "EKG")) -> IO LoggerName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (FilePath, Port "EKG"))
getEKGURL

            IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ BlockchainSource
-> NetworkParameters
-> PipeliningStrategy (CardanoBlock StandardCrypto)
-> SomeNetworkDiscriminant
-> [PoolCertificate]
-> Tracers IO
-> Maybe FilePath
-> Maybe (DBDecorator IO)
-> HostPreference
-> Listen
-> Maybe TlsConfiguration
-> Maybe Settings
-> Maybe TokenMetadataServer
-> Block
-> (URI -> IO ())
-> IO ExitCode
serveWallet
                (CardanoNodeConn
-> NodeToClientVersionData -> SyncTolerance -> BlockchainSource
NodeSource CardanoNodeConn
socketPath NodeToClientVersionData
vData (NominalDiffTime -> SyncTolerance
SyncTolerance NominalDiffTime
10))
                NetworkParameters
gp
                PipeliningStrategy (CardanoBlock StandardCrypto)
forall block. HasHeader block => PipeliningStrategy block
tunedForMainnetPipeliningStrategy
                (Proxy 'Mainnet -> SomeNetworkDiscriminant
forall (n :: NetworkDiscriminant).
(NetworkDiscriminantVal n, PaymentAddress n IcarusKey,
 PaymentAddress n ByronKey, PaymentAddress n ShelleyKey,
 DelegationAddress n ShelleyKey, HasNetworkId n, DecodeAddress n,
 EncodeAddress n, DecodeStakeAddress n, EncodeStakeAddress n,
 Typeable n) =>
Proxy n -> SomeNetworkDiscriminant
SomeNetworkDiscriminant (Proxy 'Mainnet -> SomeNetworkDiscriminant)
-> Proxy 'Mainnet -> SomeNetworkDiscriminant
forall a b. (a -> b) -> a -> b
$ Proxy 'Mainnet
forall k (t :: k). Proxy t
Proxy @'Mainnet)
                [PoolCertificate]
poolCertificates
                Tracers IO
tracers
                (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
db)
                Maybe (DBDecorator IO)
forall a. Maybe a
Nothing
                (FilePath -> HostPreference
forall a. IsString a => FilePath -> a
fromString FilePath
walletHost)
                (Int -> Listen
ListenOnPort Int
walletPort)
                Maybe TlsConfiguration
forall a. Maybe a
Nothing
                Maybe Settings
forall a. Maybe a
Nothing
                Maybe TokenMetadataServer
tokenMetadataServer
                Block
block0
                (\URI
u -> Tracer IO TestsLog -> TestsLog -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO TestsLog
trCluster (TestsLog -> IO ()) -> TestsLog -> IO ()
forall a b. (a -> b) -> a -> b
$ LoggerName -> LoggerName -> LoggerName -> TestsLog
MsgBaseUrl (FilePath -> LoggerName
T.pack (FilePath -> LoggerName) -> (URI -> FilePath) -> URI -> LoggerName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> FilePath
forall a. Show a => a -> FilePath
show (URI -> LoggerName) -> URI -> LoggerName
forall a b. (a -> b) -> a -> b
$ URI
u)
                    LoggerName
ekgUrl LoggerName
prometheusUrl)

newtype ChainIndexPort = ChainIndexPort Int

setupPABServices
    :: forall a.
    ( Show a
    , Ord a
    , FromJSON a
    , ToJSON a
    , Pretty a
    , Servant.MimeUnrender Servant.JSON a
    , HasDefinitions a
    , OpenApi.ToSchema a
    )
    => BuiltinHandler a -> String -> Int -> FilePath -> RunningNode -> IO ()
setupPABServices :: BuiltinHandler a
-> FilePath -> Int -> FilePath -> RunningNode -> IO ()
setupPABServices BuiltinHandler a
userContractHandler FilePath
walletHost Int
walletPort FilePath
dir RunningNode
rn = IO (Async ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Async ()) -> IO ()) -> IO (Async ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ do -- TODO: better types for arguments
    BaseUrl
walletUrl <- FilePath -> Int -> IO BaseUrl
restoreWallets FilePath
walletHost Int
walletPort
    ChainIndexPort
chainIndexPort <- FilePath -> RunningNode -> IO ChainIndexPort
launchChainIndex FilePath
dir RunningNode
rn
    BuiltinHandler a
-> LoggerName
-> FilePath
-> BaseUrl
-> RunningNode
-> ChainIndexPort
-> IO ()
forall a.
(Show a, Ord a, FromJSON a, ToJSON a, Pretty a,
 MimeUnrender JSON a, HasDefinitions a, ToSchema a) =>
BuiltinHandler a
-> LoggerName
-> FilePath
-> BaseUrl
-> RunningNode
-> ChainIndexPort
-> IO ()
launchPAB BuiltinHandler a
userContractHandler LoggerName
fixturePassphrase FilePath
dir BaseUrl
walletUrl RunningNode
rn ChainIndexPort
chainIndexPort

{-| Launch the chain index in a separate thread.
-}
launchChainIndex :: FilePath -> RunningNode -> IO ChainIndexPort
launchChainIndex :: FilePath -> RunningNode -> IO ChainIndexPort
launchChainIndex FilePath
dir (RunningNode CardanoNodeConn
socketPath Block
_block0 (NetworkParameters
_gp, NodeToClientVersionData
_vData) [PoolCertificate]
_) = do
    Configuration
config <- IO Configuration
ChainIndex.Logging.defaultConfig
    let dbPath :: FilePath
dbPath = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"chain-index.db"
        chainIndexConfig :: ChainIndexConfig
chainIndexConfig = ChainIndexConfig
CI.defaultConfig
                    ChainIndexConfig
-> (ChainIndexConfig -> ChainIndexConfig) -> ChainIndexConfig
forall a b. a -> (a -> b) -> b
& (FilePath -> Identity FilePath)
-> ChainIndexConfig -> Identity ChainIndexConfig
Lens' ChainIndexConfig FilePath
CI.socketPath ((FilePath -> Identity FilePath)
 -> ChainIndexConfig -> Identity ChainIndexConfig)
-> FilePath -> ChainIndexConfig -> ChainIndexConfig
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CardanoNodeConn -> FilePath
nodeSocketFile CardanoNodeConn
socketPath
                    ChainIndexConfig
-> (ChainIndexConfig -> ChainIndexConfig) -> ChainIndexConfig
forall a b. a -> (a -> b) -> b
& (FilePath -> Identity FilePath)
-> ChainIndexConfig -> Identity ChainIndexConfig
Lens' ChainIndexConfig FilePath
CI.dbPath ((FilePath -> Identity FilePath)
 -> ChainIndexConfig -> Identity ChainIndexConfig)
-> FilePath -> ChainIndexConfig -> ChainIndexConfig
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath
dbPath
                    ChainIndexConfig
-> (ChainIndexConfig -> ChainIndexConfig) -> ChainIndexConfig
forall a b. a -> (a -> b) -> b
& (NetworkId -> Identity NetworkId)
-> ChainIndexConfig -> Identity ChainIndexConfig
Lens' ChainIndexConfig NetworkId
CI.networkId ((NetworkId -> Identity NetworkId)
 -> ChainIndexConfig -> Identity ChainIndexConfig)
-> NetworkId -> ChainIndexConfig -> ChainIndexConfig
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NetworkId
CAPI.Mainnet
    IO (Async ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Async ()) -> IO ())
-> (IO () -> IO (Async ())) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Configuration -> ChainIndexConfig -> IO ()
ChainIndex.runMain Configuration
config ChainIndexConfig
chainIndexConfig
    ChainIndexPort -> IO ChainIndexPort
forall (m :: * -> *) a. Monad m => a -> m a
return (ChainIndexPort -> IO ChainIndexPort)
-> ChainIndexPort -> IO ChainIndexPort
forall a b. (a -> b) -> a -> b
$ Int -> ChainIndexPort
ChainIndexPort (Int -> ChainIndexPort) -> Int -> ChainIndexPort
forall a b. (a -> b) -> a -> b
$ ChainIndexConfig
chainIndexConfig ChainIndexConfig -> Getting Int ChainIndexConfig Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int ChainIndexConfig Int
Lens' ChainIndexConfig Int
CI.port

{-| Launch the PAB in a separate thread.
-}
launchPAB
    :: forall a.
    ( Show a
    , Ord a
    , FromJSON a
    , ToJSON a
    , Pretty a
    , Servant.MimeUnrender Servant.JSON a
    , HasDefinitions a
    , OpenApi.ToSchema a
    )
    => BuiltinHandler a
    -> Text -- ^ Passphrase
    -> FilePath -- ^ Temp directory
    -> BaseUrl -- ^ wallet url
    -> RunningNode -- ^ Socket path
    -> ChainIndexPort -- ^ Port of the chain index
    -> IO ()
launchPAB :: BuiltinHandler a
-> LoggerName
-> FilePath
-> BaseUrl
-> RunningNode
-> ChainIndexPort
-> IO ()
launchPAB BuiltinHandler a
userContractHandler
    LoggerName
passPhrase
    FilePath
dir
    BaseUrl
walletUrl
    (RunningNode CardanoNodeConn
socketPath Block
_block0 (NetworkParameters
networkParameters, NodeToClientVersionData
_) [PoolCertificate]
_)
    (ChainIndexPort Int
chainIndexPort) = do

    let opts :: AppOpts
opts = AppOpts :: Maybe Severity
-> Maybe FilePath
-> Maybe FilePath
-> Maybe LoggerName
-> Maybe Int
-> Point
-> Bool
-> StorageBackend
-> ConfigCommand
-> AppOpts
AppOpts { minLogLevel :: Maybe Severity
minLogLevel = Maybe Severity
forall a. Maybe a
Nothing
                       , logConfigPath :: Maybe FilePath
logConfigPath = Maybe FilePath
forall a. Maybe a
Nothing
                       , configPath :: Maybe FilePath
configPath = Maybe FilePath
forall a. Maybe a
Nothing
                       , rollbackHistory :: Maybe Int
rollbackHistory = Maybe Int
forall a. Maybe a
Nothing
                       , resumeFrom :: Point
resumeFrom = Point
PointAtGenesis
                       , runEkgServer :: Bool
runEkgServer = Bool
False
                       , storageBackend :: StorageBackend
storageBackend = StorageBackend
BeamBackend
                       , cmd :: ConfigCommand
cmd = ConfigCommand
PABWebserver
                       , passphrase :: Maybe LoggerName
PAB.Command.passphrase = LoggerName -> Maybe LoggerName
forall a. a -> Maybe a
Just LoggerName
passPhrase
                       }
        networkID :: NetworkIdWrapper
networkID = NetworkId -> NetworkIdWrapper
NetworkIdWrapper NetworkId
CAPI.Mainnet
        -- TODO: Remove when PAB queries local node for slot config
        slotConfig :: SlotConfig
slotConfig = NetworkParameters -> SlotConfig
slotConfigOfNetworkParameters NetworkParameters
networkParameters
        -- TODO: Remove when PAB queries local node for security param
        securityParam :: Integer
securityParam = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                      (Word32 -> Integer) -> Word32 -> Integer
forall a b. (a -> b) -> a -> b
$ Quantity "block" Word32 -> Word32
forall (unit :: Symbol) a. Quantity unit a -> a
getQuantity
                      (Quantity "block" Word32 -> Word32)
-> Quantity "block" Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ SlottingParameters -> Quantity "block" Word32
getSecurityParameter
                      (SlottingParameters -> Quantity "block" Word32)
-> SlottingParameters -> Quantity "block" Word32
forall a b. (a -> b) -> a -> b
$ NetworkParameters -> SlottingParameters
slottingParameters NetworkParameters
networkParameters
        config :: Config
config =
            Config
PAB.Config.defaultConfig
                { nodeServerConfig :: PABServerConfig
nodeServerConfig = PABServerConfig
forall a. Default a => a
def
                    { pscSocketPath :: FilePath
pscSocketPath = CardanoNodeConn -> FilePath
nodeSocketFile CardanoNodeConn
socketPath
                    , pscNodeMode :: NodeMode
pscNodeMode = NodeMode
AlonzoNode
                    , pscNetworkId :: NetworkIdWrapper
pscNetworkId = NetworkIdWrapper
networkID
                    , pscSlotConfig :: SlotConfig
pscSlotConfig = SlotConfig
slotConfig
                    , pscKeptBlocks :: Integer
pscKeptBlocks = Integer
securityParam
                    }
                , dbConfig :: DbConfig
dbConfig = DbConfig -> DbConfig
SqliteDB DbConfig
forall a. Default a => a
def{ dbConfigFile :: LoggerName
dbConfigFile = FilePath -> LoggerName
T.pack (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"plutus-pab.db") }
                , chainQueryConfig :: ChainQueryConfig
chainQueryConfig = ChainIndexConfig -> ChainQueryConfig
ChainIndexConfig ChainIndexConfig
forall a. Default a => a
def{ciBaseUrl :: ChainIndexUrl
PAB.CI.ciBaseUrl = BaseUrl -> ChainIndexUrl
PAB.CI.ChainIndexUrl (BaseUrl -> ChainIndexUrl) -> BaseUrl -> ChainIndexUrl
forall a b. (a -> b) -> a -> b
$ Scheme -> FilePath -> Int -> FilePath -> BaseUrl
BaseUrl Scheme
Http FilePath
"localhost" Int
chainIndexPort FilePath
""}
                , walletServerConfig :: WalletConfig
walletServerConfig = ASetter WalletConfig WalletConfig WalletUrl WalletUrl
-> WalletUrl -> WalletConfig -> WalletConfig
forall s t a b. ASetter s t a b -> b -> s -> t
set ((LocalWalletSettings -> Identity LocalWalletSettings)
-> WalletConfig -> Identity WalletConfig
Traversal' WalletConfig LocalWalletSettings
Wallet.Config.walletSettingsL ((LocalWalletSettings -> Identity LocalWalletSettings)
 -> WalletConfig -> Identity WalletConfig)
-> ((WalletUrl -> Identity WalletUrl)
    -> LocalWalletSettings -> Identity LocalWalletSettings)
-> ASetter WalletConfig WalletConfig WalletUrl WalletUrl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WalletUrl -> Identity WalletUrl)
-> LocalWalletSettings -> Identity LocalWalletSettings
Lens' LocalWalletSettings WalletUrl
Wallet.Config.baseUrlL) (BaseUrl -> WalletUrl
WalletUrl BaseUrl
walletUrl) WalletConfig
forall a. Default a => a
def
                }
    BuiltinHandler a -> Maybe Config -> AppOpts -> IO ()
forall a.
(Show a, Ord a, FromJSON a, ToJSON a, Pretty a,
 MimeUnrender JSON a, HasDefinitions a, ToSchema a) =>
BuiltinHandler a -> Maybe Config -> AppOpts -> IO ()
PAB.Run.runWithOpts BuiltinHandler a
userContractHandler (Config -> Maybe Config
forall a. a -> Maybe a
Just Config
config) AppOpts
opts { cmd :: ConfigCommand
cmd = ConfigCommand
Migrate }
    BuiltinHandler a -> Maybe Config -> AppOpts -> IO ()
forall a.
(Show a, Ord a, FromJSON a, ToJSON a, Pretty a,
 MimeUnrender JSON a, HasDefinitions a, ToSchema a) =>
BuiltinHandler a -> Maybe Config -> AppOpts -> IO ()
PAB.Run.runWithOpts BuiltinHandler a
userContractHandler (Config -> Maybe Config
forall a. a -> Maybe a
Just Config
config) AppOpts
opts { cmd :: ConfigCommand
cmd = ConfigCommand
PABWebserver }

slotConfigOfNetworkParameters :: NetworkParameters -> SlotConfig
slotConfigOfNetworkParameters :: NetworkParameters -> SlotConfig
slotConfigOfNetworkParameters
    (NetworkParameters
        (GenesisParameters Hash "Genesis"
_ (StartTime UTCTime
startUtcTime))
        (SlottingParameters (SlotLength NominalDiffTime
nominalDiffTime) EpochLength
_ ActiveSlotCoefficient
_ Quantity "block" Word32
_) ProtocolParameters
_) =
    Integer -> POSIXTime -> SlotConfig
SlotConfig (Pico -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Pico -> Integer) -> Pico -> Integer
forall a b. (a -> b) -> a -> b
$ Pico
1000 Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
* NominalDiffTime -> Pico
nominalDiffTimeToSeconds NominalDiffTime
nominalDiffTime) (UTCTime -> POSIXTime
TimeSlot.utcTimeToPOSIXTime UTCTime
startUtcTime)

{-| Set up wallets
-}
restoreWallets :: String -> Int -> IO BaseUrl
restoreWallets :: FilePath -> Int -> IO BaseUrl
restoreWallets FilePath
walletHost Int
walletPort = do
    Int -> IO ()
sleep Int
15
    Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings
    let baseUrl :: BaseUrl
baseUrl = BaseUrl :: Scheme -> FilePath -> Int -> FilePath -> BaseUrl
BaseUrl{baseUrlScheme :: Scheme
baseUrlScheme=Scheme
Http,baseUrlHost :: FilePath
baseUrlHost=FilePath
walletHost,baseUrlPort :: Int
baseUrlPort=Int
walletPort,baseUrlPath :: FilePath
baseUrlPath=FilePath
""}
        clientEnv :: ClientEnv
clientEnv = Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
manager BaseUrl
baseUrl
        ApiMnemonicT '[15, 18, 21, 24]
mnemonic :: ApiMnemonicT '[15, 18, 21, 24] = SomeMnemonic -> ApiMnemonicT '[15, 18, 21, 24]
forall (sizes :: [Nat]). SomeMnemonic -> ApiMnemonicT sizes
ApiMnemonicT (SomeMnemonic -> ApiMnemonicT '[15, 18, 21, 24])
-> SomeMnemonic -> ApiMnemonicT '[15, 18, 21, 24]
forall a b. (a -> b) -> a -> b
$ Mnemonic 15 -> SomeMnemonic
forall (mw :: Nat). KnownNat mw => Mnemonic mw -> SomeMnemonic
SomeMnemonic (Mnemonic 15 -> SomeMnemonic) -> Mnemonic 15 -> SomeMnemonic
forall a b. (a -> b) -> a -> b
$ [Mnemonic 15] -> Mnemonic 15
forall a. [a] -> a
head [Mnemonic 15]
Faucet.seqMnemonics
        wpData :: WalletPostData
wpData    = Maybe (ApiT AddressPoolGap)
-> ApiMnemonicT (AllowedMnemonics 'Shelley)
-> Maybe (ApiMnemonicT (AllowedMnemonics 'SndFactor))
-> ApiT WalletName
-> ApiT (Passphrase "user")
-> WalletPostData
Wallet.Types.WalletPostData
                        Maybe (ApiT AddressPoolGap)
forall a. Maybe a
Nothing
                        ApiMnemonicT '[15, 18, 21, 24]
ApiMnemonicT (AllowedMnemonics 'Shelley)
mnemonic
                        Maybe (ApiMnemonicT (AllowedMnemonics 'SndFactor))
forall a. Maybe a
Nothing
                        (WalletName -> ApiT WalletName
forall a. a -> ApiT a
ApiT (WalletName -> ApiT WalletName) -> WalletName -> ApiT WalletName
forall a b. (a -> b) -> a -> b
$ LoggerName -> WalletName
WalletName LoggerName
"plutus-wallet")
                        (Passphrase "user" -> ApiT (Passphrase "user")
forall a. a -> ApiT a
ApiT (Passphrase "user" -> ApiT (Passphrase "user"))
-> Passphrase "user" -> ApiT (Passphrase "user")
forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> Passphrase "user"
forall (purpose :: Symbol). ScrubbedBytes -> Passphrase purpose
Passphrase (ScrubbedBytes -> Passphrase "user")
-> ScrubbedBytes -> Passphrase "user"
forall a b. (a -> b) -> a -> b
$ FilePath -> ScrubbedBytes
forall a. IsString a => FilePath -> a
fromString (FilePath -> ScrubbedBytes) -> FilePath -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ LoggerName -> FilePath
T.unpack LoggerName
fixturePassphrase)
        walletAcc :: WalletOrAccountPostData
walletAcc = WalletOrAccountPostData :: Either WalletPostData AccountPostData -> WalletOrAccountPostData
WalletOrAccountPostData{$sel:postData:WalletOrAccountPostData :: Either WalletPostData AccountPostData
postData=WalletPostData -> Either WalletPostData AccountPostData
forall a b. a -> Either a b
Left WalletPostData
wpData}
    Either ClientError ApiWallet
result <- (ClientM ApiWallet
 -> ClientEnv -> IO (Either ClientError ApiWallet))
-> ClientEnv
-> ClientM ApiWallet
-> IO (Either ClientError ApiWallet)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ClientM ApiWallet -> ClientEnv -> IO (Either ClientError ApiWallet)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientEnv
clientEnv (ClientM ApiWallet -> IO (Either ClientError ApiWallet))
-> ClientM ApiWallet -> IO (Either ClientError ApiWallet)
forall a b. (a -> b) -> a -> b
$ WalletClient ApiWallet -> PostData ApiWallet -> ClientM ApiWallet
forall wallet.
WalletClient wallet -> PostData wallet -> ClientM wallet
WalletClient.postWallet WalletClient ApiWallet
WalletClient.walletClient PostData ApiWallet
WalletOrAccountPostData
walletAcc
    case Either ClientError ApiWallet
result of
        Left ClientError
err -> do
            FilePath -> IO ()
putStrLn FilePath
"restoreWallet failed"
            FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Error: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ClientError -> FilePath
forall a. Show a => a -> FilePath
show ClientError
err
            FilePath -> IO ()
putStrLn FilePath
"restoreWallet: trying again in 30s"
            Int -> IO ()
sleep Int
15
            FilePath -> Int -> IO BaseUrl
restoreWallets FilePath
walletHost Int
walletPort
        Right (ApiWallet (ApiT WalletId
i) ApiT AddressPoolGap
_ ApiWalletBalance
_ ApiWalletAssetsBalance
_ ApiWalletDelegation
_ ApiT WalletName
_ Maybe ApiWalletPassphraseInfo
_ ApiT SyncProgress
_ ApiBlockReference
_) -> do
            FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Restored wallet: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> WalletId -> FilePath
forall a. Show a => a -> FilePath
show WalletId
i
            FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Passphrase: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> LoggerName -> FilePath
T.unpack LoggerName
fixturePassphrase
            BaseUrl -> IO BaseUrl
forall (m :: * -> *) a. Monad m => a -> m a
return BaseUrl
baseUrl

sleep :: Int -> IO ()
sleep :: Int -> IO ()
sleep Int
n = Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1_000_000


-- Logging

data TestsLog
    = MsgBaseUrl Text Text Text -- wallet url, ekg url, prometheus url
    | MsgSettingUpFaucet
    | MsgCluster ClusterLog
    deriving (Int -> TestsLog -> FilePath -> FilePath
[TestsLog] -> FilePath -> FilePath
TestsLog -> FilePath
(Int -> TestsLog -> FilePath -> FilePath)
-> (TestsLog -> FilePath)
-> ([TestsLog] -> FilePath -> FilePath)
-> Show TestsLog
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [TestsLog] -> FilePath -> FilePath
$cshowList :: [TestsLog] -> FilePath -> FilePath
show :: TestsLog -> FilePath
$cshow :: TestsLog -> FilePath
showsPrec :: Int -> TestsLog -> FilePath -> FilePath
$cshowsPrec :: Int -> TestsLog -> FilePath -> FilePath
Show)

instance ToText TestsLog where
    toText :: TestsLog -> LoggerName
toText = \case
        MsgBaseUrl LoggerName
walletUrl LoggerName
ekgUrl LoggerName
prometheusUrl -> [LoggerName] -> LoggerName
forall a. Monoid a => [a] -> a
mconcat
            [ LoggerName
"Wallet url: " , LoggerName
walletUrl
            , LoggerName
", EKG url: " , LoggerName
ekgUrl
            , LoggerName
", Prometheus url:", LoggerName
prometheusUrl
            ]
        TestsLog
MsgSettingUpFaucet -> LoggerName
"Setting up faucet..."
        MsgCluster ClusterLog
msg -> ClusterLog -> LoggerName
forall a. ToText a => a -> LoggerName
toText ClusterLog
msg

instance HasPrivacyAnnotation TestsLog
instance HasSeverityAnnotation TestsLog where
    getSeverityAnnotation :: TestsLog -> Severity
getSeverityAnnotation = \case
        TestsLog
MsgSettingUpFaucet -> Severity
Notice
        MsgBaseUrl {}      -> Severity
Notice
        MsgCluster ClusterLog
msg     -> ClusterLog -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation ClusterLog
msg