{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE DerivingVia          #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE UndecidableInstances #-}

-- | PAB Log messages and instances
module Plutus.PAB.Monitoring.PABLogMsg(
    PABLogMsg(..),
    ChainIndexServerMsg,
    WalletMsg,
    CNSEServerLogMsg,
    AppMsg(..),
    CoreMsg(..),
    PABMultiAgentMsg(..),
    RequestSize(..),
    WalletClientMsg(..)
    ) where

import Cardano.Api qualified as C
import Cardano.BM.Data.Tracer (ToObject (toObject), TracingVerbosity (MaximalVerbosity))
import Cardano.BM.Data.Tracer.Extras (StructuredLog, Tagged (Tagged), mkObjectStr)
import Cardano.ChainIndex.Types (ChainIndexServerMsg)
import Cardano.Node.Socket.Emulator.Types (CNSEServerLogMsg (..))
import Cardano.Node.Types (PABServerConfig)
import Cardano.Wallet.Mock.Types (WalletMsg)
import Control.Monad.Freer.Extras.Beam (BeamLog)
import Data.Aeson (FromJSON, ToJSON, Value)
import Data.Aeson.Text (encodeToLazyText)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time.Format.ISO8601 qualified as F
import GHC.Generics (Generic)
import Plutus.Contract.Effects (PABReq, PABResp)
import Plutus.Contract.Resumable (Response)
import Plutus.Contract.State (ContractResponse)
import Plutus.PAB.Core.ContractInstance (ContractInstanceMsg)
import Plutus.PAB.Effects.Contract (PABContract (..))
import Plutus.PAB.Events.Contract (ContractInstanceId)
import Plutus.PAB.Instances ()
import Prettyprinter (Pretty (pretty), colon, line, viaShow, (<+>))
import Wallet.Emulator.LogMessages (TxBalanceMsg)
import Wallet.Emulator.MultiAgent (EmulatorEvent)
import Wallet.Emulator.Wallet (Wallet)

data WalletClientMsg =
    WalletClientError String
    | BalanceTxError String
    deriving stock (WalletClientMsg -> WalletClientMsg -> Bool
(WalletClientMsg -> WalletClientMsg -> Bool)
-> (WalletClientMsg -> WalletClientMsg -> Bool)
-> Eq WalletClientMsg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalletClientMsg -> WalletClientMsg -> Bool
$c/= :: WalletClientMsg -> WalletClientMsg -> Bool
== :: WalletClientMsg -> WalletClientMsg -> Bool
$c== :: WalletClientMsg -> WalletClientMsg -> Bool
Eq, Int -> WalletClientMsg -> ShowS
[WalletClientMsg] -> ShowS
WalletClientMsg -> String
(Int -> WalletClientMsg -> ShowS)
-> (WalletClientMsg -> String)
-> ([WalletClientMsg] -> ShowS)
-> Show WalletClientMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletClientMsg] -> ShowS
$cshowList :: [WalletClientMsg] -> ShowS
show :: WalletClientMsg -> String
$cshow :: WalletClientMsg -> String
showsPrec :: Int -> WalletClientMsg -> ShowS
$cshowsPrec :: Int -> WalletClientMsg -> ShowS
Show, (forall x. WalletClientMsg -> Rep WalletClientMsg x)
-> (forall x. Rep WalletClientMsg x -> WalletClientMsg)
-> Generic WalletClientMsg
forall x. Rep WalletClientMsg x -> WalletClientMsg
forall x. WalletClientMsg -> Rep WalletClientMsg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WalletClientMsg x -> WalletClientMsg
$cfrom :: forall x. WalletClientMsg -> Rep WalletClientMsg x
Generic)
    deriving anyclass ([WalletClientMsg] -> Value
[WalletClientMsg] -> Encoding
WalletClientMsg -> Value
WalletClientMsg -> Encoding
(WalletClientMsg -> Value)
-> (WalletClientMsg -> Encoding)
-> ([WalletClientMsg] -> Value)
-> ([WalletClientMsg] -> Encoding)
-> ToJSON WalletClientMsg
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WalletClientMsg] -> Encoding
$ctoEncodingList :: [WalletClientMsg] -> Encoding
toJSONList :: [WalletClientMsg] -> Value
$ctoJSONList :: [WalletClientMsg] -> Value
toEncoding :: WalletClientMsg -> Encoding
$ctoEncoding :: WalletClientMsg -> Encoding
toJSON :: WalletClientMsg -> Value
$ctoJSON :: WalletClientMsg -> Value
ToJSON, Value -> Parser [WalletClientMsg]
Value -> Parser WalletClientMsg
(Value -> Parser WalletClientMsg)
-> (Value -> Parser [WalletClientMsg]) -> FromJSON WalletClientMsg
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WalletClientMsg]
$cparseJSONList :: Value -> Parser [WalletClientMsg]
parseJSON :: Value -> Parser WalletClientMsg
$cparseJSON :: Value -> Parser WalletClientMsg
FromJSON)

instance Pretty WalletClientMsg where
    pretty :: WalletClientMsg -> Doc ann
pretty = WalletClientMsg -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow

instance ToObject WalletClientMsg where
    toObject :: TracingVerbosity -> WalletClientMsg -> Object
toObject TracingVerbosity
_ WalletClientMsg
m = Text -> () -> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ WalletClientMsg -> String
forall a. Show a => a -> String
show WalletClientMsg
m) ()

data AppMsg t =
    ActiveContractsMsg
    | ContractHistoryMsg
    | PABMsg (PABLogMsg t)
    | AvailableContract Text
    | ContractInstances (ContractDef t) [ContractInstanceId]
    | ContractHistoryItem ContractInstanceId (Response PABResp)
    deriving stock ((forall x. AppMsg t -> Rep (AppMsg t) x)
-> (forall x. Rep (AppMsg t) x -> AppMsg t) -> Generic (AppMsg t)
forall x. Rep (AppMsg t) x -> AppMsg t
forall x. AppMsg t -> Rep (AppMsg t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t x. Rep (AppMsg t) x -> AppMsg t
forall t x. AppMsg t -> Rep (AppMsg t) x
$cto :: forall t x. Rep (AppMsg t) x -> AppMsg t
$cfrom :: forall t x. AppMsg t -> Rep (AppMsg t) x
Generic)

deriving stock instance (Show (ContractDef t)) => Show (AppMsg t)
deriving anyclass instance (ToJSON (ContractDef t)) => ToJSON (AppMsg t)
deriving anyclass instance (FromJSON (ContractDef t)) => FromJSON (AppMsg t)

instance (Pretty (ContractDef t)) => Pretty (AppMsg t) where
    pretty :: AppMsg t -> Doc ann
pretty = \case
        AppMsg t
ActiveContractsMsg               -> Doc ann
"Active contracts"
        AppMsg t
ContractHistoryMsg               -> Doc ann
"Contract history"
        PABMsg PABLogMsg t
m                         -> PABLogMsg t -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty PABLogMsg t
m
        AvailableContract Text
t              -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t
        ContractInstances ContractDef t
t [ContractInstanceId]
s            -> ContractDef t -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractDef t
t Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [ContractInstanceId] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [ContractInstanceId]
s
        ContractHistoryItem ContractInstanceId
instanceId Response PABResp
s -> ContractInstanceId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceId
instanceId Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Response Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ((PABResp -> Text) -> Response PABResp -> Response Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PABResp -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText Response PABResp
s)

data PABLogMsg t =
    SCoreMsg (CoreMsg t)
    | SChainIndexServerMsg ChainIndexServerMsg
    | SWalletMsg WalletMsg
    | SMockserverLogMsg CNSEServerLogMsg
    | SMultiAgent (PABMultiAgentMsg t)
    deriving stock ((forall x. PABLogMsg t -> Rep (PABLogMsg t) x)
-> (forall x. Rep (PABLogMsg t) x -> PABLogMsg t)
-> Generic (PABLogMsg t)
forall x. Rep (PABLogMsg t) x -> PABLogMsg t
forall x. PABLogMsg t -> Rep (PABLogMsg t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t x. Rep (PABLogMsg t) x -> PABLogMsg t
forall t x. PABLogMsg t -> Rep (PABLogMsg t) x
$cto :: forall t x. Rep (PABLogMsg t) x -> PABLogMsg t
$cfrom :: forall t x. PABLogMsg t -> Rep (PABLogMsg t) x
Generic)

deriving stock instance (Show (ContractDef t)) => Show (PABLogMsg t)
deriving anyclass instance (ToJSON (ContractDef t)) => ToJSON (PABLogMsg t)
deriving anyclass instance (FromJSON (ContractDef t)) => FromJSON (PABLogMsg t)

instance Pretty (ContractDef t) => Pretty (PABLogMsg t) where
    pretty :: PABLogMsg t -> Doc ann
pretty = \case
        SCoreMsg CoreMsg t
m             -> CoreMsg t -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty CoreMsg t
m
        SChainIndexServerMsg ChainIndexServerMsg
m -> ChainIndexServerMsg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ChainIndexServerMsg
m
        SWalletMsg WalletMsg
m           -> WalletMsg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty WalletMsg
m
        SMockserverLogMsg CNSEServerLogMsg
m    -> CNSEServerLogMsg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty CNSEServerLogMsg
m
        SMultiAgent PABMultiAgentMsg t
m          -> PABMultiAgentMsg t -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty PABMultiAgentMsg t
m



{- ToObject instances

'ToObject.toObject' is very similar to 'ToJSON.toJSON' except that

* 'toObject' has an additional paramter for verbosity
* 'toObject' must always produce a JSON object (key-value map)

In the definitions below, every object produced by 'toObject' has a field
'string' with a friendly description of the message, similar to its
'Pretty' instance. Additional fields depend on the type of message.

-}

instance (ToJSON (ContractDef t), StructuredLog (ContractDef t)) => ToObject (AppMsg t) where
    toObject :: TracingVerbosity -> AppMsg t -> Object
toObject TracingVerbosity
v = \case
        AppMsg t
ActiveContractsMsg ->
            Text -> () -> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr Text
"Listing active contract instances" ()
        AppMsg t
ContractHistoryMsg ->
            Text -> () -> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr Text
"Showing contract history" ()
        PABMsg PABLogMsg t
m -> TracingVerbosity -> PABLogMsg t -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
v PABLogMsg t
m
        AvailableContract Text
t ->
            Text -> Text -> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr Text
"Available contract" Text
t
        ContractInstances ContractDef t
exe [ContractInstanceId]
ids ->
            Text
-> (ContractDef t, Tagged "instances" [ContractInstanceId])
-> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr
                Text
"Active instances for contract"
                (ContractDef t
exe, [ContractInstanceId] -> Tagged "instances" [ContractInstanceId]
forall k (s :: k) b. b -> Tagged s b
Tagged @"instances" [ContractInstanceId]
ids)
        ContractHistoryItem ContractInstanceId
i Response PABResp
state ->
            Text
-> Either (ContractInstanceId, Response PABResp) ContractInstanceId
-> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr Text
"Contract history item" (Either (ContractInstanceId, Response PABResp) ContractInstanceId
 -> Object)
-> Either (ContractInstanceId, Response PABResp) ContractInstanceId
-> Object
forall a b. (a -> b) -> a -> b
$
                case TracingVerbosity
v of
                    TracingVerbosity
MaximalVerbosity -> (ContractInstanceId, Response PABResp)
-> Either (ContractInstanceId, Response PABResp) ContractInstanceId
forall a b. a -> Either a b
Left (ContractInstanceId
i, Response PABResp
state)
                    TracingVerbosity
_                -> ContractInstanceId
-> Either (ContractInstanceId, Response PABResp) ContractInstanceId
forall a b. b -> Either a b
Right ContractInstanceId
i

instance (StructuredLog (ContractDef t), ToJSON (ContractDef t)) => ToObject (PABLogMsg t) where
    toObject :: TracingVerbosity -> PABLogMsg t -> Object
toObject TracingVerbosity
v = \case
        SCoreMsg CoreMsg t
m             -> TracingVerbosity -> CoreMsg t -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
v CoreMsg t
m
        SChainIndexServerMsg ChainIndexServerMsg
m -> TracingVerbosity -> ChainIndexServerMsg -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
v ChainIndexServerMsg
m
        SWalletMsg WalletMsg
m           -> TracingVerbosity -> WalletMsg -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
v WalletMsg
m
        SMultiAgent PABMultiAgentMsg t
m          -> TracingVerbosity -> PABMultiAgentMsg t -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
v PABMultiAgentMsg t
m
        SMockserverLogMsg CNSEServerLogMsg
m    -> case CNSEServerLogMsg
m of
            StartingSlotCoordination UTCTime
i Millisecond
l -> Text
-> (Tagged "initial-slot-time" String,
    Tagged "slot-length" Millisecond)
-> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr Text
"Starting slot coordination thread" (String -> Tagged "initial-slot-time" String
forall k (s :: k) b. b -> Tagged s b
Tagged @"initial-slot-time" (UTCTime -> String
forall t. ISO8601 t => t -> String
F.iso8601Show  UTCTime
i), Millisecond -> Tagged "slot-length" Millisecond
forall k (s :: k) b. b -> Tagged s b
Tagged @"slot-length" Millisecond
l)
            StartingCNSEServer Int
p    -> Text -> Tagged "port" Int -> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr Text
"Starting Cardano Node Emulator on port " (Int -> Tagged "port" Int
forall k (s :: k) b. b -> Tagged s b
Tagged @"port" Int
p)
            ProcessingEmulatorMsg EmulatorMsg
e -> Text -> Tagged "event" EmulatorMsg -> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr Text
"Processing chain event" (EmulatorMsg -> Tagged "event" EmulatorMsg
forall k (s :: k) b. b -> Tagged s b
Tagged @"event" EmulatorMsg
e)


-- | FIXME: Redundant?
data PABMultiAgentMsg t =
    EmulatorMsg EmulatorEvent
    | ContractInstanceLog (ContractInstanceMsg t)
    | UserLog T.Text
    | BeamLogItem BeamLog
    | PABStateRestored Int
    | RestoringPABState
    | StartingPABBackendServer Int
    | WalletBalancingMsg Wallet TxBalanceMsg
    | WalletClient WalletClientMsg
    deriving stock (forall x. PABMultiAgentMsg t -> Rep (PABMultiAgentMsg t) x)
-> (forall x. Rep (PABMultiAgentMsg t) x -> PABMultiAgentMsg t)
-> Generic (PABMultiAgentMsg t)
forall x. Rep (PABMultiAgentMsg t) x -> PABMultiAgentMsg t
forall x. PABMultiAgentMsg t -> Rep (PABMultiAgentMsg t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t x. Rep (PABMultiAgentMsg t) x -> PABMultiAgentMsg t
forall t x. PABMultiAgentMsg t -> Rep (PABMultiAgentMsg t) x
$cto :: forall t x. Rep (PABMultiAgentMsg t) x -> PABMultiAgentMsg t
$cfrom :: forall t x. PABMultiAgentMsg t -> Rep (PABMultiAgentMsg t) x
Generic

instance (StructuredLog (ContractDef t), ToJSON (ContractDef t)) => ToObject (PABMultiAgentMsg t) where
    toObject :: TracingVerbosity -> PABMultiAgentMsg t -> Object
toObject TracingVerbosity
v = \case
        EmulatorMsg EmulatorEvent
e              -> Text -> Tagged "payload" EmulatorEvent -> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr Text
"emulator message" (EmulatorEvent -> Tagged "payload" EmulatorEvent
forall k (s :: k) b. b -> Tagged s b
Tagged @"payload" EmulatorEvent
e)
        ContractInstanceLog ContractInstanceMsg t
m      -> TracingVerbosity -> ContractInstanceMsg t -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
v ContractInstanceMsg t
m
        UserLog Text
t                  -> TracingVerbosity -> Text -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
v Text
t
        BeamLogItem BeamLog
b              -> TracingVerbosity -> BeamLog -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
v BeamLog
b
        PABMultiAgentMsg t
RestoringPABState          -> Text -> () -> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr Text
"Restoring PAB state ..." ()
        PABStateRestored Int
n         -> Text -> () -> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr ( Text
"PAB state restored with "
                                                 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
                                                 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" contract instance(s)."
                                                  ) ()
        StartingPABBackendServer Int
i -> Text -> Tagged "port" Int -> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr Text
"starting backend server" (Int -> Tagged "port" Int
forall k (s :: k) b. b -> Tagged s b
Tagged @"port" Int
i)
        WalletBalancingMsg Wallet
w TxBalanceMsg
m     -> Text
-> (Tagged "wallet" Wallet, Tagged "message" TxBalanceMsg)
-> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr Text
"balancing" (Wallet -> Tagged "wallet" Wallet
forall k (s :: k) b. b -> Tagged s b
Tagged @"wallet" Wallet
w, TxBalanceMsg -> Tagged "message" TxBalanceMsg
forall k (s :: k) b. b -> Tagged s b
Tagged @"message" TxBalanceMsg
m)
        WalletClient WalletClientMsg
m -> TracingVerbosity -> WalletClientMsg -> Object
forall a. ToObject a => TracingVerbosity -> a -> Object
toObject TracingVerbosity
v WalletClientMsg
m

deriving stock instance (Show (ContractDef t)) => Show (PABMultiAgentMsg t)
deriving anyclass instance (ToJSON (ContractDef t)) => ToJSON (PABMultiAgentMsg t)
deriving anyclass instance (FromJSON (ContractDef t)) => FromJSON (PABMultiAgentMsg t)

instance Pretty (ContractDef t) => Pretty (PABMultiAgentMsg t) where
    pretty :: PABMultiAgentMsg t -> Doc ann
pretty = \case
        EmulatorMsg EmulatorEvent
m         -> EmulatorEvent -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty EmulatorEvent
m
        ContractInstanceLog ContractInstanceMsg t
m -> ContractInstanceMsg t -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceMsg t
m
        UserLog Text
m             -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
m
        BeamLogItem BeamLog
b         -> BeamLog -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty BeamLog
b
        PABMultiAgentMsg t
RestoringPABState     -> Doc ann
"Restoring PAB state ..."
        PABStateRestored Int
0    -> Doc ann
"No contract instance were restored in the PAB state."
        PABStateRestored Int
1    -> Doc ann
"PAB state restored with 1 contract instance."
        PABStateRestored Int
n    -> Doc ann
"PAB state restored with"
                              Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
n
                              Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"contract instances."
        StartingPABBackendServer Int
port ->
            Doc ann
"Starting PAB backend server on port" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
port
        WalletBalancingMsg Wallet
w TxBalanceMsg
m -> Wallet -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Wallet
w Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TxBalanceMsg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TxBalanceMsg
m
        WalletClient WalletClientMsg
m -> WalletClientMsg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty WalletClientMsg
m

data CoreMsg t =
    FindingContract ContractInstanceId
    | FoundContract (Maybe (ContractResponse Value Value PABResp PABReq))
    | ConnectingToAlonzoNode PABServerConfig C.SlotNo
    deriving stock (forall x. CoreMsg t -> Rep (CoreMsg t) x)
-> (forall x. Rep (CoreMsg t) x -> CoreMsg t)
-> Generic (CoreMsg t)
forall x. Rep (CoreMsg t) x -> CoreMsg t
forall x. CoreMsg t -> Rep (CoreMsg t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t x. Rep (CoreMsg t) x -> CoreMsg t
forall t x. CoreMsg t -> Rep (CoreMsg t) x
$cto :: forall t x. Rep (CoreMsg t) x -> CoreMsg t
$cfrom :: forall t x. CoreMsg t -> Rep (CoreMsg t) x
Generic

deriving stock instance (Show (ContractDef t)) => Show (CoreMsg t)
deriving anyclass instance (ToJSON (ContractDef t)) => ToJSON (CoreMsg t)
deriving anyclass instance (FromJSON (ContractDef t)) => FromJSON (CoreMsg t)

instance Pretty (ContractDef t) => Pretty (CoreMsg t) where
    pretty :: CoreMsg t -> Doc ann
pretty = \case
        FindingContract ContractInstanceId
i      -> Doc ann
"Finding contract" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractInstanceId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceId
i
        FoundContract Maybe (ContractResponse Value Value PABResp PABReq)
c        -> Doc ann
"Found contract" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Maybe (ContractResponse Value Value PABResp PABReq) -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Maybe (ContractResponse Value Value PABResp PABReq)
c
        ConnectingToAlonzoNode PABServerConfig
config SlotNo
slotNo ->
                Doc ann
"Connecting to Alonzo node with config:"
            Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Doc ann
forall ann. Doc ann
line
            Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  PABServerConfig -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty PABServerConfig
config
            Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Doc ann
forall ann. Doc ann
line
            Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Doc ann
"The tip of the local node:"
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> SlotNo -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow SlotNo
slotNo

instance (StructuredLog (ContractDef t), ToJSON (ContractDef t)) => ToObject (CoreMsg t) where
    toObject :: TracingVerbosity -> CoreMsg t -> Object
toObject TracingVerbosity
v = \case
        FindingContract ContractInstanceId
instanceID ->
            Text -> ContractInstanceId -> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr Text
"finding contract instance" ContractInstanceId
instanceID
        FoundContract Maybe (ContractResponse Value Value PABResp PABReq)
state ->
            Text
-> Either
     (Tagged
        "contract" (Maybe (ContractResponse Value Value PABResp PABReq)))
     ()
-> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr Text
"found contract" (Either
   (Tagged
      "contract" (Maybe (ContractResponse Value Value PABResp PABReq)))
   ()
 -> Object)
-> Either
     (Tagged
        "contract" (Maybe (ContractResponse Value Value PABResp PABReq)))
     ()
-> Object
forall a b. (a -> b) -> a -> b
$
                case TracingVerbosity
v of
                    TracingVerbosity
MaximalVerbosity -> Tagged
  "contract" (Maybe (ContractResponse Value Value PABResp PABReq))
-> Either
     (Tagged
        "contract" (Maybe (ContractResponse Value Value PABResp PABReq)))
     ()
forall a b. a -> Either a b
Left (Maybe (ContractResponse Value Value PABResp PABReq)
-> Tagged
     "contract" (Maybe (ContractResponse Value Value PABResp PABReq))
forall k (s :: k) b. b -> Tagged s b
Tagged @"contract" Maybe (ContractResponse Value Value PABResp PABReq)
state)
                    TracingVerbosity
_                -> ()
-> Either
     (Tagged
        "contract" (Maybe (ContractResponse Value Value PABResp PABReq)))
     ()
forall a b. b -> Either a b
Right ()
        ConnectingToAlonzoNode PABServerConfig
_ SlotNo
_ -> Text -> () -> Object
forall k. StructuredLog k => Text -> k -> Object
mkObjectStr Text
"Connecting to Alonzo node" ()

newtype RequestSize = RequestSize Int
    deriving stock (Int -> RequestSize -> ShowS
[RequestSize] -> ShowS
RequestSize -> String
(Int -> RequestSize -> ShowS)
-> (RequestSize -> String)
-> ([RequestSize] -> ShowS)
-> Show RequestSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestSize] -> ShowS
$cshowList :: [RequestSize] -> ShowS
show :: RequestSize -> String
$cshow :: RequestSize -> String
showsPrec :: Int -> RequestSize -> ShowS
$cshowsPrec :: Int -> RequestSize -> ShowS
Show)
    deriving newtype ([RequestSize] -> Value
[RequestSize] -> Encoding
RequestSize -> Value
RequestSize -> Encoding
(RequestSize -> Value)
-> (RequestSize -> Encoding)
-> ([RequestSize] -> Value)
-> ([RequestSize] -> Encoding)
-> ToJSON RequestSize
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RequestSize] -> Encoding
$ctoEncodingList :: [RequestSize] -> Encoding
toJSONList :: [RequestSize] -> Value
$ctoJSONList :: [RequestSize] -> Value
toEncoding :: RequestSize -> Encoding
$ctoEncoding :: RequestSize -> Encoding
toJSON :: RequestSize -> Value
$ctoJSON :: RequestSize -> Value
ToJSON, Value -> Parser [RequestSize]
Value -> Parser RequestSize
(Value -> Parser RequestSize)
-> (Value -> Parser [RequestSize]) -> FromJSON RequestSize
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RequestSize]
$cparseJSONList :: Value -> Parser [RequestSize]
parseJSON :: Value -> Parser RequestSize
$cparseJSON :: Value -> Parser RequestSize
FromJSON)

instance Pretty RequestSize where
    pretty :: RequestSize -> Doc ann
pretty (RequestSize Int
i) = Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"bytes"