{-# LANGUAGE DuplicateRecordFields #-}

module Hydra.TUI.RenderMessage (
  RenderedMessage (..),
  renderMessage,
  toLogMessage,
) where

import Hydra.Prelude

import Cardano.Api.UTxO qualified as UTxO
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Encoding qualified as TLE
import Hydra.API.ClientInput (ClientInput (..))
import Hydra.API.ServerOutput (
  ApiMessage (..),
  ClientMessage (..),
  DecommitInvalidReason (..),
  Greetings (..),
  InvalidInput (..),
  ServerOutput (..),
  TimedServerOutput (..),
 )
import Hydra.Cardano.Api hiding (Active, txId)
import Hydra.Chain (PostTxError (..), failureReason, reason, redeemerPtr)
import Hydra.Chain.Direct.State ()
import Hydra.TUI.Drawing.Utils (prettyHeadId, prettyTxId)
import Hydra.TUI.Logging.Types (LogMessage (..), Severity (..))
import Hydra.Tx (HeadId, Snapshot (..), SnapshotNumber, txId)

-- | A fully-rendered API message, ready to be turned into a 'LogMessage'.
-- The three representations are kept separate so the TUI can show a short
-- summary in lists, a structured detail view, and the raw JSON when the user
-- toggles the detail pane.
data RenderedMessage = RenderedMessage
  { RenderedMessage -> Severity
rmSeverity :: Severity
  , RenderedMessage -> UTCTime
rmTime :: UTCTime
  , RenderedMessage -> Text
rmSummary :: Text
  , RenderedMessage -> Text
rmDetail :: Text
  , RenderedMessage -> Text
rmRawJson :: Text
  }

-- | Convert a 'RenderedMessage' to a 'LogMessage'.
toLogMessage :: RenderedMessage -> LogMessage
toLogMessage :: RenderedMessage -> LogMessage
toLogMessage RenderedMessage{Severity
$sel:rmSeverity:RenderedMessage :: RenderedMessage -> Severity
rmSeverity :: Severity
rmSeverity, UTCTime
$sel:rmTime:RenderedMessage :: RenderedMessage -> UTCTime
rmTime :: UTCTime
rmTime, Text
$sel:rmSummary:RenderedMessage :: RenderedMessage -> Text
rmSummary :: Text
rmSummary, Text
$sel:rmDetail:RenderedMessage :: RenderedMessage -> Text
rmDetail :: Text
rmDetail, Text
$sel:rmRawJson:RenderedMessage :: RenderedMessage -> Text
rmRawJson :: Text
rmRawJson} =
  LogMessage
    { severity :: Severity
severity = Severity
rmSeverity
    , message :: Text
message = Text
rmSummary
    , detail :: Text
detail = Text
rmDetail
    , time :: UTCTime
time = UTCTime
rmTime
    , rawJson :: Text
rawJson = Text
rmRawJson
    }

-- | Render any API message into its three representations: summary, detail, raw JSON.
renderMessage :: UTCTime -> ApiMessage Tx -> RenderedMessage
renderMessage :: UTCTime -> ApiMessage Tx -> RenderedMessage
renderMessage UTCTime
now = \case
  ApiTimedServerOutput tso :: TimedServerOutput Tx
tso@TimedServerOutput{UTCTime
time :: UTCTime
$sel:time:TimedServerOutput :: forall tx. TimedServerOutput tx -> UTCTime
time, ServerOutput Tx
output :: ServerOutput Tx
$sel:output:TimedServerOutput :: forall tx. TimedServerOutput tx -> ServerOutput tx
output} ->
    UTCTime -> ServerOutput Tx -> Text -> RenderedMessage
renderServerOutput UTCTime
time ServerOutput Tx
output (TimedServerOutput Tx -> Text
forall a. ToJSON a => a -> Text
encodeJson TimedServerOutput Tx
tso)
  ApiClientMessage ClientMessage Tx
msg ->
    UTCTime -> ClientMessage Tx -> Text -> RenderedMessage
renderClientMessage UTCTime
now ClientMessage Tx
msg (ClientMessage Tx -> Text
forall a. ToJSON a => a -> Text
encodeJson ClientMessage Tx
msg)
  ApiGreetings Greetings Tx
g ->
    UTCTime -> Greetings Tx -> Text -> RenderedMessage
renderGreetings UTCTime
now Greetings Tx
g (Greetings Tx -> Text
forall a. ToJSON a => a -> Text
encodeJson Greetings Tx
g)
  ApiInvalidInput InvalidInput
ii ->
    UTCTime -> InvalidInput -> Text -> RenderedMessage
renderInvalidInput UTCTime
now InvalidInput
ii (InvalidInput -> Text
forall a. ToJSON a => a -> Text
encodeJson InvalidInput
ii)

-- ---------------------------------------------------------------------------
-- Internal helpers
-- ---------------------------------------------------------------------------

encodeJson :: ToJSON a => a -> Text
encodeJson :: forall a. ToJSON a => a -> Text
encodeJson = LazyText -> Text
TL.toStrict (LazyText -> Text) -> (a -> LazyText) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LazyText
TLE.decodeUtf8 (ByteString -> LazyText) -> (a -> ByteString) -> a -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (Value -> ByteString) -> (a -> Value) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON

mk :: Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk :: Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk Severity
sev UTCTime
t Text
summary [Text]
detailLines Text
raw =
  RenderedMessage
    { $sel:rmSeverity:RenderedMessage :: Severity
rmSeverity = Severity
sev
    , $sel:rmTime:RenderedMessage :: UTCTime
rmTime = UTCTime
t
    , $sel:rmSummary:RenderedMessage :: Text
rmSummary = Text
summary
    , $sel:rmDetail:RenderedMessage :: Text
rmDetail = Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
detailLines
    , $sel:rmRawJson:RenderedMessage :: Text
rmRawJson = Text
raw
    }

fld :: Text -> Text -> Text
fld :: Text -> Text -> Text
fld Text
lbl Text
val = Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
val

-- ---------------------------------------------------------------------------
-- ServerOutput (29 constructors)
-- ---------------------------------------------------------------------------

renderServerOutput :: UTCTime -> ServerOutput Tx -> Text -> RenderedMessage
renderServerOutput :: UTCTime -> ServerOutput Tx -> Text -> RenderedMessage
renderServerOutput UTCTime
time ServerOutput Tx
output Text
raw = case ServerOutput Tx
output of
  ServerOutput Tx
NetworkConnected ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk Severity
Success UTCTime
time Text
"Network connected" [Text
"Network connected successfully."] Text
raw
  ServerOutput Tx
NetworkDisconnected ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk Severity
Error UTCTime
time Text
"Network disconnected" [Text
"Lost connection to the network."] Text
raw
  NetworkVersionMismatch{ProtocolVersion
ourVersion :: ProtocolVersion
$sel:ourVersion:NetworkConnected :: forall tx. ServerOutput tx -> ProtocolVersion
ourVersion, Maybe ProtocolVersion
theirVersion :: Maybe ProtocolVersion
$sel:theirVersion:NetworkConnected :: forall tx. ServerOutput tx -> Maybe ProtocolVersion
theirVersion} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Error
      UTCTime
time
      Text
"Network version mismatch"
      [ Text -> Text -> Text
fld Text
"Our version" (ProtocolVersion -> Text
forall b a. (Show a, IsString b) => a -> b
show ProtocolVersion
ourVersion)
      , Text -> Text -> Text
fld Text
"Their version" (Text -> (ProtocolVersion -> Text) -> Maybe ProtocolVersion -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"(unknown)" ProtocolVersion -> Text
forall b a. (Show a, IsString b) => a -> b
show Maybe ProtocolVersion
theirVersion)
      , Text
"Check that all nodes run compatible versions."
      ]
      Text
raw
  NetworkClusterIDMismatch{Text
clusterPeers :: Text
$sel:clusterPeers:NetworkConnected :: forall tx. ServerOutput tx -> Text
clusterPeers, Text
misconfiguredPeers :: Text
$sel:misconfiguredPeers:NetworkConnected :: forall tx. ServerOutput tx -> Text
misconfiguredPeers} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Error
      UTCTime
time
      Text
"Network cluster ID mismatch"
      [ Text -> Text -> Text
fld Text
"Cluster peers" Text
clusterPeers
      , Text -> Text -> Text
fld Text
"Misconfigured peers" Text
misconfiguredPeers
      ]
      Text
raw
  PeerConnected{Host
peer :: Host
$sel:peer:NetworkConnected :: forall tx. ServerOutput tx -> Host
peer} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk Severity
Info UTCTime
time (Text
"Peer connected: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Host -> Text
forall b a. (Show a, IsString b) => a -> b
show Host
peer) [Text -> Text -> Text
fld Text
"Peer" (Host -> Text
forall b a. (Show a, IsString b) => a -> b
show Host
peer)] Text
raw
  PeerDisconnected{Host
$sel:peer:NetworkConnected :: forall tx. ServerOutput tx -> Host
peer :: Host
peer} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk Severity
Error UTCTime
time (Text
"Peer disconnected: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Host -> Text
forall b a. (Show a, IsString b) => a -> b
show Host
peer) [Text -> Text -> Text
fld Text
"Peer" (Host -> Text
forall b a. (Show a, IsString b) => a -> b
show Host
peer)] Text
raw
  HeadIsOpen{HeadId
headId :: HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId, [Party]
parties :: [Party]
$sel:parties:NetworkConnected :: forall tx. ServerOutput tx -> [Party]
parties} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Success
      UTCTime
time
      Text
"Head is open"
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> Text -> Text
fld Text
"Parties" (Int -> Text
forall b a. (Show a, IsString b) => a -> b
show ([Party] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Party]
parties))
      ]
      Text
raw
  HeadIsClosed{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, SnapshotNumber
snapshotNumber :: SnapshotNumber
$sel:snapshotNumber:NetworkConnected :: forall tx. ServerOutput tx -> SnapshotNumber
snapshotNumber, UTCTime
contestationDeadline :: UTCTime
$sel:contestationDeadline:NetworkConnected :: forall tx. ServerOutput tx -> UTCTime
contestationDeadline} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Info
      UTCTime
time
      (Text
"Head closed at snapshot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SnapshotNumber -> Text
forall b a. (Show a, IsString b) => a -> b
show SnapshotNumber
snapshotNumber)
      (HeadId -> SnapshotNumber -> UTCTime -> [Text]
closedDetails HeadId
headId SnapshotNumber
snapshotNumber UTCTime
contestationDeadline [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"Submit a contest transaction before the deadline to challenge."])
      Text
raw
  HeadIsContested{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, SnapshotNumber
$sel:snapshotNumber:NetworkConnected :: forall tx. ServerOutput tx -> SnapshotNumber
snapshotNumber :: SnapshotNumber
snapshotNumber, UTCTime
$sel:contestationDeadline:NetworkConnected :: forall tx. ServerOutput tx -> UTCTime
contestationDeadline :: UTCTime
contestationDeadline} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Info
      UTCTime
time
      (Text
"Head contested at snapshot " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SnapshotNumber -> Text
forall b a. (Show a, IsString b) => a -> b
show SnapshotNumber
snapshotNumber)
      (HeadId -> SnapshotNumber -> UTCTime -> [Text]
closedDetails HeadId
headId SnapshotNumber
snapshotNumber UTCTime
contestationDeadline)
      Text
raw
  ReadyToFanout{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Success
      UTCTime
time
      Text
"Ready to fan out"
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text
"Contestation period has passed. You can now submit a fanout transaction."
      ]
      Text
raw
  HeadPartiallyFannedOut{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, UTxOType Tx
distributedUTxO :: UTxOType Tx
$sel:distributedUTxO:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
distributedUTxO, UTxOType Tx
remainingUTxO :: UTxOType Tx
$sel:remainingUTxO:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
remainingUTxO} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Success
      UTCTime
time
      Text
"Head partially fanned out"
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> Text -> Text
fld Text
"Distributed outputs" (Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (UTxO -> Int
forall era. UTxO era -> Int
UTxO.size UTxO
UTxOType Tx
distributedUTxO))
      , Text -> Text -> Text
fld Text
"Remaining outputs" (Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (UTxO -> Int
forall era. UTxO era -> Int
UTxO.size UTxO
UTxOType Tx
remainingUTxO))
      ]
      Text
raw
  HeadIsFinalized{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, UTxOType Tx
finalizedUTxO :: UTxOType Tx
$sel:finalizedUTxO:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
finalizedUTxO} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Success
      UTCTime
time
      Text
"Head finalized"
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> Text -> Text
fld Text
"Distributed outputs" (Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (UTxO -> Int
forall era. UTxO era -> Int
UTxO.size UTxO
UTxOType Tx
finalizedUTxO))
      ]
      Text
raw
  TxValid{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, TxIdType Tx
transactionId :: TxIdType Tx
$sel:transactionId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
transactionId} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Success
      UTCTime
time
      (Text
"Transaction " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
prettyTxId TxId
TxIdType Tx
transactionId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" valid")
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> Text -> Text
fld Text
"Transaction ID" (TxId -> Text
prettyTxId TxId
TxIdType Tx
transactionId)
      , Text
"Transaction accepted and will be included in the next snapshot."
      ]
      Text
raw
  TxInvalid{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, Tx
transaction :: Tx
$sel:transaction:NetworkConnected :: forall tx. ServerOutput tx -> tx
transaction, ValidationError
validationError :: ValidationError
$sel:validationError:NetworkConnected :: forall tx. ServerOutput tx -> ValidationError
validationError} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Error
      UTCTime
time
      (Text
"Transaction " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
prettyTxId (Tx -> TxIdType Tx
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx
transaction) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" invalid")
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> Text -> Text
fld Text
"Transaction ID" (TxId -> Text
prettyTxId (Tx -> TxIdType Tx
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx
transaction))
      , Text -> Text -> Text
fld Text
"Validation error" (ValidationError -> Text
forall b a. (Show a, IsString b) => a -> b
show ValidationError
validationError)
      ]
      Text
raw
  SnapshotConfirmed{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, $sel:snapshot:NetworkConnected :: forall tx. ServerOutput tx -> Snapshot tx
snapshot = Snapshot{SnapshotNumber
number :: SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number, SnapshotVersion
version :: SnapshotVersion
$sel:version:Snapshot :: forall tx. Snapshot tx -> SnapshotVersion
version, [Tx]
confirmed :: [Tx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [tx]
confirmed}} ->
    let txCount :: Int
txCount = [Tx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx]
confirmed
        countLabel :: Text
countLabel
          | Int
txCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text
" (empty)"
          | Int
txCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Text
" (1 transaction)"
          | Bool
otherwise = Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
txCount Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" transactions)"
     in Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
          Severity
Info
          UTCTime
time
          (Text
"Snapshot #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SnapshotNumber -> Text
forall b a. (Show a, IsString b) => a -> b
show SnapshotNumber
number Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SnapshotVersion -> Text
forall b a. (Show a, IsString b) => a -> b
show SnapshotVersion
version Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" confirmed" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
countLabel)
          ( [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
            , Text -> Text -> Text
fld Text
"Snapshot number" (SnapshotNumber -> Text
forall b a. (Show a, IsString b) => a -> b
show SnapshotNumber
number)
            , Text -> Text -> Text
fld Text
"Version" (SnapshotVersion -> Text
forall b a. (Show a, IsString b) => a -> b
show SnapshotVersion
version)
            , Text -> Text -> Text
fld Text
"Transactions" (if Int
txCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Text
"none" else Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
txCount)
            ]
              [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ((\Tx
tx -> Text
"  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
prettyTxId (Tx -> TxIdType Tx
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx
tx)) (Tx -> Text) -> [Tx] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx]
confirmed)
          )
          Text
raw
  IgnoredHeadInitializing{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, ContestationPeriod
contestationPeriod :: ContestationPeriod
$sel:contestationPeriod:NetworkConnected :: forall tx. ServerOutput tx -> ContestationPeriod
contestationPeriod, [Party]
$sel:parties:NetworkConnected :: forall tx. ServerOutput tx -> [Party]
parties :: [Party]
parties, [OnChainId]
participants :: [OnChainId]
$sel:participants:NetworkConnected :: forall tx. ServerOutput tx -> [OnChainId]
participants} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Info
      UTCTime
time
      Text
"Ignored head initializing"
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> Text -> Text
fld Text
"Contestation period" (ContestationPeriod -> Text
forall b a. (Show a, IsString b) => a -> b
show ContestationPeriod
contestationPeriod)
      , Text -> Text -> Text
fld Text
"Parties" (Int -> Text
forall b a. (Show a, IsString b) => a -> b
show ([Party] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Party]
parties))
      , Text -> Text -> Text
fld Text
"Participants" (Int -> Text
forall b a. (Show a, IsString b) => a -> b
show ([OnChainId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [OnChainId]
participants))
      , Text
"This node did not participate in the head initialization."
      ]
      Text
raw
  DecommitRequested{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, Tx
decommitTx :: Tx
$sel:decommitTx:NetworkConnected :: forall tx. ServerOutput tx -> tx
decommitTx, UTxOType Tx
utxoToDecommit :: UTxOType Tx
$sel:utxoToDecommit:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxoToDecommit} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Info
      UTCTime
time
      (Text
"Decommit requested: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
prettyTxId (Tx -> TxIdType Tx
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx
decommitTx))
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> Text -> Text
fld Text
"Decommit tx" (TxId -> Text
prettyTxId (Tx -> TxIdType Tx
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx
decommitTx))
      , Text -> UTxO -> Text
utxoBlock Text
"UTxO to decommit" UTxO
UTxOType Tx
utxoToDecommit
      ]
      Text
raw
  DecommitInvalid{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, Tx
$sel:decommitTx:NetworkConnected :: forall tx. ServerOutput tx -> tx
decommitTx :: Tx
decommitTx, DecommitInvalidReason Tx
decommitInvalidReason :: DecommitInvalidReason Tx
$sel:decommitInvalidReason:NetworkConnected :: forall tx. ServerOutput tx -> DecommitInvalidReason tx
decommitInvalidReason} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Error
      UTCTime
time
      (Text
"Decommit invalid: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
prettyTxId (Tx -> TxIdType Tx
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx
decommitTx))
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> Text -> Text
fld Text
"Decommit tx" (TxId -> Text
prettyTxId (Tx -> TxIdType Tx
forall tx. IsTx tx => tx -> TxIdType tx
txId Tx
decommitTx))
      , Text -> Text -> Text
fld Text
"Reason" (DecommitInvalidReason Tx -> Text
renderDecommitInvalidReason DecommitInvalidReason Tx
decommitInvalidReason)
      ]
      Text
raw
  DecommitApproved{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, TxIdType Tx
decommitTxId :: TxIdType Tx
$sel:decommitTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
decommitTxId, UTxOType Tx
$sel:utxoToDecommit:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxoToDecommit :: UTxOType Tx
utxoToDecommit} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Success
      UTCTime
time
      (Text
"Decommit approved: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
prettyTxId TxId
TxIdType Tx
decommitTxId)
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> Text -> Text
fld Text
"Decommit tx" (TxId -> Text
prettyTxId TxId
TxIdType Tx
decommitTxId)
      , Text -> UTxO -> Text
utxoBlock Text
"UTxO to decommit" UTxO
UTxOType Tx
utxoToDecommit
      ]
      Text
raw
  DecommitFinalized{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, UTxOType Tx
$sel:distributedUTxO:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
distributedUTxO :: UTxOType Tx
distributedUTxO} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Success
      UTCTime
time
      Text
"Decommit finalized"
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> UTxO -> Text
utxoBlock Text
"Distributed UTxO" UTxO
UTxOType Tx
distributedUTxO
      ]
      Text
raw
  CommitRecorded{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, UTxOType Tx
utxoToCommit :: UTxOType Tx
$sel:utxoToCommit:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxoToCommit, TxIdType Tx
pendingDeposit :: TxIdType Tx
$sel:pendingDeposit:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
pendingDeposit, UTCTime
deadline :: UTCTime
$sel:deadline:NetworkConnected :: forall tx. ServerOutput tx -> UTCTime
deadline} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Success
      UTCTime
time
      (Text
"Deposit recorded: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
prettyTxId TxId
TxIdType Tx
pendingDeposit)
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> Text -> Text
fld Text
"Deposit tx ID" (TxId -> Text
prettyTxId TxId
TxIdType Tx
pendingDeposit)
      , Text -> Text -> Text
fld Text
"Deadline" (UTCTime -> Text
forall b a. (Show a, IsString b) => a -> b
show UTCTime
deadline)
      , Text -> UTxO -> Text
utxoBlock Text
"UTxO to commit" UTxO
UTxOType Tx
utxoToCommit
      , Text
"Waiting for approval before funds enter the head."
      ]
      Text
raw
  DepositActivated{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, TxIdType Tx
depositTxId :: TxIdType Tx
$sel:depositTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
depositTxId, UTCTime
$sel:deadline:NetworkConnected :: forall tx. ServerOutput tx -> UTCTime
deadline :: UTCTime
deadline, UTCTime
chainTime :: UTCTime
$sel:chainTime:NetworkConnected :: forall tx. ServerOutput tx -> UTCTime
chainTime} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Info
      UTCTime
time
      (Text
"Deposit activated: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
prettyTxId TxId
TxIdType Tx
depositTxId)
      (HeadId -> TxId -> UTCTime -> UTCTime -> [Text]
depositDetails HeadId
headId TxId
TxIdType Tx
depositTxId UTCTime
deadline UTCTime
chainTime)
      Text
raw
  DepositExpired{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, TxIdType Tx
$sel:depositTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
depositTxId :: TxIdType Tx
depositTxId, UTCTime
$sel:deadline:NetworkConnected :: forall tx. ServerOutput tx -> UTCTime
deadline :: UTCTime
deadline, UTCTime
$sel:chainTime:NetworkConnected :: forall tx. ServerOutput tx -> UTCTime
chainTime :: UTCTime
chainTime} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Error
      UTCTime
time
      (Text
"Deposit expired: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
prettyTxId TxId
TxIdType Tx
depositTxId)
      (HeadId -> TxId -> UTCTime -> UTCTime -> [Text]
depositDetails HeadId
headId TxId
TxIdType Tx
depositTxId UTCTime
deadline UTCTime
chainTime [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"The deposit was not approved in time and has expired."])
      Text
raw
  CommitApproved{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, UTxOType Tx
$sel:utxoToCommit:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
utxoToCommit :: UTxOType Tx
utxoToCommit} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Success
      UTCTime
time
      Text
"Commit approved"
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> UTxO -> Text
utxoBlock Text
"UTxO committed" UTxO
UTxOType Tx
utxoToCommit
      ]
      Text
raw
  CommitFinalized{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, TxIdType Tx
$sel:depositTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
depositTxId :: TxIdType Tx
depositTxId} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Success
      UTCTime
time
      (Text
"Commit finalized: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
prettyTxId TxId
TxIdType Tx
depositTxId)
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> Text -> Text
fld Text
"Deposit tx ID" (TxId -> Text
prettyTxId TxId
TxIdType Tx
depositTxId)
      , Text
"Funds are now in the head."
      ]
      Text
raw
  CommitRecovered{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, UTxOType Tx
recoveredUTxO :: UTxOType Tx
$sel:recoveredUTxO:NetworkConnected :: forall tx. ServerOutput tx -> UTxOType tx
recoveredUTxO, TxIdType Tx
recoveredTxId :: TxIdType Tx
$sel:recoveredTxId:NetworkConnected :: forall tx. ServerOutput tx -> TxIdType tx
recoveredTxId} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Info
      UTCTime
time
      (Text
"Commit recovered: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
prettyTxId TxId
TxIdType Tx
recoveredTxId)
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> Text -> Text
fld Text
"Recovered tx ID" (TxId -> Text
prettyTxId TxId
TxIdType Tx
recoveredTxId)
      , Text -> UTxO -> Text
utxoBlock Text
"Recovered UTxO" UTxO
UTxOType Tx
recoveredUTxO
      , Text
"The pending deposit was recovered back to L1."
      ]
      Text
raw
  SnapshotSideLoaded{HeadId
$sel:headId:NetworkConnected :: forall tx. ServerOutput tx -> HeadId
headId :: HeadId
headId, SnapshotNumber
$sel:snapshotNumber:NetworkConnected :: forall tx. ServerOutput tx -> SnapshotNumber
snapshotNumber :: SnapshotNumber
snapshotNumber} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Info
      UTCTime
time
      (Text
"Snapshot #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SnapshotNumber -> Text
forall b a. (Show a, IsString b) => a -> b
show SnapshotNumber
snapshotNumber Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" side-loaded")
      [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
      , Text -> Text -> Text
fld Text
"Snapshot number" (SnapshotNumber -> Text
forall b a. (Show a, IsString b) => a -> b
show SnapshotNumber
snapshotNumber)
      , Text
"Local state reset; pending transactions pruned."
      ]
      Text
raw
  EventLogRotated{} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk Severity
Info UTCTime
time Text
"Checkpoint triggered" [Text
"Head state event log checkpoint triggered."] Text
raw
  NodeUnsynced{ChainSlot
chainSlot :: ChainSlot
$sel:chainSlot:NetworkConnected :: forall tx. ServerOutput tx -> ChainSlot
chainSlot, UTCTime
$sel:chainTime:NetworkConnected :: forall tx. ServerOutput tx -> UTCTime
chainTime :: UTCTime
chainTime, NominalDiffTime
drift :: NominalDiffTime
$sel:drift:NetworkConnected :: forall tx. ServerOutput tx -> NominalDiffTime
drift} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Error
      UTCTime
time
      Text
"Node out of sync"
      [ Text -> Text -> Text
fld Text
"Chain slot" (ChainSlot -> Text
forall b a. (Show a, IsString b) => a -> b
show ChainSlot
chainSlot)
      , Text -> Text -> Text
fld Text
"Chain time" (UTCTime -> Text
forall b a. (Show a, IsString b) => a -> b
show UTCTime
chainTime)
      , Text -> Text -> Text
fld Text
"Drift" (NominalDiffTime -> Text
forall b a. (Show a, IsString b) => a -> b
show NominalDiffTime
drift)
      , Text
"Node state is behind the chain backend. Transactions will be rejected."
      ]
      Text
raw
  NodeSynced{ChainSlot
$sel:chainSlot:NetworkConnected :: forall tx. ServerOutput tx -> ChainSlot
chainSlot :: ChainSlot
chainSlot, UTCTime
$sel:chainTime:NetworkConnected :: forall tx. ServerOutput tx -> UTCTime
chainTime :: UTCTime
chainTime, NominalDiffTime
$sel:drift:NetworkConnected :: forall tx. ServerOutput tx -> NominalDiffTime
drift :: NominalDiffTime
drift} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Info
      UTCTime
time
      Text
"Node back in sync"
      [ Text -> Text -> Text
fld Text
"Chain slot" (ChainSlot -> Text
forall b a. (Show a, IsString b) => a -> b
show ChainSlot
chainSlot)
      , Text -> Text -> Text
fld Text
"Chain time" (UTCTime -> Text
forall b a. (Show a, IsString b) => a -> b
show UTCTime
chainTime)
      , Text -> Text -> Text
fld Text
"Drift" (NominalDiffTime -> Text
forall b a. (Show a, IsString b) => a -> b
show NominalDiffTime
drift)
      ]
      Text
raw

-- ---------------------------------------------------------------------------
-- ClientMessage (4 constructors)
-- ---------------------------------------------------------------------------

renderClientMessage :: UTCTime -> ClientMessage Tx -> Text -> RenderedMessage
renderClientMessage :: UTCTime -> ClientMessage Tx -> Text -> RenderedMessage
renderClientMessage UTCTime
now ClientMessage Tx
msg Text
raw = case ClientMessage Tx
msg of
  CommandFailed{ClientInput Tx
clientInput :: ClientInput Tx
$sel:clientInput:CommandFailed :: forall tx. ClientMessage tx -> ClientInput tx
clientInput} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Error
      UTCTime
now
      (Text
"Invalid command: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ClientInput Tx -> Text
forall b a. (Show a, IsString b) => a -> b
show ClientInput Tx
clientInput)
      [ Text -> Text -> Text
fld Text
"Command" (ClientInput Tx -> Text
forall b a. (Show a, IsString b) => a -> b
show ClientInput Tx
clientInput)
      , case ClientInput Tx
clientInput of
          ClientInput Tx
Fanout ->
            Text
"A partial fanout is already in progress for this head — use Partial fanout [P] to continue draining it."
          PartialFanout{} ->
            Text
"Invalid selection: the head is not ready to fan out, or the chosen UTxO is not part of what remains."
          ClientInput Tx
_ -> Text
"This command is not valid in the current head state."
      ]
      Text
raw
  PostTxOnChainFailed{PostTxError Tx
postTxError :: PostTxError Tx
$sel:postTxError:CommandFailed :: forall tx. ClientMessage tx -> PostTxError tx
postTxError} ->
    let summary :: Text
summary = case PostTxError Tx
postTxError of
          NotEnoughFuel Tx
_ ->
            Text
"Not enough Fuel. Please provide more to the internal wallet and try again."
          PostTxError Tx
_ -> Text
"On-chain transaction failed"
     in Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk Severity
Error UTCTime
now Text
summary (PostTxError Tx -> [Text]
renderPostTxError PostTxError Tx
postTxError) Text
raw
  RejectedInputBecauseUnsynced{ClientInput Tx
$sel:clientInput:CommandFailed :: forall tx. ClientMessage tx -> ClientInput tx
clientInput :: ClientInput Tx
clientInput, NominalDiffTime
drift :: NominalDiffTime
$sel:drift:CommandFailed :: forall tx. ClientMessage tx -> NominalDiffTime
drift} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Error
      UTCTime
now
      Text
"Command rejected: node not synced"
      [ Text -> Text -> Text
fld Text
"Command" (ClientInput Tx -> Text
forall b a. (Show a, IsString b) => a -> b
show ClientInput Tx
clientInput)
      , Text -> Text -> Text
fld Text
"Sync drift" (NominalDiffTime -> Text
forall b a. (Show a, IsString b) => a -> b
show NominalDiffTime
drift)
      , Text
"Wait for the node to catch up with the chain before retrying."
      ]
      Text
raw
  SideLoadSnapshotRejected{ClientInput Tx
$sel:clientInput:CommandFailed :: forall tx. ClientMessage tx -> ClientInput tx
clientInput :: ClientInput Tx
clientInput, SideLoadRequirementFailure Tx
requirementFailure :: SideLoadRequirementFailure Tx
$sel:requirementFailure:CommandFailed :: forall tx. ClientMessage tx -> SideLoadRequirementFailure tx
requirementFailure} ->
    Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
      Severity
Error
      UTCTime
now
      Text
"Side-load snapshot rejected"
      [ Text -> Text -> Text
fld Text
"Command" (ClientInput Tx -> Text
forall b a. (Show a, IsString b) => a -> b
show ClientInput Tx
clientInput)
      , Text -> Text -> Text
fld Text
"Failure" (SideLoadRequirementFailure Tx -> Text
forall b a. (Show a, IsString b) => a -> b
show SideLoadRequirementFailure Tx
requirementFailure)
      ]
      Text
raw

-- ---------------------------------------------------------------------------
-- Greetings
-- ---------------------------------------------------------------------------

renderGreetings :: UTCTime -> Greetings Tx -> Text -> RenderedMessage
renderGreetings :: UTCTime -> Greetings Tx -> Text -> RenderedMessage
renderGreetings UTCTime
now Greetings{Party
me :: Party
$sel:me:Greetings :: forall tx. Greetings tx -> Party
me, HeadStatus
headStatus :: HeadStatus
$sel:headStatus:Greetings :: forall tx. Greetings tx -> HeadStatus
headStatus, Maybe HeadId
hydraHeadId :: Maybe HeadId
$sel:hydraHeadId:Greetings :: forall tx. Greetings tx -> Maybe HeadId
hydraHeadId, [Char]
hydraNodeVersion :: [Char]
$sel:hydraNodeVersion:Greetings :: forall tx. Greetings tx -> [Char]
hydraNodeVersion, SyncedStatus
chainSyncedStatus :: SyncedStatus
$sel:chainSyncedStatus:Greetings :: forall tx. Greetings tx -> SyncedStatus
chainSyncedStatus} =
  Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
    Severity
Info
    UTCTime
now
    (Text
"Connected to hydra-node " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a. ToText a => a -> Text
toText [Char]
hydraNodeVersion)
    ( [ Text -> Text -> Text
fld Text
"Node version" ([Char] -> Text
forall a. ToText a => a -> Text
toText [Char]
hydraNodeVersion)
      , Text -> Text -> Text
fld Text
"Party" (Party -> Text
forall b a. (Show a, IsString b) => a -> b
show Party
me)
      , Text -> Text -> Text
fld Text
"Head status" (HeadStatus -> Text
forall b a. (Show a, IsString b) => a -> b
show HeadStatus
headStatus)
      , Text -> Text -> Text
fld Text
"Chain sync" (SyncedStatus -> Text
forall b a. (Show a, IsString b) => a -> b
show SyncedStatus
chainSyncedStatus)
      ]
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> (HeadId -> [Text]) -> Maybe HeadId -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\HeadId
hid -> [Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
hid)]) Maybe HeadId
hydraHeadId
    )

-- ---------------------------------------------------------------------------
-- InvalidInput
-- ---------------------------------------------------------------------------

renderInvalidInput :: UTCTime -> InvalidInput -> Text -> RenderedMessage
renderInvalidInput :: UTCTime -> InvalidInput -> Text -> RenderedMessage
renderInvalidInput UTCTime
now InvalidInput{[Char]
reason :: [Char]
$sel:reason:InvalidInput :: InvalidInput -> [Char]
reason, Text
input :: Text
$sel:input:InvalidInput :: InvalidInput -> Text
input} =
  Severity -> UTCTime -> Text -> [Text] -> Text -> RenderedMessage
mk
    Severity
Error
    UTCTime
now
    Text
"Invalid input"
    [ Text -> Text -> Text
fld Text
"Reason" ([Char] -> Text
forall a. ToText a => a -> Text
toText [Char]
reason)
    , Text -> Text -> Text
fld Text
"Input" Text
input
    ]

-- ---------------------------------------------------------------------------
-- Utilities
-- ---------------------------------------------------------------------------

-- | Render a UTxO map as a labelled block: "Label:\n  txin ↦ ₳ X.XXXXXX\n  ...".
-- Embeds newlines so it can be used as a single item in a detail-lines list.
utxoBlock :: Text -> UTxO -> Text
utxoBlock :: Text -> UTxO -> Text
utxoBlock Text
lbl UTxO
u
  | [(TxIn, TxOut CtxUTxO Era)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(TxIn, TxOut CtxUTxO Era)]
entries = Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": (none)"
  | Bool
otherwise = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":") Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((Text
"  " <>) (Text -> Text)
-> ((TxIn, TxOut CtxUTxO Era) -> Text)
-> (TxIn, TxOut CtxUTxO Era)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, TxOut CtxUTxO Era) -> Text
renderUTxOEntry ((TxIn, TxOut CtxUTxO Era) -> Text)
-> [(TxIn, TxOut CtxUTxO Era)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxIn, TxOut CtxUTxO Era)]
entries)
 where
  entries :: [(TxIn, TxOut CtxUTxO Era)]
entries = UTxO -> [(TxIn, TxOut CtxUTxO Era)]
forall era. UTxO era -> [(TxIn, TxOut CtxUTxO era)]
UTxO.toList UTxO
u

-- | Render a UTxO entry as "txin ↦ ₳ X.XXXXXX" (full txin, ADA-denominated).
renderUTxOEntry :: (TxIn, TxOut CtxUTxO) -> Text
renderUTxOEntry :: (TxIn, TxOut CtxUTxO Era) -> Text
renderUTxOEntry (TxIn
txin, TxOut AddressInEra
_ Value
val TxOutDatum CtxUTxO
_ ReferenceScript
_) =
  let Coin Integer
l = Value -> Coin
selectLovelace Value
val
      (Integer
ada, Integer
frac) = Integer -> Integer
forall a. Num a => a -> a
abs Integer
l Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
1_000_000
      fracStr :: [Char]
fracStr = Integer -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Integer
frac
      padded :: Text
padded = Int -> Text -> Text
T.replicate (Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
fracStr) Text
"0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
fracStr
      sign :: Text
sign = if Integer
l Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Text
"-" else Text
""
   in TxIn -> Text
renderTxIn TxIn
txin Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ↦ ₳ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sign Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Integer -> [Char]
forall b a. (Show a, IsString b) => a -> b
show Integer
ada) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
padded

renderDecommitInvalidReason :: DecommitInvalidReason Tx -> Text
renderDecommitInvalidReason :: DecommitInvalidReason Tx -> Text
renderDecommitInvalidReason = \case
  DecommitTxInvalid{ValidationError
validationError :: ValidationError
$sel:validationError:DecommitTxInvalid :: forall tx. DecommitInvalidReason tx -> ValidationError
validationError} -> Text
"Transaction invalid: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ValidationError -> Text
forall b a. (Show a, IsString b) => a -> b
show ValidationError
validationError
  DecommitAlreadyInFlight{TxIdType Tx
otherDecommitTxId :: TxIdType Tx
$sel:otherDecommitTxId:DecommitTxInvalid :: forall tx. DecommitInvalidReason tx -> TxIdType tx
otherDecommitTxId} -> Text
"Another decommit already in flight: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
forall b a. (Show a, IsString b) => a -> b
show TxId
TxIdType Tx
otherDecommitTxId
  DepositInFlight{TxIdType Tx
depositTxId :: TxIdType Tx
$sel:depositTxId:DecommitTxInvalid :: forall tx. DecommitInvalidReason tx -> TxIdType tx
depositTxId} -> Text
"A deposit is in flight, recover or await it first: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxId -> Text
forall b a. (Show a, IsString b) => a -> b
show TxId
TxIdType Tx
depositTxId

renderPostTxError :: PostTxError Tx -> [Text]
renderPostTxError :: PostTxError Tx -> [Text]
renderPostTxError = \case
  NotEnoughFuel Tx
_ ->
    [ Text
"Not enough fuel."
    , Text
"Add ADA to the internal wallet and try again."
    ]
  InternalWalletError{Text
$sel:reason:NoSeedInput :: forall tx. PostTxError tx -> Text
reason :: Text
reason} ->
    [ Text -> Text -> Text
fld Text
"Internal wallet error" Text
reason
    ]
  ScriptFailedInWallet{Text
$sel:redeemerPtr:NoSeedInput :: forall tx. PostTxError tx -> Text
redeemerPtr :: Text
redeemerPtr, Text
$sel:failureReason:NoSeedInput :: forall tx. PostTxError tx -> Text
failureReason :: Text
failureReason} ->
    [ Text
"Script execution failed in wallet."
    , Text -> Text -> Text
fld Text
"Redeemer" Text
redeemerPtr
    , Text -> Text -> Text
fld Text
"Reason" Text
failureReason
    ]
  FailedToPostTx{Text
$sel:failureReason:NoSeedInput :: forall tx. PostTxError tx -> Text
failureReason :: Text
failureReason} ->
    [ Text
"Failed to submit transaction to the chain."
    , Text -> Text -> Text
fld Text
"Reason" Text
failureReason
    ]
  FailedToConstructDepositTx{Text
$sel:failureReason:NoSeedInput :: forall tx. PostTxError tx -> Text
failureReason :: Text
failureReason} -> Text -> Maybe Text -> [Text]
failedToConstruct Text
"deposit" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
failureReason)
  FailedToConstructRecoverTx{Text
$sel:failureReason:NoSeedInput :: forall tx. PostTxError tx -> Text
failureReason :: Text
failureReason} -> Text -> Maybe Text -> [Text]
failedToConstruct Text
"recover" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
failureReason)
  FailedToConstructIncrementTx{Text
$sel:failureReason:NoSeedInput :: forall tx. PostTxError tx -> Text
failureReason :: Text
failureReason} -> Text -> Maybe Text -> [Text]
failedToConstruct Text
"increment" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
failureReason)
  FailedToConstructDecrementTx{Text
$sel:failureReason:NoSeedInput :: forall tx. PostTxError tx -> Text
failureReason :: Text
failureReason} -> Text -> Maybe Text -> [Text]
failedToConstruct Text
"decrement" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
failureReason)
  PostTxError Tx
FailedToConstructCloseTx -> Text -> Maybe Text -> [Text]
failedToConstruct Text
"close" Maybe Text
forall a. Maybe a
Nothing
  PostTxError Tx
FailedToConstructContestTx -> Text -> Maybe Text -> [Text]
failedToConstruct Text
"contest" Maybe Text
forall a. Maybe a
Nothing
  PostTxError Tx
FailedToConstructFanoutTx -> Text -> Maybe Text -> [Text]
failedToConstruct Text
"fanout" Maybe Text
forall a. Maybe a
Nothing
  PostTxError Tx
err ->
    [ Text -> Text -> Text
fld Text
"On-chain error" (PostTxError Tx -> Text
forall b a. (Show a, IsString b) => a -> b
show PostTxError Tx
err)
    ]

failedToConstruct :: Text -> Maybe Text -> [Text]
failedToConstruct :: Text -> Maybe Text -> [Text]
failedToConstruct Text
name Maybe Text
reason =
  (Text
"Failed to construct " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" transaction.") Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
r -> [Text -> Text -> Text
fld Text
"Reason" Text
r]) Maybe Text
reason

closedDetails :: HeadId -> SnapshotNumber -> UTCTime -> [Text]
closedDetails :: HeadId -> SnapshotNumber -> UTCTime -> [Text]
closedDetails HeadId
headId SnapshotNumber
snapshotNumber UTCTime
contestationDeadline =
  [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
  , Text -> Text -> Text
fld Text
"Snapshot" (SnapshotNumber -> Text
forall b a. (Show a, IsString b) => a -> b
show SnapshotNumber
snapshotNumber)
  , Text -> Text -> Text
fld Text
"Contestation deadline" (UTCTime -> Text
forall b a. (Show a, IsString b) => a -> b
show UTCTime
contestationDeadline)
  ]

depositDetails :: HeadId -> TxId -> UTCTime -> UTCTime -> [Text]
depositDetails :: HeadId -> TxId -> UTCTime -> UTCTime -> [Text]
depositDetails HeadId
headId TxId
depositTxId UTCTime
deadline UTCTime
chainTime =
  [ Text -> Text -> Text
fld Text
"Head ID" (HeadId -> Text
prettyHeadId HeadId
headId)
  , Text -> Text -> Text
fld Text
"Deposit tx ID" (TxId -> Text
prettyTxId TxId
depositTxId)
  , Text -> Text -> Text
fld Text
"Deadline" (UTCTime -> Text
forall b a. (Show a, IsString b) => a -> b
show UTCTime
deadline)
  , Text -> Text -> Text
fld Text
"Chain time" (UTCTime -> Text
forall b a. (Show a, IsString b) => a -> b
show UTCTime
chainTime)
  ]