{-# LANGUAGE ApplicativeDo         #-}
{-# LANGUAGE BlockArguments        #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DerivingVia           #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StrictData            #-}
{-# LANGUAGE TypeApplications      #-}

module Plutus.PAB.Run.Cli (ConfigCommandArgs(..), runConfigCommand) where

-----------------------------------------------------------------------------------------------------------------------
-- Command interpretation
-----------------------------------------------------------------------------------------------------------------------

import Cardano.Api qualified as C
import Cardano.Api.NetworkId.Extra (NetworkIdWrapper (..))
import Cardano.BM.Configuration (Configuration)
import Cardano.BM.Data.Trace (Trace)
import Cardano.ChainIndex.Server qualified as ChainIndex
import Cardano.Node.Params qualified as Params
import Cardano.Node.Server qualified as NodeServer
import Cardano.Node.Types (NodeMode (MockNode), PABServerConfig (pscNetworkId, pscNodeMode, pscSocketPath), _AlonzoNode)
import Cardano.Protocol.Socket.Type (epochSlots)
import Cardano.Wallet.Mock.Server qualified as WalletServer
import Cardano.Wallet.Mock.Types (WalletMsg)
import Cardano.Wallet.Types (WalletConfig (LocalWalletConfig, RemoteWalletConfig))
import Control.Concurrent (takeMVar, threadDelay)
import Control.Concurrent.Async (Async, async, waitAny)
import Control.Concurrent.Availability (Availability, available, starting)
import Control.Concurrent.STM qualified as STM
import Control.Lens (preview)
import Control.Monad (forM, forM_, forever, void, when)
import Control.Monad.Freer (Eff, LastMember, Member, interpret, runM)
import Control.Monad.Freer.Delay (DelayEffect, delayThread, handleDelayEffect)
import Control.Monad.Freer.Error (throwError)
import Control.Monad.Freer.Extras.Log (logInfo)
import Control.Monad.Freer.Reader (ask, runReader)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (logErrorN, runStdoutLoggingT)
import Data.Aeson (FromJSON, ToJSON)
import Data.Foldable (traverse_)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe, isJust)
import Data.OpenApi.Schema qualified as OpenApi
import Data.Proxy (Proxy (Proxy))
import Data.Set qualified as Set
import Data.Text.Extras (tshow)
import Data.Time.Units (Second)
import Plutus.Contract.Resumable (responses)
import Plutus.Contract.State (State (State, record))
import Plutus.Contract.State qualified as State
import Plutus.PAB.App (StorageBackend (..))
import Plutus.PAB.App qualified as App
import Plutus.PAB.Core qualified as Core
import Plutus.PAB.Core.ContractInstance (ContractInstanceState (ContractInstanceState), updateState)
import Plutus.PAB.Core.ContractInstance.STM (InstanceState, emptyInstanceState)
import Plutus.PAB.Db.Beam qualified as Beam
import Plutus.PAB.Effects.Contract qualified as Contract
import Plutus.PAB.Effects.Contract.Builtin (Builtin, BuiltinHandler, HasDefinitions, SomeBuiltinState, getResponse)
import Plutus.PAB.Monitoring.Monitoring qualified as LM
import Plutus.PAB.Run.Command (ConfigCommand (ChainIndex, ContractState, ForkCommands, Migrate, MockWallet, PABWebserver, ReportActiveContracts, ReportAvailableContracts, ReportContractHistory, StartNode))
import Plutus.PAB.Types (ChainQueryConfig (..), Config (Config, dbConfig, pabWebserverConfig), chainQueryConfig,
                         nodeServerConfig, walletServerConfig)
import Plutus.PAB.Webserver.Server qualified as PABServer
import Plutus.PAB.Webserver.Types (ContractActivationArgs (ContractActivationArgs, caID, caWallet))
import Prettyprinter (Pretty (pretty), defaultLayoutOptions, layoutPretty, pretty)
import Prettyprinter.Render.Text (renderStrict)
import Servant qualified
import System.Exit (ExitCode (ExitFailure), exitWith)
import Wallet.Emulator.Wallet qualified as Wallet
import Wallet.Types qualified as Wallet

data ConfigCommandArgs a =
    ConfigCommandArgs
        { ConfigCommandArgs a -> Trace IO (AppMsg (Builtin a))
ccaTrace          :: Trace IO (LM.AppMsg (Builtin a))  -- ^ PAB Tracer logging instance
        , ConfigCommandArgs a -> Configuration
ccaLoggingConfig  :: Configuration -- ^ Monitoring configuration
        , ConfigCommandArgs a -> Config
ccaPABConfig      :: Config        -- ^ PAB Configuration
        , ConfigCommandArgs a -> Availability
ccaAvailability   :: Availability  -- ^ Token for signaling service availability
        , ConfigCommandArgs a -> StorageBackend
ccaStorageBackend :: App.StorageBackend -- ^ Wheter to use the beam-sqlite or in-memory backend
        }

-- | Interpret a 'Command' in 'Eff' using the provided tracer and configurations
--
runConfigCommand :: forall a.
    ( Ord a
    , Show a
    , ToJSON a
    , FromJSON a
    , Pretty a
    , Servant.MimeUnrender Servant.JSON a
    , HasDefinitions a
    , OpenApi.ToSchema a
    )
    => BuiltinHandler a
    -> ConfigCommandArgs a
    -> ConfigCommand
    -> IO ()

-- Run the database migration
runConfigCommand :: BuiltinHandler a -> ConfigCommandArgs a -> ConfigCommand -> IO ()
runConfigCommand BuiltinHandler a
_ ConfigCommandArgs{Trace IO (AppMsg (Builtin a))
ccaTrace :: Trace IO (AppMsg (Builtin a))
ccaTrace :: forall a. ConfigCommandArgs a -> Trace IO (AppMsg (Builtin a))
ccaTrace, ccaPABConfig :: forall a. ConfigCommandArgs a -> Config
ccaPABConfig=Config{DbConfig
dbConfig :: DbConfig
dbConfig :: Config -> DbConfig
dbConfig}} ConfigCommand
Migrate =
    DbConfig -> Trace IO (PABLogMsg (Builtin a)) -> IO ()
forall a. DbConfig -> Trace IO (PABLogMsg (Builtin a)) -> IO ()
App.migrate DbConfig
dbConfig (Trace IO (AppMsg (Builtin a)) -> Trace IO (PABLogMsg (Builtin a))
forall (m :: * -> *) a.
Trace m (AppMsg (Builtin a)) -> Trace m (PABLogMsg (Builtin a))
toPABMsg Trace IO (AppMsg (Builtin a))
ccaTrace)

-- Run mock wallet service
runConfigCommand BuiltinHandler a
_ ConfigCommandArgs{Trace IO (AppMsg (Builtin a))
ccaTrace :: Trace IO (AppMsg (Builtin a))
ccaTrace :: forall a. ConfigCommandArgs a -> Trace IO (AppMsg (Builtin a))
ccaTrace, ccaPABConfig :: forall a. ConfigCommandArgs a -> Config
ccaPABConfig = Config {PABServerConfig
nodeServerConfig :: PABServerConfig
nodeServerConfig :: Config -> PABServerConfig
nodeServerConfig, chainQueryConfig :: Config -> ChainQueryConfig
chainQueryConfig = ChainIndexConfig ChainIndexConfig
ciConfig, walletServerConfig :: Config -> WalletConfig
walletServerConfig = LocalWalletConfig LocalWalletSettings
ws},Availability
ccaAvailability :: Availability
ccaAvailability :: forall a. ConfigCommandArgs a -> Availability
ccaAvailability} ConfigCommand
MockWallet = do
    Params
params <- IO Params -> IO Params
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Params -> IO Params) -> IO Params -> IO Params
forall a b. (a -> b) -> a -> b
$ PABServerConfig -> IO Params
Params.fromPABServerConfig PABServerConfig
nodeServerConfig
    IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Trace IO WalletMsg
-> LocalWalletSettings
-> FilePath
-> Params
-> ChainIndexUrl
-> Availability
-> IO ()
WalletServer.main
        (Trace IO (AppMsg (Builtin a)) -> Trace IO WalletMsg
forall (m :: * -> *) a.
Trace m (AppMsg (Builtin a)) -> Trace m WalletMsg
toWalletLog Trace IO (AppMsg (Builtin a))
ccaTrace)
        LocalWalletSettings
ws
        (PABServerConfig -> FilePath
pscSocketPath PABServerConfig
nodeServerConfig)
        Params
params
        (ChainIndexConfig -> ChainIndexUrl
ChainIndex.ciBaseUrl ChainIndexConfig
ciConfig)
        Availability
ccaAvailability

-- Run mock wallet service
runConfigCommand BuiltinHandler a
_ ConfigCommandArgs{ccaPABConfig :: forall a. ConfigCommandArgs a -> Config
ccaPABConfig = Config {walletServerConfig :: Config -> WalletConfig
walletServerConfig = WalletConfig
RemoteWalletConfig}} ConfigCommand
MockWallet =
    FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Plutus.PAB.Run.Cli.runConfigCommand: Can't run mock wallet in remote wallet config."

-- Run mock wallet service
runConfigCommand BuiltinHandler a
_ ConfigCommandArgs{ccaPABConfig :: forall a. ConfigCommandArgs a -> Config
ccaPABConfig = Config {chainQueryConfig :: Config -> ChainQueryConfig
chainQueryConfig = BlockfrostConfig BlockfrostConfig
_}} ConfigCommand
MockWallet =
    FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Plutus.PAB.Run.Cli.runConfigCommand: Can't run mock wallet with BlockfrostConfig."

-- Run mock node server
runConfigCommand BuiltinHandler a
_ ConfigCommandArgs{Trace IO (AppMsg (Builtin a))
ccaTrace :: Trace IO (AppMsg (Builtin a))
ccaTrace :: forall a. ConfigCommandArgs a -> Trace IO (AppMsg (Builtin a))
ccaTrace, ccaPABConfig :: forall a. ConfigCommandArgs a -> Config
ccaPABConfig = Config {PABServerConfig
nodeServerConfig :: PABServerConfig
nodeServerConfig :: Config -> PABServerConfig
nodeServerConfig},Availability
ccaAvailability :: Availability
ccaAvailability :: forall a. ConfigCommandArgs a -> Availability
ccaAvailability} ConfigCommand
StartNode = do
    case PABServerConfig -> NodeMode
pscNodeMode PABServerConfig
nodeServerConfig of
        NodeMode
MockNode -> do
            IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Trace IO PABServerLogMsg
-> PABServerConfig -> Availability -> IO ()
NodeServer.main
                (Trace IO (AppMsg (Builtin a)) -> Trace IO PABServerLogMsg
forall (m :: * -> *) a.
Trace m (AppMsg (Builtin a)) -> Trace m PABServerLogMsg
toMockNodeServerLog Trace IO (AppMsg (Builtin a))
ccaTrace)
                PABServerConfig
nodeServerConfig
                Availability
ccaAvailability
        NodeMode
_        -> do
            Availability -> IO ()
forall (m :: * -> *). MonadIO m => Availability -> m ()
available Availability
ccaAvailability
            -- The semantics of Command(s) is that once a set of commands are
            -- started if any finishes the entire application is terminated. We want
            -- to prevent that by keeping the thread suspended.
            IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
1000000000

-- Run PAB webserver
runConfigCommand
    BuiltinHandler a
contractHandler
    ConfigCommandArgs { Trace IO (AppMsg (Builtin a))
ccaTrace :: Trace IO (AppMsg (Builtin a))
ccaTrace :: forall a. ConfigCommandArgs a -> Trace IO (AppMsg (Builtin a))
ccaTrace
                      , ccaPABConfig :: forall a. ConfigCommandArgs a -> Config
ccaPABConfig =
                          config :: Config
config@Config { WebserverConfig
pabWebserverConfig :: WebserverConfig
pabWebserverConfig :: Config -> WebserverConfig
pabWebserverConfig, PABServerConfig
nodeServerConfig :: PABServerConfig
nodeServerConfig :: Config -> PABServerConfig
nodeServerConfig, DbConfig
dbConfig :: DbConfig
dbConfig :: Config -> DbConfig
dbConfig }
                      , Availability
ccaAvailability :: Availability
ccaAvailability :: forall a. ConfigCommandArgs a -> Availability
ccaAvailability, StorageBackend
ccaStorageBackend :: StorageBackend
ccaStorageBackend :: forall a. ConfigCommandArgs a -> StorageBackend
ccaStorageBackend
                      } ConfigCommand
PABWebserver = do

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ Getting (First ()) NodeMode () -> NodeMode -> Maybe ()
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ()) NodeMode ()
Prism' NodeMode ()
_AlonzoNode (NodeMode -> Maybe ()) -> NodeMode -> Maybe ()
forall a b. (a -> b) -> a -> b
$ PABServerConfig -> NodeMode
pscNodeMode PABServerConfig
nodeServerConfig) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        C.ChainTip SlotNo
slotNo Hash BlockHeader
_ BlockNo
_ <- LocalNodeConnectInfo CardanoMode -> IO ChainTip
forall mode. LocalNodeConnectInfo mode -> IO ChainTip
C.getLocalChainTip (LocalNodeConnectInfo CardanoMode -> IO ChainTip)
-> LocalNodeConnectInfo CardanoMode -> IO ChainTip
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo :: forall mode.
ConsensusModeParams mode
-> NetworkId -> FilePath -> LocalNodeConnectInfo mode
C.LocalNodeConnectInfo
            { localConsensusModeParams :: ConsensusModeParams CardanoMode
C.localConsensusModeParams = EpochSlots -> ConsensusModeParams CardanoMode
C.CardanoModeParams EpochSlots
epochSlots
            , localNodeNetworkId :: NetworkId
C.localNodeNetworkId = NetworkIdWrapper -> NetworkId
unNetworkIdWrapper (NetworkIdWrapper -> NetworkId) -> NetworkIdWrapper -> NetworkId
forall a b. (a -> b) -> a -> b
$ PABServerConfig -> NetworkIdWrapper
pscNetworkId PABServerConfig
nodeServerConfig
            , localNodeSocketPath :: FilePath
C.localNodeSocketPath = PABServerConfig -> FilePath
pscSocketPath PABServerConfig
nodeServerConfig
            }
        Trace IO (AppMsg (Builtin a))
-> Eff '[LogMsg (AppMsg (Builtin a)), IO] ~> IO
forall (m :: * -> *) l.
MonadIO m =>
Trace m l -> Eff '[LogMsg l, m] ~> m
LM.runLogEffects Trace IO (AppMsg (Builtin a))
ccaTrace (Eff '[LogMsg (AppMsg (Builtin a)), IO] () -> IO ())
-> Eff '[LogMsg (AppMsg (Builtin a)), IO] () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            forall (effs :: [* -> *]).
Member (LogMsg (AppMsg (Builtin a))) effs =>
AppMsg (Builtin a) -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo @(LM.AppMsg (Builtin a))
                (AppMsg (Builtin a) -> Eff '[LogMsg (AppMsg (Builtin a)), IO] ())
-> AppMsg (Builtin a) -> Eff '[LogMsg (AppMsg (Builtin a)), IO] ()
forall a b. (a -> b) -> a -> b
$ PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall t. PABLogMsg t -> AppMsg t
LM.PABMsg
                (PABLogMsg (Builtin a) -> AppMsg (Builtin a))
-> PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall a b. (a -> b) -> a -> b
$ CoreMsg (Builtin a) -> PABLogMsg (Builtin a)
forall t. CoreMsg t -> PABLogMsg t
LM.SCoreMsg
                (CoreMsg (Builtin a) -> PABLogMsg (Builtin a))
-> CoreMsg (Builtin a) -> PABLogMsg (Builtin a)
forall a b. (a -> b) -> a -> b
$ PABServerConfig -> SlotNo -> CoreMsg (Builtin a)
forall t. PABServerConfig -> SlotNo -> CoreMsg t
LM.ConnectingToAlonzoNode PABServerConfig
nodeServerConfig SlotNo
slotNo

    -- retrieve previous contracts only when not in InMemoryBackend mode
    Either
  PABError
  [(SomeBuiltinState a, ContractInstanceId,
    ContractActivationArgs a)]
previousContracts <- StorageBackend
-> IO
     (Either
        PABError
        [(SomeBuiltinState a, ContractInstanceId,
          ContractActivationArgs a)])
retrievePreviousContracts StorageBackend
ccaStorageBackend

    -- Then, start the server
    Either PABError ()
result <- StorageBackend
-> Trace IO (PABLogMsg (Builtin a))
-> BuiltinHandler a
-> Config
-> App a ()
-> IO (Either PABError ())
forall a b.
(FromJSON a, ToJSON a, HasDefinitions a, Typeable a) =>
StorageBackend
-> Trace IO (PABLogMsg (Builtin a))
-> BuiltinHandler a
-> Config
-> App a b
-> IO (Either PABError b)
App.runApp StorageBackend
ccaStorageBackend (Trace IO (AppMsg (Builtin a)) -> Trace IO (PABLogMsg (Builtin a))
forall (m :: * -> *) a.
Trace m (AppMsg (Builtin a)) -> Trace m (PABLogMsg (Builtin a))
toPABMsg Trace IO (AppMsg (Builtin a))
ccaTrace) BuiltinHandler a
contractHandler Config
config
      (App a () -> IO (Either PABError ()))
-> App a () -> IO (Either PABError ())
forall a b. (a -> b) -> a -> b
$ do
          PABEnvironment (Builtin a) (AppEnv a)
env <- forall (effs :: [* -> *]).
Member (Reader (PABEnvironment (Builtin a) (AppEnv a))) effs =>
Eff effs (PABEnvironment (Builtin a) (AppEnv a))
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @(Core.PABEnvironment (Builtin a) (App.AppEnv a))

          -- But first, spin up all the previous contracts
          PABMultiAgentMsg (Builtin a) -> App a ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo @(LM.PABMultiAgentMsg (Builtin a)) PABMultiAgentMsg (Builtin a)
forall t. PABMultiAgentMsg t
LM.RestoringPABState
          case Either
  PABError
  [(SomeBuiltinState a, ContractInstanceId,
    ContractActivationArgs a)]
previousContracts of
            Left PABError
err -> PABError -> App a ()
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError PABError
err
            Right [(SomeBuiltinState a, ContractInstanceId,
  ContractActivationArgs a)]
ts -> do
                [(SomeBuiltinState a, ContractInstanceId,
  ContractActivationArgs a)]
-> ((SomeBuiltinState a, ContractInstanceId,
     ContractActivationArgs a)
    -> App a ())
-> App a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(SomeBuiltinState a, ContractInstanceId,
  ContractActivationArgs a)]
ts (((SomeBuiltinState a, ContractInstanceId,
   ContractActivationArgs a)
  -> App a ())
 -> App a ())
-> ((SomeBuiltinState a, ContractInstanceId,
     ContractActivationArgs a)
    -> App a ())
-> App a ()
forall a b. (a -> b) -> a -> b
$ \(SomeBuiltinState a
s, ContractInstanceId
cid, ContractActivationArgs a
args) -> do
                  PABAction (Builtin a) (AppEnv a) ContractInstanceId
action <- SomeBuiltinState a
-> ContractInstanceId
-> ContractActivationArgs a
-> Eff
     (PABEffects (Builtin a) (AppEnv a))
     (PABAction (Builtin a) (AppEnv a) ContractInstanceId)
forall a env (effs :: [* -> *]).
LastMember IO effs =>
SomeBuiltinState a
-> ContractInstanceId
-> ContractActivationArgs a
-> Eff effs (PABAction (Builtin a) env ContractInstanceId)
buildPABAction @a @(App.AppEnv a) SomeBuiltinState a
s ContractInstanceId
cid ContractActivationArgs a
args
                  IO (Async (Either PABError ContractInstanceId))
-> Eff
     (PABEffects (Builtin a) (AppEnv a))
     (Async (Either PABError ContractInstanceId))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async (Either PABError ContractInstanceId))
 -> Eff
      (PABEffects (Builtin a) (AppEnv a))
      (Async (Either PABError ContractInstanceId)))
-> (IO (Either PABError ContractInstanceId)
    -> IO (Async (Either PABError ContractInstanceId)))
-> IO (Either PABError ContractInstanceId)
-> Eff
     (PABEffects (Builtin a) (AppEnv a))
     (Async (Either PABError ContractInstanceId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either PABError ContractInstanceId)
-> IO (Async (Either PABError ContractInstanceId))
forall a. IO a -> IO (Async a)
async (IO (Either PABError ContractInstanceId)
 -> Eff
      (PABEffects (Builtin a) (AppEnv a))
      (Async (Either PABError ContractInstanceId)))
-> IO (Either PABError ContractInstanceId)
-> Eff
     (PABEffects (Builtin a) (AppEnv a))
     (Async (Either PABError ContractInstanceId))
forall a b. (a -> b) -> a -> b
$ PABEnvironment (Builtin a) (AppEnv a)
-> PABAction (Builtin a) (AppEnv a) ContractInstanceId
-> IO (Either PABError ContractInstanceId)
forall t env a.
PABEnvironment t env -> PABAction t env a -> IO (Either PABError a)
Core.runPAB' PABEnvironment (Builtin a) (AppEnv a)
env PABAction (Builtin a) (AppEnv a) ContractInstanceId
action
                  pure ()
                PABMultiAgentMsg (Builtin a) -> App a ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo @(LM.PABMultiAgentMsg (Builtin a)) (Int -> PABMultiAgentMsg (Builtin a)
forall t. Int -> PABMultiAgentMsg t
LM.PABStateRestored (Int -> PABMultiAgentMsg (Builtin a))
-> Int -> PABMultiAgentMsg (Builtin a)
forall a b. (a -> b) -> a -> b
$ [(SomeBuiltinState a, ContractInstanceId,
  ContractActivationArgs a)]
-> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(SomeBuiltinState a, ContractInstanceId,
  ContractActivationArgs a)]
ts)

          -- then, actually start the server.
          (MVar ()
mvar, App a ()
_) <- WebserverConfig
-> Availability
-> PABAction (Builtin a) (AppEnv a) (MVar (), App a ())
forall t env.
(FromJSON (ContractDef t), ToJSON (ContractDef t), PABContract t,
 MimeUnrender JSON (ContractDef t), ToSchema (ContractDef t)) =>
WebserverConfig
-> Availability -> PABAction t env (MVar (), PABAction t env ())
PABServer.startServer WebserverConfig
pabWebserverConfig Availability
ccaAvailability
          IO () -> App a ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App a ()) -> IO () -> App a ()
forall a b. (a -> b) -> a -> b
$ MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
mvar
    (PABError -> IO ()) -> (() -> IO ()) -> Either PABError () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PABError -> IO ()
forall a b. Pretty a => a -> IO b
handleError () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return Either PABError ()
result
  where

    retrievePreviousContracts :: StorageBackend
-> IO
     (Either
        PABError
        [(SomeBuiltinState a, ContractInstanceId,
          ContractActivationArgs a)])
retrievePreviousContracts StorageBackend
BeamBackend = do
      DBConnection
connection <- DbConfig -> Trace IO (PABLogMsg (Builtin a)) -> IO DBConnection
forall a.
DbConfig -> Trace IO (PABLogMsg (Builtin a)) -> IO DBConnection
App.dbConnect DbConfig
dbConfig ((PABLogMsg (Builtin a) -> AppMsg (Builtin a))
-> Trace IO (AppMsg (Builtin a))
-> Trace IO (PABLogMsg (Builtin a))
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
LM.convertLog PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall t. PABLogMsg t -> AppMsg t
LM.PABMsg Trace IO (AppMsg (Builtin a))
ccaTrace)
      -- Restore the running contracts by first collecting up enough details about the
      -- previous contracts to re-start them
      DBConnection
-> Trace IO (PABLogMsg (Builtin a))
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     [(SomeBuiltinState a, ContractInstanceId,
       ContractActivationArgs a)]
-> IO
     (Either
        PABError
        [(SomeBuiltinState a, ContractInstanceId,
          ContractActivationArgs a)])
forall a b.
(ToJSON a, FromJSON a, HasDefinitions a, Typeable a) =>
DBConnection
-> Trace IO (PABLogMsg (Builtin a))
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     b
-> IO (Either PABError b)
Beam.runBeamStoreAction DBConnection
connection ((PABLogMsg (Builtin a) -> AppMsg (Builtin a))
-> Trace IO (AppMsg (Builtin a))
-> Trace IO (PABLogMsg (Builtin a))
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
LM.convertLog PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall t. PABLogMsg t -> AppMsg t
LM.PABMsg Trace IO (AppMsg (Builtin a))
ccaTrace)
        (Eff
   '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
     DelayEffect, IO]
   [(SomeBuiltinState a, ContractInstanceId,
     ContractActivationArgs a)]
 -> IO
      (Either
         PABError
         [(SomeBuiltinState a, ContractInstanceId,
           ContractActivationArgs a)]))
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     [(SomeBuiltinState a, ContractInstanceId,
       ContractActivationArgs a)]
-> IO
     (Either
        PABError
        [(SomeBuiltinState a, ContractInstanceId,
          ContractActivationArgs a)])
forall a b. (a -> b) -> a -> b
$ (LogMsg (AppMsg (Builtin a))
 ~> Eff
      '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
        DelayEffect, IO])
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
   ~> Eff
        '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
          DelayEffect, IO]
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Trace IO (AppMsg (Builtin a))
-> LogMsg (AppMsg (Builtin a))
   ~> Eff
        '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
          DelayEffect, IO]
forall a (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m) =>
Trace m a -> LogMsg a ~> Eff effs
LM.handleLogMsgTrace Trace IO (AppMsg (Builtin a))
ccaTrace)
        (Eff
   '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
     LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
   [(SomeBuiltinState a, ContractInstanceId,
     ContractActivationArgs a)]
 -> Eff
      '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
        DelayEffect, IO]
      [(SomeBuiltinState a, ContractInstanceId,
        ContractActivationArgs a)])
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     [(SomeBuiltinState a, ContractInstanceId,
       ContractActivationArgs a)]
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     [(SomeBuiltinState a, ContractInstanceId,
       ContractActivationArgs a)]
forall a b. (a -> b) -> a -> b
$ do
            [(ContractInstanceId, ContractActivationArgs a)]
cIds <- Map ContractInstanceId (ContractActivationArgs a)
-> [(ContractInstanceId, ContractActivationArgs a)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ContractInstanceId (ContractActivationArgs a)
 -> [(ContractInstanceId, ContractActivationArgs a)])
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     (Map ContractInstanceId (ContractActivationArgs a))
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     [(ContractInstanceId, ContractActivationArgs a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (effs :: [* -> *]).
Member (ContractStore (Builtin a)) effs =>
Eff
  effs
  (Map
     ContractInstanceId
     (ContractActivationArgs (ContractDef (Builtin a))))
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
Eff
  effs
  (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
Contract.getActiveContracts @(Builtin a)
            [(ContractInstanceId, ContractActivationArgs a)]
-> ((ContractInstanceId, ContractActivationArgs a)
    -> Eff
         '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
           LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
         (SomeBuiltinState a, ContractInstanceId, ContractActivationArgs a))
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     [(SomeBuiltinState a, ContractInstanceId,
       ContractActivationArgs a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(ContractInstanceId, ContractActivationArgs a)]
cIds (((ContractInstanceId, ContractActivationArgs a)
  -> Eff
       '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
         LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
       (SomeBuiltinState a, ContractInstanceId, ContractActivationArgs a))
 -> Eff
      '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
        LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
      [(SomeBuiltinState a, ContractInstanceId,
        ContractActivationArgs a)])
-> ((ContractInstanceId, ContractActivationArgs a)
    -> Eff
         '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
           LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
         (SomeBuiltinState a, ContractInstanceId, ContractActivationArgs a))
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     [(SomeBuiltinState a, ContractInstanceId,
       ContractActivationArgs a)]
forall a b. (a -> b) -> a -> b
$ \(ContractInstanceId
cid, ContractActivationArgs a
args) -> do
              SomeBuiltinState a
s <- ContractInstanceId
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     (State (Builtin a))
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
ContractInstanceId -> Eff effs (State t)
Contract.getState @(Builtin a) ContractInstanceId
cid
              let priorContract :: (SomeBuiltinState a, Wallet.ContractInstanceId, ContractActivationArgs a)
                  priorContract :: (SomeBuiltinState a, ContractInstanceId, ContractActivationArgs a)
priorContract = (SomeBuiltinState a
s, ContractInstanceId
cid, ContractActivationArgs a
args)
              (SomeBuiltinState a, ContractInstanceId, ContractActivationArgs a)
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     (SomeBuiltinState a, ContractInstanceId, ContractActivationArgs a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeBuiltinState a, ContractInstanceId, ContractActivationArgs a)
priorContract
    retrievePreviousContracts StorageBackend
InMemoryBackend = Either
  PABError
  [(SomeBuiltinState a, ContractInstanceId,
    ContractActivationArgs a)]
-> IO
     (Either
        PABError
        [(SomeBuiltinState a, ContractInstanceId,
          ContractActivationArgs a)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   PABError
   [(SomeBuiltinState a, ContractInstanceId,
     ContractActivationArgs a)]
 -> IO
      (Either
         PABError
         [(SomeBuiltinState a, ContractInstanceId,
           ContractActivationArgs a)]))
-> Either
     PABError
     [(SomeBuiltinState a, ContractInstanceId,
       ContractActivationArgs a)]
-> IO
     (Either
        PABError
        [(SomeBuiltinState a, ContractInstanceId,
          ContractActivationArgs a)])
forall a b. (a -> b) -> a -> b
$ [(SomeBuiltinState a, ContractInstanceId,
  ContractActivationArgs a)]
-> Either
     PABError
     [(SomeBuiltinState a, ContractInstanceId,
       ContractActivationArgs a)]
forall a b. b -> Either a b
Right []

    handleError :: a -> IO b
handleError a
err = do
        LoggingT IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStdoutLoggingT (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Text -> LoggingT IO ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logErrorN (Text -> LoggingT IO ()) -> (a -> Text) -> a -> LoggingT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> Text
forall a. Show a => a -> Text
tshow (Doc Any -> Text) -> (a -> Doc Any) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty) a
err
        ExitCode -> IO b
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
2)

-- Fork a list of commands
runConfigCommand BuiltinHandler a
contractHandler c :: ConfigCommandArgs a
c@ConfigCommandArgs{Availability
ccaAvailability :: Availability
ccaAvailability :: forall a. ConfigCommandArgs a -> Availability
ccaAvailability, ccaPABConfig :: forall a. ConfigCommandArgs a -> Config
ccaPABConfig=Config {PABServerConfig
nodeServerConfig :: PABServerConfig
nodeServerConfig :: Config -> PABServerConfig
nodeServerConfig} } (ForkCommands [ConfigCommand]
commands) =
    let shouldStartMocks :: Bool
shouldStartMocks = case PABServerConfig -> NodeMode
pscNodeMode PABServerConfig
nodeServerConfig of
                             NodeMode
MockNode -> Bool
True
                             NodeMode
_        -> Bool
False
        startedCommands :: [ConfigCommand]
startedCommands  = (ConfigCommand -> Bool) -> [ConfigCommand] -> [ConfigCommand]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> ConfigCommand -> Bool
mockedServices Bool
shouldStartMocks) [ConfigCommand]
commands
     in 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
$ do
          FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Starting all commands (" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [ConfigCommand] -> FilePath
forall a. Show a => a -> FilePath
show [ConfigCommand]
startedCommands FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
")."
          [Async ()]
threads <- (ConfigCommand -> IO (Async ()))
-> [ConfigCommand] -> IO [Async ()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ConfigCommand -> IO (Async ())
forkCommand [ConfigCommand]
startedCommands
          FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Started all commands (" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [ConfigCommand] -> FilePath
forall a. Show a => a -> FilePath
show [ConfigCommand]
startedCommands FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
")."
          [Async ()] -> IO (Async (), ())
forall a. [Async a] -> IO (Async a, a)
waitAny [Async ()]
threads
  where
    mockedServices :: Bool -> ConfigCommand -> Bool
    mockedServices :: Bool -> ConfigCommand -> Bool
mockedServices Bool
shouldStartMocks ConfigCommand
ChainIndex = Bool
shouldStartMocks
    mockedServices Bool
shouldStartMocks ConfigCommand
MockWallet = Bool
shouldStartMocks
    mockedServices Bool
_ ConfigCommand
_                         = Bool
True
    forkCommand :: ConfigCommand -> IO (Async ())
    forkCommand :: ConfigCommand -> IO (Async ())
forkCommand ConfigCommand
subcommand = do
      FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Starting: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ConfigCommand -> FilePath
forall a. Show a => a -> FilePath
show ConfigCommand
subcommand
      Async ()
asyncId <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ()))
-> (ConfigCommand -> IO ()) -> ConfigCommand -> IO (Async ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ())
-> (ConfigCommand -> IO ()) -> ConfigCommand -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinHandler a -> ConfigCommandArgs a -> ConfigCommand -> IO ()
forall a.
(Ord a, Show a, ToJSON a, FromJSON a, Pretty a,
 MimeUnrender JSON a, HasDefinitions a, ToSchema a) =>
BuiltinHandler a -> ConfigCommandArgs a -> ConfigCommand -> IO ()
runConfigCommand BuiltinHandler a
contractHandler ConfigCommandArgs a
c (ConfigCommand -> IO (Async ())) -> ConfigCommand -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ ConfigCommand
subcommand
      FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Started: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ConfigCommand -> FilePath
forall a. Show a => a -> FilePath
show ConfigCommand
subcommand
      Availability -> IO ()
forall (m :: * -> *). MonadIO m => Availability -> m ()
starting Availability
ccaAvailability
      pure Async ()
asyncId

-- Run the chain-index service
runConfigCommand BuiltinHandler a
_ ConfigCommandArgs{Availability
ccaAvailability :: Availability
ccaAvailability :: forall a. ConfigCommandArgs a -> Availability
ccaAvailability, Trace IO (AppMsg (Builtin a))
ccaTrace :: Trace IO (AppMsg (Builtin a))
ccaTrace :: forall a. ConfigCommandArgs a -> Trace IO (AppMsg (Builtin a))
ccaTrace, ccaPABConfig :: forall a. ConfigCommandArgs a -> Config
ccaPABConfig=Config { PABServerConfig
nodeServerConfig :: PABServerConfig
nodeServerConfig :: Config -> PABServerConfig
nodeServerConfig, chainQueryConfig :: Config -> ChainQueryConfig
chainQueryConfig = ChainIndexConfig ChainIndexConfig
ciConfig}} ConfigCommand
ChainIndex = do
    Params
params <- IO Params -> IO Params
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Params -> IO Params) -> IO Params -> IO Params
forall a b. (a -> b) -> a -> b
$ PABServerConfig -> IO Params
Params.fromPABServerConfig PABServerConfig
nodeServerConfig
    ChainIndexTrace
-> ChainIndexConfig -> FilePath -> Params -> Availability -> IO ()
ChainIndex.main
        (Trace IO (AppMsg (Builtin a)) -> ChainIndexTrace
forall (m :: * -> *) a.
Trace m (AppMsg (Builtin a)) -> Trace m ChainIndexServerMsg
toChainIndexLog Trace IO (AppMsg (Builtin a))
ccaTrace)
        ChainIndexConfig
ciConfig
        (PABServerConfig -> FilePath
pscSocketPath PABServerConfig
nodeServerConfig)
        Params
params
        Availability
ccaAvailability

-- Run the chain-index service
runConfigCommand BuiltinHandler a
_ ConfigCommandArgs{ccaPABConfig :: forall a. ConfigCommandArgs a -> Config
ccaPABConfig=Config {chainQueryConfig :: Config -> ChainQueryConfig
chainQueryConfig = BlockfrostConfig BlockfrostConfig
_ }} ConfigCommand
ChainIndex =
    FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Plutus.PAB.Run.Cli.runConfigCommand: Can't run Chain Index with BlockfrostConfig."

-- Get the state of a contract
runConfigCommand BuiltinHandler a
_ ConfigCommandArgs{Trace IO (AppMsg (Builtin a))
ccaTrace :: Trace IO (AppMsg (Builtin a))
ccaTrace :: forall a. ConfigCommandArgs a -> Trace IO (AppMsg (Builtin a))
ccaTrace, ccaPABConfig :: forall a. ConfigCommandArgs a -> Config
ccaPABConfig=Config{DbConfig
dbConfig :: DbConfig
dbConfig :: Config -> DbConfig
dbConfig}} (ContractState ContractInstanceId
contractInstanceId) = do
    DBConnection
connection <- DbConfig -> Trace IO (PABLogMsg (Builtin a)) -> IO DBConnection
forall a.
DbConfig -> Trace IO (PABLogMsg (Builtin a)) -> IO DBConnection
App.dbConnect DbConfig
dbConfig ((PABLogMsg (Builtin a) -> AppMsg (Builtin a))
-> Trace IO (AppMsg (Builtin a))
-> Trace IO (PABLogMsg (Builtin a))
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
LM.convertLog PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall t. PABLogMsg t -> AppMsg t
LM.PABMsg Trace IO (AppMsg (Builtin a))
ccaTrace)
    (Either PABError () -> ()) -> IO (Either PABError ()) -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PABError -> ()) -> (() -> ()) -> Either PABError () -> ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> ()) -> (PABError -> FilePath) -> PABError -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PABError -> FilePath
forall a. Show a => a -> FilePath
show) () -> ()
forall a. a -> a
id)
        (IO (Either PABError ()) -> IO ())
-> IO (Either PABError ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ DBConnection
-> Trace IO (PABLogMsg (Builtin a))
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     ()
-> IO (Either PABError ())
forall a b.
(ToJSON a, FromJSON a, HasDefinitions a, Typeable a) =>
DBConnection
-> Trace IO (PABLogMsg (Builtin a))
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     b
-> IO (Either PABError b)
Beam.runBeamStoreAction DBConnection
connection ((PABLogMsg (Builtin a) -> AppMsg (Builtin a))
-> Trace IO (AppMsg (Builtin a))
-> Trace IO (PABLogMsg (Builtin a))
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
LM.convertLog PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall t. PABLogMsg t -> AppMsg t
LM.PABMsg Trace IO (AppMsg (Builtin a))
ccaTrace)
        (Eff
   '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
     DelayEffect, IO]
   ()
 -> IO (Either PABError ()))
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     ()
-> IO (Either PABError ())
forall a b. (a -> b) -> a -> b
$ (LogMsg (AppMsg (Builtin a))
 ~> Eff
      '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
        DelayEffect, IO])
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
   ~> Eff
        '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
          DelayEffect, IO]
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Trace IO (AppMsg (Builtin a))
-> LogMsg (AppMsg (Builtin a))
   ~> Eff
        '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
          DelayEffect, IO]
forall a (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m) =>
Trace m a -> LogMsg a ~> Eff effs
LM.handleLogMsgTrace Trace IO (AppMsg (Builtin a))
ccaTrace)
        (Eff
   '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
     LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
   ()
 -> Eff
      '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
        DelayEffect, IO]
      ())
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     ()
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     ()
forall a b. (a -> b) -> a -> b
$ do
            SomeBuiltinState a
s <- ContractInstanceId
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     (State (Builtin a))
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
ContractInstanceId -> Eff effs (State t)
Contract.getState @(Builtin a) ContractInstanceId
contractInstanceId
            let outputState :: ContractResponse Value Value PABResp PABReq
outputState = Proxy (Builtin a)
-> State (Builtin a) -> ContractResponse Value Value PABResp PABReq
forall contract.
PABContract contract =>
Proxy contract
-> State contract -> ContractResponse Value Value PABResp PABReq
Contract.serialisableState (Proxy (Builtin a)
forall k (t :: k). Proxy t
Proxy @(Builtin a)) State (Builtin a)
SomeBuiltinState a
s
            forall (effs :: [* -> *]).
Member (LogMsg (AppMsg (Builtin a))) effs =>
AppMsg (Builtin a) -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo @(LM.AppMsg (Builtin a)) (AppMsg (Builtin a)
 -> Eff
      '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
        LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
      ())
-> AppMsg (Builtin a)
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     ()
forall a b. (a -> b) -> a -> b
$ PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall t. PABLogMsg t -> AppMsg t
LM.PABMsg (PABLogMsg (Builtin a) -> AppMsg (Builtin a))
-> PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall a b. (a -> b) -> a -> b
$ CoreMsg (Builtin a) -> PABLogMsg (Builtin a)
forall t. CoreMsg t -> PABLogMsg t
LM.SCoreMsg (CoreMsg (Builtin a) -> PABLogMsg (Builtin a))
-> CoreMsg (Builtin a) -> PABLogMsg (Builtin a)
forall a b. (a -> b) -> a -> b
$ Maybe (ContractResponse Value Value PABResp PABReq)
-> CoreMsg (Builtin a)
forall t.
Maybe (ContractResponse Value Value PABResp PABReq) -> CoreMsg t
LM.FoundContract (Maybe (ContractResponse Value Value PABResp PABReq)
 -> CoreMsg (Builtin a))
-> Maybe (ContractResponse Value Value PABResp PABReq)
-> CoreMsg (Builtin a)
forall a b. (a -> b) -> a -> b
$ ContractResponse Value Value PABResp PABReq
-> Maybe (ContractResponse Value Value PABResp PABReq)
forall a. a -> Maybe a
Just ContractResponse Value Value PABResp PABReq
outputState
            Eff
  '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
    LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
  ()
forall (effs :: [* -> *]). Member DelayEffect effs => Eff effs ()
drainLog

-- Get all available contracts
runConfigCommand BuiltinHandler a
_ ConfigCommandArgs{Trace IO (AppMsg (Builtin a))
ccaTrace :: Trace IO (AppMsg (Builtin a))
ccaTrace :: forall a. ConfigCommandArgs a -> Trace IO (AppMsg (Builtin a))
ccaTrace} ConfigCommand
ReportAvailableContracts = do
    Eff '[IO] () -> IO ()
forall (m :: * -> *) a. Monad m => Eff '[m] a -> m a
runM
        (Eff '[IO] () -> IO ()) -> Eff '[IO] () -> IO ()
forall a b. (a -> b) -> a -> b
$ (ContractDefinition (Builtin a) ~> Eff '[IO])
-> Eff '[ContractDefinition (Builtin a), IO] ~> Eff '[IO]
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (forall (effs :: [* -> *]).
HasDefinitions a =>
ContractDefinition (Builtin a) ~> Eff effs
forall a (effs :: [* -> *]).
HasDefinitions a =>
ContractDefinition (Builtin a) ~> Eff effs
App.handleContractDefinition @a)
        (Eff '[ContractDefinition (Builtin a), IO] () -> Eff '[IO] ())
-> Eff '[ContractDefinition (Builtin a), IO] () -> Eff '[IO] ()
forall a b. (a -> b) -> a -> b
$ (LogMsg (AppMsg (Builtin a))
 ~> Eff '[ContractDefinition (Builtin a), IO])
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractDefinition (Builtin a), IO]
   ~> Eff '[ContractDefinition (Builtin a), IO]
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Trace IO (AppMsg (Builtin a))
-> LogMsg (AppMsg (Builtin a))
   ~> Eff '[ContractDefinition (Builtin a), IO]
forall a (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m) =>
Trace m a -> LogMsg a ~> Eff effs
LM.handleLogMsgTrace Trace IO (AppMsg (Builtin a))
ccaTrace)
        (Eff
   '[LogMsg (AppMsg (Builtin a)), ContractDefinition (Builtin a), IO]
   ()
 -> Eff '[ContractDefinition (Builtin a), IO] ())
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractDefinition (Builtin a), IO]
     ()
-> Eff '[ContractDefinition (Builtin a), IO] ()
forall a b. (a -> b) -> a -> b
$ Eff
  '[DelayEffect, LogMsg (AppMsg (Builtin a)),
    ContractDefinition (Builtin a), IO]
  ()
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractDefinition (Builtin a), IO]
     ()
forall (effs :: [* -> *]) (m :: * -> *).
(LastMember m effs, MonadIO m) =>
Eff (DelayEffect : effs) ~> Eff effs
handleDelayEffect
        (Eff
   '[DelayEffect, LogMsg (AppMsg (Builtin a)),
     ContractDefinition (Builtin a), IO]
   ()
 -> Eff
      '[LogMsg (AppMsg (Builtin a)), ContractDefinition (Builtin a), IO]
      ())
-> Eff
     '[DelayEffect, LogMsg (AppMsg (Builtin a)),
       ContractDefinition (Builtin a), IO]
     ()
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractDefinition (Builtin a), IO]
     ()
forall a b. (a -> b) -> a -> b
$ do
            [a]
availableContracts <- forall (effs :: [* -> *]).
Member (ContractDefinition (Builtin a)) effs =>
Eff effs [ContractDef (Builtin a)]
forall t (effs :: [* -> *]).
Member (ContractDefinition t) effs =>
Eff effs [ContractDef t]
Contract.getDefinitions @(Builtin a)
            (a
 -> Eff
      '[DelayEffect, LogMsg (AppMsg (Builtin a)),
        ContractDefinition (Builtin a), IO]
      ())
-> [a]
-> Eff
     '[DelayEffect, LogMsg (AppMsg (Builtin a)),
       ContractDefinition (Builtin a), IO]
     ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (effs :: [* -> *]).
Member (LogMsg (AppMsg (Builtin a))) effs =>
AppMsg (Builtin a) -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo @(LM.AppMsg (Builtin a)) (AppMsg (Builtin a)
 -> Eff
      '[DelayEffect, LogMsg (AppMsg (Builtin a)),
        ContractDefinition (Builtin a), IO]
      ())
-> (a -> AppMsg (Builtin a))
-> a
-> Eff
     '[DelayEffect, LogMsg (AppMsg (Builtin a)),
       ContractDefinition (Builtin a), IO]
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AppMsg (Builtin a)
forall t. Text -> AppMsg t
LM.AvailableContract (Text -> AppMsg (Builtin a))
-> (a -> Text) -> a -> AppMsg (Builtin a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> Text
forall ann. Doc ann -> Text
render (Doc Any -> Text) -> (a -> Doc Any) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty) [a]
availableContracts
            Eff
  '[DelayEffect, LogMsg (AppMsg (Builtin a)),
    ContractDefinition (Builtin a), IO]
  ()
forall (effs :: [* -> *]). Member DelayEffect effs => Eff effs ()
drainLog
                where
                    render :: Doc ann -> Text
render = SimpleDocStream ann -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream ann -> Text)
-> (Doc ann -> SimpleDocStream ann) -> Doc ann -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions

-- Get all active contracts
runConfigCommand BuiltinHandler a
_ ConfigCommandArgs{Trace IO (AppMsg (Builtin a))
ccaTrace :: Trace IO (AppMsg (Builtin a))
ccaTrace :: forall a. ConfigCommandArgs a -> Trace IO (AppMsg (Builtin a))
ccaTrace, ccaPABConfig :: forall a. ConfigCommandArgs a -> Config
ccaPABConfig=Config{DbConfig
dbConfig :: DbConfig
dbConfig :: Config -> DbConfig
dbConfig}} ConfigCommand
ReportActiveContracts = do
    DBConnection
connection <- DbConfig -> Trace IO (PABLogMsg (Builtin a)) -> IO DBConnection
forall a.
DbConfig -> Trace IO (PABLogMsg (Builtin a)) -> IO DBConnection
App.dbConnect DbConfig
dbConfig ((PABLogMsg (Builtin a) -> AppMsg (Builtin a))
-> Trace IO (AppMsg (Builtin a))
-> Trace IO (PABLogMsg (Builtin a))
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
LM.convertLog PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall t. PABLogMsg t -> AppMsg t
LM.PABMsg Trace IO (AppMsg (Builtin a))
ccaTrace)
    (Either PABError () -> ()) -> IO (Either PABError ()) -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PABError -> ()) -> (() -> ()) -> Either PABError () -> ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> ()) -> (PABError -> FilePath) -> PABError -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PABError -> FilePath
forall a. Show a => a -> FilePath
show) () -> ()
forall a. a -> a
id)
        (IO (Either PABError ()) -> IO ())
-> IO (Either PABError ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ DBConnection
-> Trace IO (PABLogMsg (Builtin a))
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     ()
-> IO (Either PABError ())
forall a b.
(ToJSON a, FromJSON a, HasDefinitions a, Typeable a) =>
DBConnection
-> Trace IO (PABLogMsg (Builtin a))
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     b
-> IO (Either PABError b)
Beam.runBeamStoreAction DBConnection
connection ((PABLogMsg (Builtin a) -> AppMsg (Builtin a))
-> Trace IO (AppMsg (Builtin a))
-> Trace IO (PABLogMsg (Builtin a))
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
LM.convertLog PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall t. PABLogMsg t -> AppMsg t
LM.PABMsg Trace IO (AppMsg (Builtin a))
ccaTrace)
        (Eff
   '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
     DelayEffect, IO]
   ()
 -> IO (Either PABError ()))
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     ()
-> IO (Either PABError ())
forall a b. (a -> b) -> a -> b
$ (LogMsg (AppMsg (Builtin a))
 ~> Eff
      '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
        DelayEffect, IO])
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
   ~> Eff
        '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
          DelayEffect, IO]
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Trace IO (AppMsg (Builtin a))
-> LogMsg (AppMsg (Builtin a))
   ~> Eff
        '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
          DelayEffect, IO]
forall a (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m) =>
Trace m a -> LogMsg a ~> Eff effs
LM.handleLogMsgTrace Trace IO (AppMsg (Builtin a))
ccaTrace)
        (Eff
   '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
     LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
   ()
 -> Eff
      '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
        DelayEffect, IO]
      ())
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     ()
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     ()
forall a b. (a -> b) -> a -> b
$ do
            AppMsg (Builtin a)
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo @(LM.AppMsg (Builtin a)) AppMsg (Builtin a)
forall t. AppMsg t
LM.ActiveContractsMsg
            Map ContractInstanceId (ContractActivationArgs a)
instancesById <- forall (effs :: [* -> *]).
Member (ContractStore (Builtin a)) effs =>
Eff
  effs
  (Map
     ContractInstanceId
     (ContractActivationArgs (ContractDef (Builtin a))))
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
Eff
  effs
  (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
Contract.getActiveContracts @(Builtin a)
            let idsByDefinition :: Map a (Set ContractInstanceId)
idsByDefinition = (Set ContractInstanceId
 -> Set ContractInstanceId -> Set ContractInstanceId)
-> [(a, Set ContractInstanceId)] -> Map a (Set ContractInstanceId)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set ContractInstanceId
-> Set ContractInstanceId -> Set ContractInstanceId
forall a. Semigroup a => a -> a -> a
(<>) ([(a, Set ContractInstanceId)] -> Map a (Set ContractInstanceId))
-> [(a, Set ContractInstanceId)] -> Map a (Set ContractInstanceId)
forall a b. (a -> b) -> a -> b
$ ((ContractInstanceId, ContractActivationArgs a)
 -> (a, Set ContractInstanceId))
-> [(ContractInstanceId, ContractActivationArgs a)]
-> [(a, Set ContractInstanceId)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ContractInstanceId
inst, ContractActivationArgs{a
caID :: a
caID :: forall t. ContractActivationArgs t -> t
caID}) -> (a
caID, ContractInstanceId -> Set ContractInstanceId
forall a. a -> Set a
Set.singleton ContractInstanceId
inst)) ([(ContractInstanceId, ContractActivationArgs a)]
 -> [(a, Set ContractInstanceId)])
-> [(ContractInstanceId, ContractActivationArgs a)]
-> [(a, Set ContractInstanceId)]
forall a b. (a -> b) -> a -> b
$ Map ContractInstanceId (ContractActivationArgs a)
-> [(ContractInstanceId, ContractActivationArgs a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ContractInstanceId (ContractActivationArgs a)
instancesById
            ((a, Set ContractInstanceId)
 -> Eff
      '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
        LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
      ())
-> [(a, Set ContractInstanceId)]
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\(a
e, Set ContractInstanceId
s) -> forall (effs :: [* -> *]).
Member (LogMsg (AppMsg (Builtin a))) effs =>
AppMsg (Builtin a) -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo @(LM.AppMsg (Builtin a)) (AppMsg (Builtin a)
 -> Eff
      '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
        LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
      ())
-> AppMsg (Builtin a)
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     ()
forall a b. (a -> b) -> a -> b
$ ContractDef (Builtin a)
-> [ContractInstanceId] -> AppMsg (Builtin a)
forall t. ContractDef t -> [ContractInstanceId] -> AppMsg t
LM.ContractInstances a
ContractDef (Builtin a)
e (Set ContractInstanceId -> [ContractInstanceId]
forall a. Set a -> [a]
Set.toList Set ContractInstanceId
s)) ([(a, Set ContractInstanceId)]
 -> Eff
      '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
        LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
      ())
-> [(a, Set ContractInstanceId)]
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     ()
forall a b. (a -> b) -> a -> b
$ Map a (Set ContractInstanceId) -> [(a, Set ContractInstanceId)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map a (Set ContractInstanceId)
idsByDefinition
            Eff
  '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
    LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
  ()
forall (effs :: [* -> *]). Member DelayEffect effs => Eff effs ()
drainLog

-- Get history of a specific contract
runConfigCommand BuiltinHandler a
_ ConfigCommandArgs{Trace IO (AppMsg (Builtin a))
ccaTrace :: Trace IO (AppMsg (Builtin a))
ccaTrace :: forall a. ConfigCommandArgs a -> Trace IO (AppMsg (Builtin a))
ccaTrace, ccaPABConfig :: forall a. ConfigCommandArgs a -> Config
ccaPABConfig=Config{DbConfig
dbConfig :: DbConfig
dbConfig :: Config -> DbConfig
dbConfig}} (ReportContractHistory ContractInstanceId
contractInstanceId) = do
    DBConnection
connection <- DbConfig -> Trace IO (PABLogMsg (Builtin a)) -> IO DBConnection
forall a.
DbConfig -> Trace IO (PABLogMsg (Builtin a)) -> IO DBConnection
App.dbConnect DbConfig
dbConfig ((PABLogMsg (Builtin a) -> AppMsg (Builtin a))
-> Trace IO (AppMsg (Builtin a))
-> Trace IO (PABLogMsg (Builtin a))
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
LM.convertLog PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall t. PABLogMsg t -> AppMsg t
LM.PABMsg Trace IO (AppMsg (Builtin a))
ccaTrace)
    (Either PABError () -> ()) -> IO (Either PABError ()) -> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PABError -> ()) -> (() -> ()) -> Either PABError () -> ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> ()) -> (PABError -> FilePath) -> PABError -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PABError -> FilePath
forall a. Show a => a -> FilePath
show) () -> ()
forall a. a -> a
id)
        (IO (Either PABError ()) -> IO ())
-> IO (Either PABError ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ DBConnection
-> Trace IO (PABLogMsg (Builtin a))
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     ()
-> IO (Either PABError ())
forall a b.
(ToJSON a, FromJSON a, HasDefinitions a, Typeable a) =>
DBConnection
-> Trace IO (PABLogMsg (Builtin a))
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     b
-> IO (Either PABError b)
Beam.runBeamStoreAction DBConnection
connection ((PABLogMsg (Builtin a) -> AppMsg (Builtin a))
-> Trace IO (AppMsg (Builtin a))
-> Trace IO (PABLogMsg (Builtin a))
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
LM.convertLog PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall t. PABLogMsg t -> AppMsg t
LM.PABMsg Trace IO (AppMsg (Builtin a))
ccaTrace)
        (Eff
   '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
     DelayEffect, IO]
   ()
 -> IO (Either PABError ()))
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     ()
-> IO (Either PABError ())
forall a b. (a -> b) -> a -> b
$ (LogMsg (AppMsg (Builtin a))
 ~> Eff
      '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
        DelayEffect, IO])
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
   ~> Eff
        '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
          DelayEffect, IO]
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Trace IO (AppMsg (Builtin a))
-> LogMsg (AppMsg (Builtin a))
   ~> Eff
        '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
          DelayEffect, IO]
forall a (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m) =>
Trace m a -> LogMsg a ~> Eff effs
LM.handleLogMsgTrace Trace IO (AppMsg (Builtin a))
ccaTrace)
        (Eff
   '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
     LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
   ()
 -> Eff
      '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
        DelayEffect, IO]
      ())
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     ()
-> Eff
     '[ContractStore (Builtin a), LogMsg (PABMultiAgentMsg (Builtin a)),
       DelayEffect, IO]
     ()
forall a b. (a -> b) -> a -> b
$ do
            AppMsg (Builtin a)
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo @(LM.AppMsg (Builtin a)) AppMsg (Builtin a)
forall t. AppMsg t
LM.ContractHistoryMsg
            SomeBuiltinState a
s <- ContractInstanceId
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     (State (Builtin a))
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
ContractInstanceId -> Eff effs (State t)
Contract.getState @(Builtin a) ContractInstanceId
contractInstanceId
            let State.ContractResponse{newState :: forall w e s h.
ContractResponse w e s h -> State w (CheckpointKey, s)
State.newState=State{Responses (CheckpointKey, PABResp)
record :: Responses (CheckpointKey, PABResp)
record :: forall w e. State w e -> Responses e
record}} = Proxy (Builtin a)
-> State (Builtin a) -> ContractResponse Value Value PABResp PABReq
forall contract.
PABContract contract =>
Proxy contract
-> State contract -> ContractResponse Value Value PABResp PABReq
Contract.serialisableState (Proxy (Builtin a)
forall k (t :: k). Proxy t
Proxy @(Builtin a)) State (Builtin a)
SomeBuiltinState a
s
            (Response (CheckpointKey, PABResp)
 -> Eff
      '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
        LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
      ())
-> [Response (CheckpointKey, PABResp)]
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Response (CheckpointKey, PABResp)
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     ()
logStep (Responses (CheckpointKey, PABResp)
-> [Response (CheckpointKey, PABResp)]
forall i. Responses i -> [Response i]
responses Responses (CheckpointKey, PABResp)
record)
            Eff
  '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
    LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
  ()
forall (effs :: [* -> *]). Member DelayEffect effs => Eff effs ()
drainLog
  where
      logStep :: Response (CheckpointKey, PABResp)
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     ()
logStep Response (CheckpointKey, PABResp)
response = forall (effs :: [* -> *]).
Member (LogMsg (AppMsg (Builtin a))) effs =>
AppMsg (Builtin a) -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo @(LM.AppMsg (Builtin a)) (AppMsg (Builtin a)
 -> Eff
      '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
        LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
      ())
-> AppMsg (Builtin a)
-> Eff
     '[LogMsg (AppMsg (Builtin a)), ContractStore (Builtin a),
       LogMsg (PABMultiAgentMsg (Builtin a)), DelayEffect, IO]
     ()
forall a b. (a -> b) -> a -> b
$
          ContractInstanceId -> Response PABResp -> AppMsg (Builtin a)
forall t. ContractInstanceId -> Response PABResp -> AppMsg t
LM.ContractHistoryItem ContractInstanceId
contractInstanceId ((CheckpointKey, PABResp) -> PABResp
forall a b. (a, b) -> b
snd ((CheckpointKey, PABResp) -> PABResp)
-> Response (CheckpointKey, PABResp) -> Response PABResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response (CheckpointKey, PABResp)
response)

toPABMsg :: Trace m (LM.AppMsg (Builtin a)) -> Trace m (LM.PABLogMsg (Builtin a))
toPABMsg :: Trace m (AppMsg (Builtin a)) -> Trace m (PABLogMsg (Builtin a))
toPABMsg = (PABLogMsg (Builtin a) -> AppMsg (Builtin a))
-> Trace m (AppMsg (Builtin a)) -> Trace m (PABLogMsg (Builtin a))
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
LM.convertLog PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall t. PABLogMsg t -> AppMsg t
LM.PABMsg

toChainIndexLog :: Trace m (LM.AppMsg (Builtin a)) -> Trace m LM.ChainIndexServerMsg
toChainIndexLog :: Trace m (AppMsg (Builtin a)) -> Trace m ChainIndexServerMsg
toChainIndexLog = (ChainIndexServerMsg -> AppMsg (Builtin a))
-> Trace m (AppMsg (Builtin a)) -> Trace m ChainIndexServerMsg
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
LM.convertLog ((ChainIndexServerMsg -> AppMsg (Builtin a))
 -> Trace m (AppMsg (Builtin a)) -> Trace m ChainIndexServerMsg)
-> (ChainIndexServerMsg -> AppMsg (Builtin a))
-> Trace m (AppMsg (Builtin a))
-> Trace m ChainIndexServerMsg
forall a b. (a -> b) -> a -> b
$ PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall t. PABLogMsg t -> AppMsg t
LM.PABMsg (PABLogMsg (Builtin a) -> AppMsg (Builtin a))
-> (ChainIndexServerMsg -> PABLogMsg (Builtin a))
-> ChainIndexServerMsg
-> AppMsg (Builtin a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainIndexServerMsg -> PABLogMsg (Builtin a)
forall t. ChainIndexServerMsg -> PABLogMsg t
LM.SChainIndexServerMsg

toWalletLog :: Trace m (LM.AppMsg (Builtin a)) -> Trace m WalletMsg
toWalletLog :: Trace m (AppMsg (Builtin a)) -> Trace m WalletMsg
toWalletLog = (WalletMsg -> AppMsg (Builtin a))
-> Trace m (AppMsg (Builtin a)) -> Trace m WalletMsg
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
LM.convertLog ((WalletMsg -> AppMsg (Builtin a))
 -> Trace m (AppMsg (Builtin a)) -> Trace m WalletMsg)
-> (WalletMsg -> AppMsg (Builtin a))
-> Trace m (AppMsg (Builtin a))
-> Trace m WalletMsg
forall a b. (a -> b) -> a -> b
$ PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall t. PABLogMsg t -> AppMsg t
LM.PABMsg (PABLogMsg (Builtin a) -> AppMsg (Builtin a))
-> (WalletMsg -> PABLogMsg (Builtin a))
-> WalletMsg
-> AppMsg (Builtin a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletMsg -> PABLogMsg (Builtin a)
forall t. WalletMsg -> PABLogMsg t
LM.SWalletMsg

toMockNodeServerLog :: Trace m (LM.AppMsg (Builtin a)) -> Trace m LM.PABServerLogMsg
toMockNodeServerLog :: Trace m (AppMsg (Builtin a)) -> Trace m PABServerLogMsg
toMockNodeServerLog = (PABServerLogMsg -> AppMsg (Builtin a))
-> Trace m (AppMsg (Builtin a)) -> Trace m PABServerLogMsg
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
LM.convertLog ((PABServerLogMsg -> AppMsg (Builtin a))
 -> Trace m (AppMsg (Builtin a)) -> Trace m PABServerLogMsg)
-> (PABServerLogMsg -> AppMsg (Builtin a))
-> Trace m (AppMsg (Builtin a))
-> Trace m PABServerLogMsg
forall a b. (a -> b) -> a -> b
$ PABLogMsg (Builtin a) -> AppMsg (Builtin a)
forall t. PABLogMsg t -> AppMsg t
LM.PABMsg (PABLogMsg (Builtin a) -> AppMsg (Builtin a))
-> (PABServerLogMsg -> PABLogMsg (Builtin a))
-> PABServerLogMsg
-> AppMsg (Builtin a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PABServerLogMsg -> PABLogMsg (Builtin a)
forall t. PABServerLogMsg -> PABLogMsg t
LM.SMockserverLogMsg

-- | Wait for some time to allow all log messages to be printed to
--   the terminal.
drainLog :: Member DelayEffect effs => Eff effs ()
drainLog :: Eff effs ()
drainLog = Second -> Eff effs ()
forall a (effs :: [* -> *]).
(TimeUnit a, Member DelayEffect effs) =>
a -> Eff effs ()
delayThread (Second
1 :: Second)

-- | Build a PAB Action that will run the provided context with the
-- reconstructed state.
buildPABAction ::
    forall a env effs.
    ( LastMember IO effs
    )
    => SomeBuiltinState a
    -> Wallet.ContractInstanceId
    -> ContractActivationArgs a
    -> Eff effs (Core.PABAction (Builtin a) env Wallet.ContractInstanceId)
buildPABAction :: SomeBuiltinState a
-> ContractInstanceId
-> ContractActivationArgs a
-> Eff effs (PABAction (Builtin a) env ContractInstanceId)
buildPABAction SomeBuiltinState a
currentState ContractInstanceId
cid ContractActivationArgs{Maybe Wallet
caWallet :: Maybe Wallet
caWallet :: forall t. ContractActivationArgs t -> Maybe Wallet
caWallet, a
caID :: a
caID :: forall t. ContractActivationArgs t -> t
caID} = do
    let r :: ContractResponse Value Value PABResp PABReq
r = SomeBuiltinState a -> ContractResponse Value Value PABResp PABReq
forall a.
SomeBuiltinState a -> ContractResponse Value Value PABResp PABReq
getResponse SomeBuiltinState a
currentState

    -- Bring up the STM state
    InstanceState
stmState :: InstanceState <- IO InstanceState -> Eff effs InstanceState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InstanceState -> Eff effs InstanceState)
-> IO InstanceState -> Eff effs InstanceState
forall a b. (a -> b) -> a -> b
$ STM InstanceState -> IO InstanceState
forall a. STM a -> IO a
STM.atomically STM InstanceState
emptyInstanceState
    Eff effs () -> Eff effs ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ InstanceState
-> Eff (Reader InstanceState : effs) () -> Eff effs ()
forall r (effs :: [* -> *]) a.
r -> Eff (Reader r : effs) a -> Eff effs a
runReader InstanceState
stmState (Eff (Reader InstanceState : effs) () -> Eff effs ())
-> Eff (Reader InstanceState : effs) () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ContractResponse Value Value PABResp PABReq
-> Eff (Reader InstanceState : effs) ()
forall (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m,
 Member (Reader InstanceState) effs) =>
ContractResponse Value Value PABResp PABReq -> Eff effs ()
updateState @IO ContractResponse Value Value PABResp PABReq
r

    -- Squish it into a PAB action which we will run
    let ciState :: ContractInstanceState (Builtin a)
ciState = State (Builtin a)
-> STM InstanceState -> ContractInstanceState (Builtin a)
forall t. State t -> STM InstanceState -> ContractInstanceState t
ContractInstanceState State (Builtin a)
SomeBuiltinState a
currentState (InstanceState -> STM InstanceState
forall (f :: * -> *) a. Applicative f => a -> f a
pure InstanceState
stmState)
        wallet :: Wallet
wallet = Wallet -> Maybe Wallet -> Wallet
forall a. a -> Maybe a -> a
fromMaybe (Integer -> Wallet
Wallet.knownWallet Integer
1) Maybe Wallet
caWallet
    PABAction (Builtin a) env ContractInstanceId
-> Eff effs (PABAction (Builtin a) env ContractInstanceId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PABAction (Builtin a) env ContractInstanceId
 -> Eff effs (PABAction (Builtin a) env ContractInstanceId))
-> PABAction (Builtin a) env ContractInstanceId
-> Eff effs (PABAction (Builtin a) env ContractInstanceId)
forall a b. (a -> b) -> a -> b
$ ContractInstanceState (Builtin a)
-> ContractInstanceId
-> Wallet
-> ContractDef (Builtin a)
-> PABAction (Builtin a) env ContractInstanceId
forall t env.
PABContract t =>
ContractInstanceState t
-> ContractInstanceId
-> Wallet
-> ContractDef t
-> PABAction t env ContractInstanceId
Core.activateContract' @(Builtin a) ContractInstanceState (Builtin a)
ciState ContractInstanceId
cid Wallet
wallet a
ContractDef (Builtin a)
caID