{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

-- | User-friendly pretty-printing for textual user interfaces (TUI)
module Cardano.CLI.Compatible.Json.Friendly
  ( -- * Functions in IO

  --
  -- Use them when writing to stdout or to files.
    friendlyTx
  , friendlyTxBody
  , friendlyProposal
  , friendlyDRep

    -- * Functions that are not in IO

  --
  -- They are more low-level, but can be used in any context.
  -- The '*Impl' functions give you access to the Aeson representation
  -- of various structures.
  , friendlyTxImpl
  , friendlyTxBodyImpl
  , friendlyProposalImpl
  )
where

import Cardano.Api as Api
import Cardano.Api.Experimental (obtainCommonConstraints)
import Cardano.Api.Experimental qualified as Exp
import Cardano.Api.Ledger (ExUnits (..), extractHash, strictMaybeToMaybe)
import Cardano.Api.Ledger qualified as Alonzo
import Cardano.Api.Ledger qualified as L
import Cardano.Api.Ledger qualified as Ledger

import Cardano.CLI.Json.Encode qualified as Json
import Cardano.CLI.Orphan ()
import Cardano.CLI.Type.Common (FormatJson (..), FormatYaml (..))
import Cardano.CLI.Type.MonadWarning (MonadWarning, runWarningIO)
import Cardano.Crypto.Hash (hashToTextAsHex)
import Cardano.Ledger.Api.Tx qualified as L
import Cardano.Ledger.Core qualified as C
import Cardano.Ledger.Credential (credKeyHash, credScriptHash)
import Cardano.Ledger.Keys (coerceKeyRole)

import Control.Applicative ((<|>))
import Data.Aeson (Value (..), object, (.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.Key qualified as Aeson
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types qualified as Aeson
import Data.ByteString.Char8 qualified as BSC
import Data.Char (isAscii)
import Data.Foldable (asum)
import Data.Function ((&))
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Set qualified as Set
import Data.Text qualified as T
import Data.Text qualified as Text
import Data.Typeable (Typeable)
import Data.Vector qualified as Vector
import Data.Yaml (array)
import GHC.Exts (IsList (..))
import GHC.Unicode (isAlphaNum)
import Lens.Micro ((^.))
import Vary (Vary)
import Vary qualified

friendly
  :: (MonadIO m, Aeson.ToJSON a)
  => Vary [FormatJson, FormatYaml]
  -> Maybe (File () Out)
  -> a
  -> m (Either (FileError e) ())
friendly :: forall (m :: * -> *) a e.
(MonadIO m, ToJSON a) =>
Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out) -> a -> m (Either (FileError e) ())
friendly Vary '[FormatJson, FormatYaml]
format Maybe (File () 'Out)
mOutFile a
value = do
  output <-
    ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[FormatJson, FormatYaml]
format
        Vary '[FormatJson, FormatYaml]
-> (Vary '[FormatJson, FormatYaml] -> a -> ByteString)
-> a
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatJson, FormatYaml] -> a -> ByteString)
-> Vary '[FormatJson, FormatYaml] -> a -> ByteString
forall a. a -> a
id
              ((Vary '[FormatJson, FormatYaml] -> a -> ByteString)
 -> Vary '[FormatJson, FormatYaml] -> a -> ByteString)
-> ((Vary '[] -> a -> ByteString)
    -> Vary '[FormatJson, FormatYaml] -> a -> ByteString)
-> (Vary '[] -> a -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> a -> ByteString)
-> (Vary '[FormatYaml] -> a -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> a
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> a -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeJson)
              ((Vary '[FormatYaml] -> a -> ByteString)
 -> Vary '[FormatJson, FormatYaml] -> a -> ByteString)
-> ((Vary '[] -> a -> ByteString)
    -> Vary '[FormatYaml] -> a -> ByteString)
-> (Vary '[] -> a -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> a -> ByteString)
-> (Vary '[] -> a -> ByteString)
-> Vary '[FormatYaml]
-> a
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> a -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encodeYaml)
              ((Vary '[] -> a -> ByteString)
 -> Vary '[FormatJson, FormatYaml] -> a -> ByteString)
-> (Vary '[] -> a -> ByteString)
-> Vary '[FormatJson, FormatYaml]
-> a
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> a -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
          )
      (a -> ByteString) -> a -> ByteString
forall a b. (a -> b) -> a -> b
$ a
value

  writeLazyByteStringOutput mOutFile output

friendlyTx
  :: MonadIO m
  => Vary [FormatJson, FormatYaml]
  -> Maybe (File () Out)
  -> Exp.Era era
  -> Exp.SignedTx era
  -> m (Either (FileError e) ())
friendlyTx :: forall (m :: * -> *) era e.
MonadIO m =>
Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> Era era
-> SignedTx era
-> m (Either (FileError e) ())
friendlyTx Vary '[FormatJson, FormatYaml]
format Maybe (File () 'Out)
mOutFile Era era
era SignedTx era
tx = do
  pairs <- WarningIO m [(Key, Value)] -> m [(Key, Value)]
forall (m :: * -> *) a. WarningIO m a -> m a
runWarningIO (WarningIO m [(Key, Value)] -> m [(Key, Value)])
-> WarningIO m [(Key, Value)] -> m [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ Era era -> SignedTx era -> WarningIO m [(Key, Value)]
forall (m :: * -> *) era.
MonadWarning m =>
Era era -> SignedTx era -> m [(Key, Value)]
friendlyTxImpl Era era
era SignedTx era
tx
  friendly format mOutFile $ object pairs

friendlyTxBody
  :: MonadIO m
  => Vary [FormatJson, FormatYaml]
  -> Maybe (File () Out)
  -> Exp.Era era
  -> Exp.UnsignedTx (Exp.LedgerEra era)
  -> m (Either (FileError e) ())
friendlyTxBody :: forall (m :: * -> *) era e.
MonadIO m =>
Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> Era era
-> UnsignedTx (LedgerEra era)
-> m (Either (FileError e) ())
friendlyTxBody Vary '[FormatJson, FormatYaml]
format Maybe (File () 'Out)
mOutFile Era era
era UnsignedTx (LedgerEra era)
unsignedTx = do
  pairs <- WarningIO m [(Key, Value)] -> m [(Key, Value)]
forall (m :: * -> *) a. WarningIO m a -> m a
runWarningIO (WarningIO m [(Key, Value)] -> m [(Key, Value)])
-> WarningIO m [(Key, Value)] -> m [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ Era era -> UnsignedTx (LedgerEra era) -> WarningIO m [(Key, Value)]
forall (m :: * -> *) era.
MonadWarning m =>
Era era -> UnsignedTx (LedgerEra era) -> m [(Key, Value)]
friendlyTxBodyImpl Era era
era UnsignedTx (LedgerEra era)
unsignedTx
  friendly format mOutFile $ object pairs

friendlyProposal
  :: MonadIO m
  => Exp.IsEra era
  => Vary [FormatJson, FormatYaml]
  -> Maybe (File () Out)
  -> Proposal era
  -> m (Either (FileError e) ())
friendlyProposal :: forall (m :: * -> *) era e.
(MonadIO m, IsEra era) =>
Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> Proposal era
-> m (Either (FileError e) ())
friendlyProposal Vary '[FormatJson, FormatYaml]
format Maybe (File () 'Out)
mOutFile =
  Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out) -> Value -> m (Either (FileError e) ())
forall (m :: * -> *) a e.
(MonadIO m, ToJSON a) =>
Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out) -> a -> m (Either (FileError e) ())
friendly Vary '[FormatJson, FormatYaml]
format Maybe (File () 'Out)
mOutFile (Value -> m (Either (FileError e) ()))
-> (Proposal era -> Value)
-> Proposal era
-> m (Either (FileError e) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Value
object ([(Key, Value)] -> Value)
-> (Proposal era -> [(Key, Value)]) -> Proposal era -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proposal era -> [(Key, Value)]
forall era. IsEra era => Proposal era -> [(Key, Value)]
friendlyProposalImpl

friendlyProposalImpl :: forall era. Exp.IsEra era => Proposal era -> [Aeson.Pair]
friendlyProposalImpl :: forall era. IsEra era => Proposal era -> [(Key, Value)]
friendlyProposalImpl
  ( Proposal
      ( L.ProposalProcedure
          { Coin
pProcDeposit :: Coin
pProcDeposit :: forall era. ProposalProcedure era -> Coin
L.pProcDeposit
          , AccountAddress
pProcReturnAddr :: AccountAddress
pProcReturnAddr :: forall era. ProposalProcedure era -> AccountAddress
L.pProcReturnAddr
          , GovAction (ShelleyLedgerEra era)
pProcGovAction :: GovAction (ShelleyLedgerEra era)
pProcGovAction :: forall era. ProposalProcedure era -> GovAction era
L.pProcGovAction
          , Anchor
pProcAnchor :: Anchor
pProcAnchor :: forall era. ProposalProcedure era -> Anchor
L.pProcAnchor
          }
        )
    ) =
    Era era
-> (EraCommonConstraints era => [(Key, Value)]) -> [(Key, Value)]
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints
      (forall era. IsEra era => Era era
Exp.useEra @era)
      [ Key
"deposit" Key -> Coin -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
pProcDeposit
      , Key
"return address" Key -> AccountAddress -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= AccountAddress
pProcReturnAddr
      , Key
"governance action" Key -> GovAction (LedgerEra era) -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GovAction (ShelleyLedgerEra era)
GovAction (LedgerEra era)
pProcGovAction
      , Key
"anchor" Key -> Anchor -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Anchor
pProcAnchor
      ]

friendlyTxImpl
  :: forall m era
   . MonadWarning m
  => Exp.Era era
  -> Exp.SignedTx era
  -> m [Aeson.Pair]
friendlyTxImpl :: forall (m :: * -> *) era.
MonadWarning m =>
Era era -> SignedTx era -> m [(Key, Value)]
friendlyTxImpl Era era
era (Exp.SignedTx Tx TopTx (ShelleyLedgerEra era)
ledgerTx) =
  Era era
-> (EraCommonConstraints era => m [(Key, Value)])
-> m [(Key, Value)]
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era => m [(Key, Value)])
 -> m [(Key, Value)])
-> (EraCommonConstraints era => m [(Key, Value)])
-> m [(Key, Value)]
forall a b. (a -> b) -> a -> b
$
    let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era :: ShelleyBasedEra era
        witnesses :: [KeyWitness era]
witnesses = Tx era -> [KeyWitness era]
forall era. Tx era -> [KeyWitness era]
getTxWitnesses (ShelleyBasedEra era -> Tx TopTx (ShelleyLedgerEra era) -> Tx era
forall era.
ShelleyBasedEra era -> Tx TopTx (ShelleyLedgerEra era) -> Tx era
ShelleyTx ShelleyBasedEra era
sbe Tx TopTx (ShelleyLedgerEra era)
ledgerTx)
     in ((Key
"witnesses" Key -> [Value] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (KeyWitness era -> Value) -> [KeyWitness era] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map KeyWitness era -> Value
forall era. KeyWitness era -> Value
friendlyKeyWitness [KeyWitness era]
witnesses) (Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
:)
          ([(Key, Value)] -> [(Key, Value)])
-> m [(Key, Value)] -> m [(Key, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Era era -> UnsignedTx (LedgerEra era) -> m [(Key, Value)]
forall (m :: * -> *) era.
MonadWarning m =>
Era era -> UnsignedTx (LedgerEra era) -> m [(Key, Value)]
friendlyTxBodyImpl Era era
era (Tx TopTx (LedgerEra era) -> UnsignedTx (LedgerEra era)
forall era. EraTx era => Tx TopTx era -> UnsignedTx era
Exp.UnsignedTx Tx TopTx (ShelleyLedgerEra era)
Tx TopTx (LedgerEra era)
ledgerTx)

friendlyKeyWitness :: KeyWitness era -> Aeson.Value
friendlyKeyWitness :: forall era. KeyWitness era -> Value
friendlyKeyWitness =
  [(Key, Value)] -> Value
object
    ([(Key, Value)] -> Value)
-> (KeyWitness era -> [(Key, Value)]) -> KeyWitness era -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      ByronKeyWitness TxInWitness
txInWitness -> [Key
"Byron witness" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxInWitness -> Text
forall a. Show a => a -> Text
textShow TxInWitness
txInWitness]
      ShelleyBootstrapWitness ShelleyBasedEra era
_era BootstrapWitness
bootstrapWitness ->
        [Key
"bootstrap witness" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BootstrapWitness -> Text
forall a. Show a => a -> Text
textShow BootstrapWitness
bootstrapWitness]
      ShelleyKeyWitness ShelleyBasedEra era
_era (L.WitVKey VKey Witness
key SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature) ->
        [Key
"key" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= VKey Witness -> Text
forall a. Show a => a -> Text
textShow VKey Witness
key, Key
"signature" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> Text
forall a. Show a => a -> Text
textShow SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
signature]

friendlyTxBodyImpl
  :: forall m era
   . MonadWarning m
  => Exp.Era era
  -> Exp.UnsignedTx (Exp.LedgerEra era)
  -> m [Aeson.Pair]
friendlyTxBodyImpl :: forall (m :: * -> *) era.
MonadWarning m =>
Era era -> UnsignedTx (LedgerEra era) -> m [(Key, Value)]
friendlyTxBodyImpl Era era
era (Exp.UnsignedTx Tx TopTx (LedgerEra era)
ledgerTx) =
  [(Key, Value)] -> m [(Key, Value)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Key, Value)] -> m [(Key, Value)])
-> [(Key, Value)] -> m [(Key, Value)]
forall a b. (a -> b) -> a -> b
$
    Era era
-> (EraCommonConstraints era => [(Key, Value)]) -> [(Key, Value)]
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era => [(Key, Value)]) -> [(Key, Value)])
-> (EraCommonConstraints era => [(Key, Value)]) -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$
      let body :: TxBody TopTx (LedgerEra era)
body = Tx TopTx (LedgerEra era)
ledgerTx Tx TopTx (LedgerEra era)
-> Getting
     (TxBody TopTx (LedgerEra era))
     (Tx TopTx (LedgerEra era))
     (TxBody TopTx (LedgerEra era))
-> TxBody TopTx (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody TopTx (LedgerEra era))
  (Tx TopTx (LedgerEra era))
  (TxBody TopTx (LedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l (LedgerEra era)) (TxBody l (LedgerEra era))
L.bodyTxL
          mAuxData :: Maybe (TxAuxData (LedgerEra era))
mAuxData = StrictMaybe (TxAuxData (LedgerEra era))
-> Maybe (TxAuxData (LedgerEra era))
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (Tx TopTx (LedgerEra era)
ledgerTx Tx TopTx (LedgerEra era)
-> Getting
     (StrictMaybe (TxAuxData (LedgerEra era)))
     (Tx TopTx (LedgerEra era))
     (StrictMaybe (TxAuxData (LedgerEra era)))
-> StrictMaybe (TxAuxData (LedgerEra era))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (TxAuxData (LedgerEra era)))
  (Tx TopTx (LedgerEra era))
  (StrictMaybe (TxAuxData (LedgerEra era)))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
forall (l :: TxLevel).
Lens'
  (Tx l (LedgerEra era)) (StrictMaybe (TxAuxData (LedgerEra era)))
L.auxDataTxL)
       in Era era
-> TxBody TopTx (LedgerEra era)
-> Maybe (TxAuxData (LedgerEra era))
-> [(Key, Value)]
forall era.
Era era
-> TxBody TopTx (LedgerEra era)
-> Maybe (TxAuxData (LedgerEra era))
-> [(Key, Value)]
basePairs Era era
era TxBody TopTx (LedgerEra era)
body Maybe (TxAuxData (LedgerEra era))
mAuxData
            [(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
<> [ Key
"validity range" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ValidityInterval -> Value
renderValidityInterval (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting
     ValidityInterval (TxBody TopTx (LedgerEra era)) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting
  ValidityInterval (TxBody TopTx (LedgerEra era)) ValidityInterval
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel).
Lens' (TxBody l (LedgerEra era)) ValidityInterval
L.vldtTxBodyL)
               , Key
"mint" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MultiAsset -> Value
renderMaryMint (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting MultiAsset (TxBody TopTx (LedgerEra era)) MultiAsset
-> MultiAsset
forall s a. s -> Getting a s a -> a
^. Getting MultiAsset (TxBody TopTx (LedgerEra era)) MultiAsset
forall era (l :: TxLevel).
MaryEraTxBody era =>
Lens' (TxBody l era) MultiAsset
forall (l :: TxLevel). Lens' (TxBody l (LedgerEra era)) MultiAsset
L.mintTxBodyL)
               , Key
"collateral inputs" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxBody TopTx (LedgerEra era) -> Value
forall era.
AlonzoEraTxBody (LedgerEra era) =>
TxBody TopTx (LedgerEra era) -> Value
renderCollateralInputs TxBody TopTx (LedgerEra era)
body
               , TxBody TopTx (LedgerEra era) -> (Key, Value)
forall era.
AlonzoEraTxBody (LedgerEra era) =>
TxBody TopTx (LedgerEra era) -> (Key, Value)
renderReqSigners TxBody TopTx (LedgerEra era)
body
               , Key
"reference inputs" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxBody TopTx (LedgerEra era) -> Value
forall era.
BabbageEraTxBody (LedgerEra era) =>
TxBody TopTx (LedgerEra era) -> Value
renderReferenceInputs TxBody TopTx (LedgerEra era)
body
               , Key
"total collateral" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Coin -> Value
forall a. ToJSON a => a -> Value
toJSON (StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting
     (StrictMaybe Coin)
     (TxBody TopTx (LedgerEra era))
     (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Coin)
  (TxBody TopTx (LedgerEra era))
  (StrictMaybe Coin)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe Coin)
Lens' (TxBody TopTx (LedgerEra era)) (StrictMaybe Coin)
L.totalCollateralTxBodyL))
               , Key
"return collateral" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Era era -> StrictMaybe (TxOut (LedgerEra era)) -> Value
forall era. Era era -> StrictMaybe (TxOut (LedgerEra era)) -> Value
friendlyReturnCollateral Era era
era (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting
     (StrictMaybe (TxOut (LedgerEra era)))
     (TxBody TopTx (LedgerEra era))
     (StrictMaybe (TxOut (LedgerEra era)))
-> StrictMaybe (TxOut (LedgerEra era))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (TxOut (LedgerEra era)))
  (TxBody TopTx (LedgerEra era))
  (StrictMaybe (TxOut (LedgerEra era)))
forall era.
BabbageEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe (TxOut era))
Lens'
  (TxBody TopTx (LedgerEra era))
  (StrictMaybe (TxOut (LedgerEra era)))
L.collateralReturnTxBodyL)
               ]
            [(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
<> Era era -> Tx TopTx (LedgerEra era) -> [(Key, Value)]
forall era.
AlonzoEraTx (LedgerEra era) =>
Era era -> Tx TopTx (LedgerEra era) -> [(Key, Value)]
alonzoScriptWitnessPairs Era era
era Tx TopTx (LedgerEra era)
ledgerTx
            [(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
<> TxBody TopTx (LedgerEra era) -> [(Key, Value)]
forall era.
(ConwayEraTxBody (LedgerEra era), Typeable era, IsEra era,
 EraTx (LedgerEra era)) =>
TxBody TopTx (LedgerEra era) -> [(Key, Value)]
conwayBodyPairs TxBody TopTx (LedgerEra era)
body

renderCollateralInputs
  :: L.AlonzoEraTxBody (Exp.LedgerEra era)
  => L.TxBody C.TopTx (Exp.LedgerEra era)
  -> Aeson.Value
renderCollateralInputs :: forall era.
AlonzoEraTxBody (LedgerEra era) =>
TxBody TopTx (LedgerEra era) -> Value
renderCollateralInputs TxBody TopTx (LedgerEra era)
body =
  [TxIn] -> Value
forall a. ToJSON a => a -> Value
toJSON ((TxIn -> TxIn) -> [TxIn] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> TxIn
fromShelleyTxIn (Set TxIn -> [Item (Set TxIn)]
forall l. IsList l => l -> [Item l]
toList (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting (Set TxIn) (TxBody TopTx (LedgerEra era)) (Set TxIn)
-> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx (LedgerEra era)) (Set TxIn)
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody TopTx era) (Set TxIn)
Lens' (TxBody TopTx (LedgerEra era)) (Set TxIn)
L.collateralInputsTxBodyL)))

renderReqSigners
  :: L.AlonzoEraTxBody (Exp.LedgerEra era)
  => L.TxBody C.TopTx (Exp.LedgerEra era)
  -> Aeson.Pair
renderReqSigners :: forall era.
AlonzoEraTxBody (LedgerEra era) =>
TxBody TopTx (LedgerEra era) -> (Key, Value)
renderReqSigners TxBody TopTx (LedgerEra era)
body =
  Key
"required signers (payment key hashes needed for scripts)"
    Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Set (KeyHash Guard) -> Value
friendlyExtraKeyWits (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting
     (Set (KeyHash Guard))
     (TxBody TopTx (LedgerEra era))
     (Set (KeyHash Guard))
-> Set (KeyHash Guard)
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (KeyHash Guard))
  (TxBody TopTx (LedgerEra era))
  (Set (KeyHash Guard))
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
SimpleGetter (TxBody l era) (Set (KeyHash Guard))
forall (l :: TxLevel).
SimpleGetter (TxBody l (LedgerEra era)) (Set (KeyHash Guard))
L.reqSignerHashesTxBodyG)

renderReferenceInputs
  :: L.BabbageEraTxBody (Exp.LedgerEra era)
  => L.TxBody C.TopTx (Exp.LedgerEra era)
  -> Aeson.Value
renderReferenceInputs :: forall era.
BabbageEraTxBody (LedgerEra era) =>
TxBody TopTx (LedgerEra era) -> Value
renderReferenceInputs TxBody TopTx (LedgerEra era)
body =
  [TxIn] -> Value
forall a. ToJSON a => a -> Value
toJSON ((TxIn -> TxIn) -> [TxIn] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> TxIn
fromShelleyTxIn (Set TxIn -> [Item (Set TxIn)]
forall l. IsList l => l -> [Item l]
toList (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting (Set TxIn) (TxBody TopTx (LedgerEra era)) (Set TxIn)
-> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx (LedgerEra era)) (Set TxIn)
forall era (l :: TxLevel).
BabbageEraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l (LedgerEra era)) (Set TxIn)
L.referenceInputsTxBodyL)))

-- | Pairs that are present in every Conway-onwards era.
basePairs
  :: forall era
   . Exp.Era era
  -> L.TxBody C.TopTx (Exp.LedgerEra era)
  -> Maybe (L.TxAuxData (Exp.LedgerEra era))
  -> [Aeson.Pair]
basePairs :: forall era.
Era era
-> TxBody TopTx (LedgerEra era)
-> Maybe (TxAuxData (LedgerEra era))
-> [(Key, Value)]
basePairs Era era
era TxBody TopTx (LedgerEra era)
body Maybe (TxAuxData (LedgerEra era))
mAuxData =
  Era era
-> (EraCommonConstraints era => [(Key, Value)]) -> [(Key, Value)]
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era => [(Key, Value)]) -> [(Key, Value)])
-> (EraCommonConstraints era => [(Key, Value)]) -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$
    let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era :: ShelleyBasedEra era
        certs :: [Item (StrictSeq (TxCert (LedgerEra era)))]
certs = StrictSeq (TxCert (LedgerEra era))
-> [Item (StrictSeq (TxCert (LedgerEra era)))]
forall l. IsList l => l -> [Item l]
toList (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting
     (StrictSeq (TxCert (LedgerEra era)))
     (TxBody TopTx (LedgerEra era))
     (StrictSeq (TxCert (LedgerEra era)))
-> StrictSeq (TxCert (LedgerEra era))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert (LedgerEra era)))
  (TxBody TopTx (LedgerEra era))
  (StrictSeq (TxCert (LedgerEra era)))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens'
  (TxBody l (LedgerEra era)) (StrictSeq (TxCert (LedgerEra era)))
L.certsTxBodyL)
     in [ Key
"auxiliary scripts" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Era era -> Maybe (TxAuxData (LedgerEra era)) -> Value
forall era. Era era -> Maybe (TxAuxData (LedgerEra era)) -> Value
friendlyAuxScripts Era era
era Maybe (TxAuxData (LedgerEra era))
mAuxData
        , Key
"certificates"
            Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= if [TxCert (LedgerEra era)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Item (StrictSeq (TxCert (LedgerEra era)))]
[TxCert (LedgerEra era)]
certs
              then Value
Null
              else [Value] -> Value
array [Era era -> Certificate (LedgerEra era) -> Value
forall era. Era era -> Certificate (LedgerEra era) -> Value
friendlyCertificate Era era
era (TxCert (LedgerEra era) -> Certificate (LedgerEra era)
forall era. EraTxCert era => TxCert era -> Certificate era
Exp.Certificate TxCert (LedgerEra era)
cert) | TxCert (LedgerEra era)
cert <- [Item (StrictSeq (TxCert (LedgerEra era)))]
[TxCert (LedgerEra era)]
certs]
        , Key
"era" Key -> CardanoEra era -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Era era -> CardanoEra era
forall era. Era era -> CardanoEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era :: CardanoEra era)
        , Key
"fee" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin -> Value
friendlyLovelace (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting Coin (TxBody TopTx (LedgerEra era)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody TopTx (LedgerEra era)) Coin
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx (LedgerEra era)) Coin
L.feeTxBodyL)
        , Key
"inputs" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [TxIn] -> Value
forall a. ToJSON a => a -> Value
toJSON ((TxIn -> TxIn) -> [TxIn] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> TxIn
fromShelleyTxIn (Set TxIn -> [Item (Set TxIn)]
forall l. IsList l => l -> [Item l]
toList (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting (Set TxIn) (TxBody TopTx (LedgerEra era)) (Set TxIn)
-> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx (LedgerEra era)) (Set TxIn)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l (LedgerEra era)) (Set TxIn)
L.inputsTxBodyL)))
        , Key
"metadata" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe (TxAuxData (LedgerEra era)) -> Value
forall era. EraTxAuxData era => Maybe (TxAuxData era) -> Value
friendlyMetadata Maybe (TxAuxData (LedgerEra era))
mAuxData
        , Key
"outputs"
            Key -> [Value] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (TxOut (LedgerEra era) -> Value)
-> [TxOut (LedgerEra era)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map
              (Era era -> TxOut CtxTx era -> Value
forall era. Era era -> TxOut CtxTx era -> Value
friendlyTxOut Era era
era (TxOut CtxTx era -> Value)
-> (TxOut (LedgerEra era) -> TxOut CtxTx era)
-> TxOut (LedgerEra era)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxUTxO era -> TxOut CtxTx era
forall era. TxOut CtxUTxO era -> TxOut CtxTx era
fromCtxUTxOTxOut (TxOut CtxUTxO era -> TxOut CtxTx era)
-> (TxOut (LedgerEra era) -> TxOut CtxUTxO era)
-> TxOut (LedgerEra era)
-> TxOut CtxTx era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era
-> TxOut (ShelleyLedgerEra era) -> TxOut CtxUTxO era
forall era ctx.
ShelleyBasedEra era
-> TxOut (ShelleyLedgerEra era) -> TxOut ctx era
fromShelleyTxOut ShelleyBasedEra era
sbe)
              (StrictSeq (TxOut (LedgerEra era))
-> [Item (StrictSeq (TxOut (LedgerEra era)))]
forall l. IsList l => l -> [Item l]
toList (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting
     (StrictSeq (TxOut (LedgerEra era)))
     (TxBody TopTx (LedgerEra era))
     (StrictSeq (TxOut (LedgerEra era)))
-> StrictSeq (TxOut (LedgerEra era))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut (LedgerEra era)))
  (TxBody TopTx (LedgerEra era))
  (StrictSeq (TxOut (LedgerEra era)))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel).
Lens'
  (TxBody l (LedgerEra era)) (StrictSeq (TxOut (LedgerEra era)))
L.outputsTxBodyL))
        , Key
"withdrawals" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Withdrawals -> Value
friendlyWithdrawals (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting Withdrawals (TxBody TopTx (LedgerEra era)) Withdrawals
-> Withdrawals
forall s a. s -> Getting a s a -> a
^. Getting Withdrawals (TxBody TopTx (LedgerEra era)) Withdrawals
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l (LedgerEra era)) Withdrawals
L.withdrawalsTxBodyL)
        ]

renderValidityInterval :: L.ValidityInterval -> Aeson.Value
renderValidityInterval :: ValidityInterval -> Value
renderValidityInterval (L.ValidityInterval StrictMaybe SlotNo
invalidBefore StrictMaybe SlotNo
invalidHereafter) =
  [(Key, Value)] -> Value
object
    [ Key
"lower bound" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe SlotNo -> Value
forall a. ToJSON a => a -> Value
toJSON (StrictMaybe SlotNo -> Maybe SlotNo
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe SlotNo
invalidBefore)
    , Key
"upper bound" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe SlotNo -> Value
forall a. ToJSON a => a -> Value
toJSON (StrictMaybe SlotNo -> Maybe SlotNo
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe SlotNo
invalidHereafter)
    ]

renderMaryMint :: L.MultiAsset -> Aeson.Value
renderMaryMint :: MultiAsset -> Value
renderMaryMint MultiAsset
ma
  | MultiAsset
ma MultiAsset -> MultiAsset -> Bool
forall a. Eq a => a -> a -> Bool
== MultiAsset
forall a. Monoid a => a
mempty = Value
Null
  | Bool
otherwise = Value -> Value
friendlyValue (MultiAsset -> Value
fromMultiAsset MultiAsset
ma)

alonzoScriptWitnessPairs
  :: L.AlonzoEraTx (Exp.LedgerEra era)
  => Exp.Era era
  -> Ledger.Tx C.TopTx (Exp.LedgerEra era)
  -> [Aeson.Pair]
alonzoScriptWitnessPairs :: forall era.
AlonzoEraTx (LedgerEra era) =>
Era era -> Tx TopTx (LedgerEra era) -> [(Key, Value)]
alonzoScriptWitnessPairs Era era
era Tx TopTx (LedgerEra era)
tx =
  [ Key
"redeemers" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Era era -> Tx TopTx (LedgerEra era) -> Value
forall era.
AlonzoEraTx (LedgerEra era) =>
Era era -> Tx TopTx (LedgerEra era) -> Value
renderRedeemers Era era
era Tx TopTx (LedgerEra era)
tx
  , Key
"scripts" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx TopTx (LedgerEra era) -> Value
forall era.
(AlonzoEraTxWits (LedgerEra era), EraTx (LedgerEra era)) =>
Tx TopTx (LedgerEra era) -> Value
renderScriptData Tx TopTx (LedgerEra era)
tx
  , Key
"datums" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Tx TopTx (LedgerEra era) -> Value
forall era.
(AlonzoEraTxWits (LedgerEra era), EraTx (LedgerEra era)) =>
Tx TopTx (LedgerEra era) -> Value
renderDats Tx TopTx (LedgerEra era)
tx
  ]

conwayBodyPairs
  :: forall era
   . ( L.ConwayEraTxBody (Exp.LedgerEra era)
     , Typeable era
     , Exp.IsEra era
     , L.EraTx (Exp.LedgerEra era)
     )
  => L.TxBody C.TopTx (Exp.LedgerEra era)
  -> [Aeson.Pair]
conwayBodyPairs :: forall era.
(ConwayEraTxBody (LedgerEra era), Typeable era, IsEra era,
 EraTx (LedgerEra era)) =>
TxBody TopTx (LedgerEra era) -> [(Key, Value)]
conwayBodyPairs TxBody TopTx (LedgerEra era)
body =
  [ Key
"governance actions"
      Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Era era -> [ProposalProcedure (LedgerEra era)] -> Value
forall era.
Typeable era =>
Era era -> [ProposalProcedure (LedgerEra era)] -> Value
friendlyLedgerProposals
        (forall era. IsEra era => Era era
Exp.useEra @era)
        (OSet (ProposalProcedure (LedgerEra era))
-> [Item (OSet (ProposalProcedure (LedgerEra era)))]
forall l. IsList l => l -> [Item l]
toList (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting
     (OSet (ProposalProcedure (LedgerEra era)))
     (TxBody TopTx (LedgerEra era))
     (OSet (ProposalProcedure (LedgerEra era)))
-> OSet (ProposalProcedure (LedgerEra era))
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (ProposalProcedure (LedgerEra era)))
  (TxBody TopTx (LedgerEra era))
  (OSet (ProposalProcedure (LedgerEra era)))
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (OSet (ProposalProcedure era))
forall (l :: TxLevel).
Lens'
  (TxBody l (LedgerEra era))
  (OSet (ProposalProcedure (LedgerEra era)))
L.proposalProceduresTxBodyL))
  , Key
"voters" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= VotingProcedures (LedgerEra era) -> Value
forall a. ToJSON a => a -> Value
toJSON (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting
     (VotingProcedures (LedgerEra era))
     (TxBody TopTx (LedgerEra era))
     (VotingProcedures (LedgerEra era))
-> VotingProcedures (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (VotingProcedures (LedgerEra era))
  (TxBody TopTx (LedgerEra era))
  (VotingProcedures (LedgerEra era))
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (VotingProcedures era)
forall (l :: TxLevel).
Lens' (TxBody l (LedgerEra era)) (VotingProcedures (LedgerEra era))
L.votingProceduresTxBodyL)
  , Key
"currentTreasuryValue"
      Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Coin -> Value
forall a. ToJSON a => a -> Value
toJSON (StrictMaybe Coin -> Maybe Coin
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting
     (StrictMaybe Coin)
     (TxBody TopTx (LedgerEra era))
     (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Coin)
  (TxBody TopTx (LedgerEra era))
  (StrictMaybe Coin)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (StrictMaybe Coin)
forall (l :: TxLevel).
Lens' (TxBody l (LedgerEra era)) (StrictMaybe Coin)
L.currentTreasuryValueTxBodyL))
  , Key
"treasuryDonation" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin -> Value
forall a. ToJSON a => a -> Value
toJSON (TxBody TopTx (LedgerEra era)
body TxBody TopTx (LedgerEra era)
-> Getting Coin (TxBody TopTx (LedgerEra era)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody TopTx (LedgerEra era)) Coin
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) Coin
forall (l :: TxLevel). Lens' (TxBody l (LedgerEra era)) Coin
L.treasuryDonationTxBodyL)
  ]

friendlyLedgerProposals
  :: Typeable era => Exp.Era era -> [L.ProposalProcedure (Exp.LedgerEra era)] -> Aeson.Value
friendlyLedgerProposals :: forall era.
Typeable era =>
Era era -> [ProposalProcedure (LedgerEra era)] -> Value
friendlyLedgerProposals Era era
e [ProposalProcedure (LedgerEra era)]
proposalProcedures =
  Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Item Array] -> Array
forall l. IsList l => [Item l] -> l
fromList ([Item Array] -> Array) -> [Item Array] -> Array
forall a b. (a -> b) -> a -> b
$ (ProposalProcedure (LedgerEra era) -> Item Array)
-> [ProposalProcedure (LedgerEra era)] -> [Item Array]
forall a b. (a -> b) -> [a] -> [b]
map (Era era
-> (EraCommonConstraints era =>
    ProposalProcedure (LedgerEra era) -> Value)
-> ProposalProcedure (LedgerEra era)
-> Value
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
e EraCommonConstraints era =>
ProposalProcedure (LedgerEra era) -> Value
ProposalProcedure (LedgerEra era) -> Value
forall era.
(Typeable era, IsEra era) =>
ProposalProcedure (LedgerEra era) -> Value
friendlyLedgerProposal) [ProposalProcedure (LedgerEra era)]
proposalProcedures

friendlyLedgerProposal
  :: forall era. (Typeable era, Exp.IsEra era) => L.ProposalProcedure (Exp.LedgerEra era) -> Aeson.Value
friendlyLedgerProposal :: forall era.
(Typeable era, IsEra era) =>
ProposalProcedure (LedgerEra era) -> Value
friendlyLedgerProposal ProposalProcedure (LedgerEra era)
proposalProcedure =
  Era era -> (EraCommonConstraints era => Value) -> Value
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints (forall era. IsEra era => Era era
Exp.useEra @era) ((EraCommonConstraints era => Value) -> Value)
-> (EraCommonConstraints era => Value) -> Value
forall a b. (a -> b) -> a -> b
$
    [(Key, Value)] -> Value
object ([(Key, Value)] -> Value) -> [(Key, Value)] -> Value
forall a b. (a -> b) -> a -> b
$
      Proposal era -> [(Key, Value)]
forall era. IsEra era => Proposal era -> [(Key, Value)]
friendlyProposalImpl (ProposalProcedure (ShelleyLedgerEra era) -> Proposal era
forall era.
Typeable era =>
ProposalProcedure (ShelleyLedgerEra era) -> Proposal era
Proposal ProposalProcedure (ShelleyLedgerEra era)
ProposalProcedure (LedgerEra era)
proposalProcedure)

renderRedeemers
  :: L.AlonzoEraTx (Exp.LedgerEra era)
  => Exp.Era era
  -> Ledger.Tx C.TopTx (Exp.LedgerEra era)
  -> Aeson.Value
renderRedeemers :: forall era.
AlonzoEraTx (LedgerEra era) =>
Era era -> Tx TopTx (LedgerEra era) -> Value
renderRedeemers Era era
era Tx TopTx (LedgerEra era)
tx =
  let plutusScriptPurposeAndExUnits :: [(PlutusPurpose AsIx (LedgerEra era),
  (Data (LedgerEra era), ExUnits))]
plutusScriptPurposeAndExUnits = Map
  (PlutusPurpose AsIx (LedgerEra era))
  (Data (LedgerEra era), ExUnits)
-> [(PlutusPurpose AsIx (LedgerEra era),
     (Data (LedgerEra era), ExUnits))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map
   (PlutusPurpose AsIx (LedgerEra era))
   (Data (LedgerEra era), ExUnits)
 -> [(PlutusPurpose AsIx (LedgerEra era),
      (Data (LedgerEra era), ExUnits))])
-> Map
     (PlutusPurpose AsIx (LedgerEra era))
     (Data (LedgerEra era), ExUnits)
-> [(PlutusPurpose AsIx (LedgerEra era),
     (Data (LedgerEra era), ExUnits))]
forall a b. (a -> b) -> a -> b
$ Redeemers (LedgerEra era)
-> Map
     (PlutusPurpose AsIx (LedgerEra era))
     (Data (LedgerEra era), ExUnits)
forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
Ledger.unRedeemers (Redeemers (LedgerEra era)
 -> Map
      (PlutusPurpose AsIx (LedgerEra era))
      (Data (LedgerEra era), ExUnits))
-> Redeemers (LedgerEra era)
-> Map
     (PlutusPurpose AsIx (LedgerEra era))
     (Data (LedgerEra era), ExUnits)
forall a b. (a -> b) -> a -> b
$ Tx TopTx (LedgerEra era)
tx Tx TopTx (LedgerEra era)
-> Getting
     (Redeemers (LedgerEra era))
     (Tx TopTx (LedgerEra era))
     (Redeemers (LedgerEra era))
-> Redeemers (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. (TxWits (LedgerEra era)
 -> Const (Redeemers (LedgerEra era)) (TxWits (LedgerEra era)))
-> Tx TopTx (LedgerEra era)
-> Const (Redeemers (LedgerEra era)) (Tx TopTx (LedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l (LedgerEra era)) (TxWits (LedgerEra era))
Ledger.witsTxL ((TxWits (LedgerEra era)
  -> Const (Redeemers (LedgerEra era)) (TxWits (LedgerEra era)))
 -> Tx TopTx (LedgerEra era)
 -> Const (Redeemers (LedgerEra era)) (Tx TopTx (LedgerEra era)))
-> ((Redeemers (LedgerEra era)
     -> Const (Redeemers (LedgerEra era)) (Redeemers (LedgerEra era)))
    -> TxWits (LedgerEra era)
    -> Const (Redeemers (LedgerEra era)) (TxWits (LedgerEra era)))
-> Getting
     (Redeemers (LedgerEra era))
     (Tx TopTx (LedgerEra era))
     (Redeemers (LedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers (LedgerEra era)
 -> Const (Redeemers (LedgerEra era)) (Redeemers (LedgerEra era)))
-> TxWits (LedgerEra era)
-> Const (Redeemers (LedgerEra era)) (TxWits (LedgerEra era))
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits (LedgerEra era)) (Redeemers (LedgerEra era))
Ledger.rdmrsTxWitsL
      redeemerList :: [Value]
redeemerList = ((PlutusPurpose AsIx (LedgerEra era),
  (Data (LedgerEra era), ExUnits))
 -> Value)
-> [(PlutusPurpose AsIx (LedgerEra era),
     (Data (LedgerEra era), ExUnits))]
-> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((PlutusPurpose AsIx (LedgerEra era)
 -> (Data (LedgerEra era), ExUnits) -> Value)
-> (PlutusPurpose AsIx (LedgerEra era),
    (Data (LedgerEra era), ExUnits))
-> Value
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Era era
-> Tx TopTx (LedgerEra era)
-> PlutusPurpose AsIx (LedgerEra era)
-> (Data (LedgerEra era), ExUnits)
-> Value
forall era.
AlonzoEraTx (LedgerEra era) =>
Era era
-> Tx TopTx (LedgerEra era)
-> PlutusPurpose AsIx (LedgerEra era)
-> (Data (LedgerEra era), ExUnits)
-> Value
renderRedeemerInfo Era era
era Tx TopTx (LedgerEra era)
tx)) [(PlutusPurpose AsIx (LedgerEra era),
  (Data (LedgerEra era), ExUnits))]
plutusScriptPurposeAndExUnits
   in Array -> Value
Aeson.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
Vector.fromList [Value]
redeemerList

renderRedeemerInfo
  :: L.AlonzoEraTx (Exp.LedgerEra era)
  => Exp.Era era
  -> Ledger.Tx C.TopTx (Exp.LedgerEra era)
  -> Ledger.PlutusPurpose Ledger.AsIx (Exp.LedgerEra era)
  -> (Ledger.Data (Exp.LedgerEra era), ExUnits)
  -> Aeson.Value
renderRedeemerInfo :: forall era.
AlonzoEraTx (LedgerEra era) =>
Era era
-> Tx TopTx (LedgerEra era)
-> PlutusPurpose AsIx (LedgerEra era)
-> (Data (LedgerEra era), ExUnits)
-> Value
renderRedeemerInfo Era era
era Tx TopTx (LedgerEra era)
tx PlutusPurpose AsIx (LedgerEra era)
redeemerPurpose (Data (LedgerEra era)
redeemerData, ExUnits
exUnits) =
  let inputNotFoundError :: Value
inputNotFoundError =
        [(Key, Value)] -> Value
Aeson.object
          [ Key
"error"
              Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not find corresponding input to " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PlutusPurpose AsIx (LedgerEra era) -> [Char]
forall a. Show a => a -> [Char]
show PlutusPurpose AsIx (LedgerEra era)
redeemerPurpose)
          ]
      mCorrespondingInput :: Maybe (PlutusPurpose AsIxItem (LedgerEra era))
mCorrespondingInput = StrictMaybe (PlutusPurpose AsIxItem (LedgerEra era))
-> Maybe (PlutusPurpose AsIxItem (LedgerEra era))
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (StrictMaybe (PlutusPurpose AsIxItem (LedgerEra era))
 -> Maybe (PlutusPurpose AsIxItem (LedgerEra era)))
-> StrictMaybe (PlutusPurpose AsIxItem (LedgerEra era))
-> Maybe (PlutusPurpose AsIxItem (LedgerEra era))
forall a b. (a -> b) -> a -> b
$ TxBody TopTx (LedgerEra era)
-> PlutusPurpose AsIx (LedgerEra era)
-> StrictMaybe (PlutusPurpose AsIxItem (LedgerEra era))
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
TxBody l era
-> PlutusPurpose AsIx era
-> StrictMaybe (PlutusPurpose AsIxItem era)
forall (l :: TxLevel).
TxBody l (LedgerEra era)
-> PlutusPurpose AsIx (LedgerEra era)
-> StrictMaybe (PlutusPurpose AsIxItem (LedgerEra era))
Ledger.redeemerPointerInverse (Tx TopTx (LedgerEra era)
tx Tx TopTx (LedgerEra era)
-> Getting
     (TxBody TopTx (LedgerEra era))
     (Tx TopTx (LedgerEra era))
     (TxBody TopTx (LedgerEra era))
-> TxBody TopTx (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody TopTx (LedgerEra era))
  (Tx TopTx (LedgerEra era))
  (TxBody TopTx (LedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l (LedgerEra era)) (TxBody l (LedgerEra era))
Ledger.bodyTxL) PlutusPurpose AsIx (LedgerEra era)
redeemerPurpose
      mPurposeRendered :: Maybe Value
mPurposeRendered = Era era -> PlutusPurpose AsIxItem (LedgerEra era) -> Value
forall era.
Era era -> PlutusPurpose AsIxItem (LedgerEra era) -> Value
renderPurpose Era era
era (PlutusPurpose AsIxItem (LedgerEra era) -> Value)
-> Maybe (PlutusPurpose AsIxItem (LedgerEra era)) -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PlutusPurpose AsIxItem (LedgerEra era))
mCorrespondingInput
   in [(Key, Value)] -> Value
object
        [ Key
"purpose" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
inputNotFoundError Maybe Value
mPurposeRendered
        , Key
"redeemer" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Data (LedgerEra era) -> ExUnits -> Value
forall era. Data era -> ExUnits -> Value
renderRedeemer Data (LedgerEra era)
redeemerData ExUnits
exUnits
        ]

renderRedeemer :: Ledger.Data era -> ExUnits -> Aeson.Value
renderRedeemer :: forall era. Data era -> ExUnits -> Value
renderRedeemer Data era
scriptData ExUnits{exUnitsSteps :: ExUnits -> Natural
exUnitsSteps = Natural
exSteps, exUnitsMem :: ExUnits -> Natural
exUnitsMem = Natural
exMemUnits} =
  [(Key, Value)] -> Value
object
    [ Key
"data" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Data -> [Char]
forall a. Show a => a -> [Char]
show (Data -> [Char]) -> Data -> [Char]
forall a b. (a -> b) -> a -> b
$ Data era -> Data
forall era. Data era -> Data
Ledger.unData Data era
scriptData)
    , Key
"execution units"
        Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
          [ Key
"steps" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Scientific -> Value
Aeson.Number (Natural -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
exSteps)
          , Key
"memory" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Scientific -> Value
Aeson.Number (Natural -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
exMemUnits)
          ]
    ]

renderLedgerInput :: Ledger.TxIn -> Aeson.Value
renderLedgerInput :: TxIn -> Value
renderLedgerInput (Ledger.TxIn (Ledger.TxId SafeHash EraIndependentTxBody
txidHash) TxIx
ix) =
  Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$
    [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$
      Text -> [Char]
T.unpack (Hash HASH EraIndependentTxBody -> Text
forall h a. Hash h a -> Text
hashToTextAsHex (SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody
forall i. SafeHash i -> Hash HASH i
extractHash SafeHash EraIndependentTxBody
txidHash)) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"#" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (TxIx -> Int
Ledger.txIxToInt TxIx
ix)

-- | Render a Plutus purpose. Dispatches on the experimental era to pick the
-- right ledger constructor set.
renderPurpose
  :: Exp.Era era
  -> Ledger.PlutusPurpose L.AsIxItem (Exp.LedgerEra era)
  -> Aeson.Value
renderPurpose :: forall era.
Era era -> PlutusPurpose AsIxItem (LedgerEra era) -> Value
renderPurpose Era era
era PlutusPurpose AsIxItem (LedgerEra era)
purpose = case Era era
era of
  Era era
Exp.ConwayEra ->
    Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Aeson.Null (PlutusPurpose AsIxItem ConwayEra -> Maybe Value
forall ledgerEra.
(AlonzoEraScript ledgerEra, ToJSON (TxCert ledgerEra)) =>
PlutusPurpose AsIxItem ledgerEra -> Maybe Value
alonzoView PlutusPurpose AsIxItem (LedgerEra era)
PlutusPurpose AsIxItem ConwayEra
purpose Maybe Value -> Maybe Value -> Maybe Value
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PlutusPurpose AsIxItem ConwayEra -> Maybe Value
forall ledgerEra.
(ConwayEraScript ledgerEra, EraPParams ledgerEra) =>
PlutusPurpose AsIxItem ledgerEra -> Maybe Value
conwayView PlutusPurpose AsIxItem (LedgerEra era)
PlutusPurpose AsIxItem ConwayEra
purpose)
  Era era
Exp.DijkstraEra ->
    Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Aeson.Null (PlutusPurpose AsIxItem DijkstraEra -> Maybe Value
forall ledgerEra.
(AlonzoEraScript ledgerEra, ToJSON (TxCert ledgerEra)) =>
PlutusPurpose AsIxItem ledgerEra -> Maybe Value
alonzoView PlutusPurpose AsIxItem (LedgerEra era)
PlutusPurpose AsIxItem DijkstraEra
purpose Maybe Value -> Maybe Value -> Maybe Value
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PlutusPurpose AsIxItem DijkstraEra -> Maybe Value
forall ledgerEra.
(ConwayEraScript ledgerEra, EraPParams ledgerEra) =>
PlutusPurpose AsIxItem ledgerEra -> Maybe Value
conwayView PlutusPurpose AsIxItem (LedgerEra era)
PlutusPurpose AsIxItem DijkstraEra
purpose Maybe Value -> Maybe Value -> Maybe Value
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PlutusPurpose AsIxItem DijkstraEra -> Maybe Value
forall ledgerEra. PlutusPurpose AsIxItem ledgerEra -> Maybe Value
dijkstraView PlutusPurpose AsIxItem (LedgerEra era)
PlutusPurpose AsIxItem DijkstraEra
purpose)
 where
  spendingLabel
    , mintingLabel
    , certifyingLabel
    , rewardingLabel
    , votingLabel
    , proposingLabel
      :: Aeson.Key
  spendingLabel :: Key
spendingLabel = Key
"spending script witnessed input"
  mintingLabel :: Key
mintingLabel = Key
"minting currency with policy id"
  certifyingLabel :: Key
certifyingLabel = Key
"validating certificate with script credentials"
  rewardingLabel :: Key
rewardingLabel = Key
"withdrawing reward from script address"
  votingLabel :: Key
votingLabel = Key
"voting using script protected voter credentials"
  proposingLabel :: Key
proposingLabel = Key
"submitting a proposal following proposal policy"

  labelPurpose :: ToJSON v => Aeson.Key -> v -> Aeson.Value
  labelPurpose :: forall v. ToJSON v => Key -> v -> Value
labelPurpose Key
k v
v = [(Key, Value)] -> Value
Aeson.object [Key
k Key -> v -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
v]

  unAsIxItem :: L.AsIxItem ix it -> it
  unAsIxItem :: forall ix it. AsIxItem ix it -> it
unAsIxItem (L.AsIxItem ix
_ it
it) = it
it

  alonzoView
    :: ( L.AlonzoEraScript ledgerEra
       , ToJSON (C.TxCert ledgerEra)
       )
    => Ledger.PlutusPurpose L.AsIxItem ledgerEra -> Maybe Aeson.Value
  alonzoView :: forall ledgerEra.
(AlonzoEraScript ledgerEra, ToJSON (TxCert ledgerEra)) =>
PlutusPurpose AsIxItem ledgerEra -> Maybe Value
alonzoView PlutusPurpose AsIxItem ledgerEra
p =
    [Maybe Value] -> Maybe Value
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ Key -> Value -> Value
forall v. ToJSON v => Key -> v -> Value
labelPurpose Key
spendingLabel (Value -> Value)
-> (AsIxItem Word32 TxIn -> Value) -> AsIxItem Word32 TxIn -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> Value
renderLedgerInput (TxIn -> Value)
-> (AsIxItem Word32 TxIn -> TxIn) -> AsIxItem Word32 TxIn -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsIxItem Word32 TxIn -> TxIn
forall ix it. AsIxItem ix it -> it
unAsIxItem (AsIxItem Word32 TxIn -> Value)
-> Maybe (AsIxItem Word32 TxIn) -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlutusPurpose AsIxItem ledgerEra -> Maybe (AsIxItem Word32 TxIn)
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 TxIn)
forall (f :: * -> * -> *).
PlutusPurpose f ledgerEra -> Maybe (f Word32 TxIn)
L.toSpendingPurpose PlutusPurpose AsIxItem ledgerEra
p
      , Key -> PolicyID -> Value
forall v. ToJSON v => Key -> v -> Value
labelPurpose Key
mintingLabel (PolicyID -> Value)
-> (AsIxItem Word32 PolicyID -> PolicyID)
-> AsIxItem Word32 PolicyID
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsIxItem Word32 PolicyID -> PolicyID
forall ix it. AsIxItem ix it -> it
unAsIxItem (AsIxItem Word32 PolicyID -> Value)
-> Maybe (AsIxItem Word32 PolicyID) -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlutusPurpose AsIxItem ledgerEra
-> Maybe (AsIxItem Word32 PolicyID)
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 PolicyID)
forall (f :: * -> * -> *).
PlutusPurpose f ledgerEra -> Maybe (f Word32 PolicyID)
L.toMintingPurpose PlutusPurpose AsIxItem ledgerEra
p
      , Key -> TxCert ledgerEra -> Value
forall v. ToJSON v => Key -> v -> Value
labelPurpose Key
certifyingLabel (TxCert ledgerEra -> Value)
-> (AsIxItem Word32 (TxCert ledgerEra) -> TxCert ledgerEra)
-> AsIxItem Word32 (TxCert ledgerEra)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsIxItem Word32 (TxCert ledgerEra) -> TxCert ledgerEra
forall ix it. AsIxItem ix it -> it
unAsIxItem (AsIxItem Word32 (TxCert ledgerEra) -> Value)
-> Maybe (AsIxItem Word32 (TxCert ledgerEra)) -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlutusPurpose AsIxItem ledgerEra
-> Maybe (AsIxItem Word32 (TxCert ledgerEra))
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 (TxCert era))
forall (f :: * -> * -> *).
PlutusPurpose f ledgerEra -> Maybe (f Word32 (TxCert ledgerEra))
L.toCertifyingPurpose PlutusPurpose AsIxItem ledgerEra
p
      , Key -> AccountAddress -> Value
forall v. ToJSON v => Key -> v -> Value
labelPurpose Key
rewardingLabel (AccountAddress -> Value)
-> (AsIxItem Word32 AccountAddress -> AccountAddress)
-> AsIxItem Word32 AccountAddress
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsIxItem Word32 AccountAddress -> AccountAddress
forall ix it. AsIxItem ix it -> it
unAsIxItem (AsIxItem Word32 AccountAddress -> Value)
-> Maybe (AsIxItem Word32 AccountAddress) -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlutusPurpose AsIxItem ledgerEra
-> Maybe (AsIxItem Word32 AccountAddress)
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 AccountAddress)
forall (f :: * -> * -> *).
PlutusPurpose f ledgerEra -> Maybe (f Word32 AccountAddress)
L.toRewardingPurpose PlutusPurpose AsIxItem ledgerEra
p
      ]

  conwayView
    :: ( L.ConwayEraScript ledgerEra
       , C.EraPParams ledgerEra
       )
    => Ledger.PlutusPurpose L.AsIxItem ledgerEra -> Maybe Aeson.Value
  conwayView :: forall ledgerEra.
(ConwayEraScript ledgerEra, EraPParams ledgerEra) =>
PlutusPurpose AsIxItem ledgerEra -> Maybe Value
conwayView PlutusPurpose AsIxItem ledgerEra
p =
    [Maybe Value] -> Maybe Value
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ Key -> Voter -> Value
forall v. ToJSON v => Key -> v -> Value
labelPurpose Key
votingLabel (Voter -> Value)
-> (AsIxItem Word32 Voter -> Voter)
-> AsIxItem Word32 Voter
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsIxItem Word32 Voter -> Voter
forall ix it. AsIxItem ix it -> it
unAsIxItem (AsIxItem Word32 Voter -> Value)
-> Maybe (AsIxItem Word32 Voter) -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlutusPurpose AsIxItem ledgerEra -> Maybe (AsIxItem Word32 Voter)
forall era (f :: * -> * -> *).
ConwayEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 Voter)
forall (f :: * -> * -> *).
PlutusPurpose f ledgerEra -> Maybe (f Word32 Voter)
L.toVotingPurpose PlutusPurpose AsIxItem ledgerEra
p
      , Key -> ProposalProcedure ledgerEra -> Value
forall v. ToJSON v => Key -> v -> Value
labelPurpose Key
proposingLabel (ProposalProcedure ledgerEra -> Value)
-> (AsIxItem Word32 (ProposalProcedure ledgerEra)
    -> ProposalProcedure ledgerEra)
-> AsIxItem Word32 (ProposalProcedure ledgerEra)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsIxItem Word32 (ProposalProcedure ledgerEra)
-> ProposalProcedure ledgerEra
forall ix it. AsIxItem ix it -> it
unAsIxItem (AsIxItem Word32 (ProposalProcedure ledgerEra) -> Value)
-> Maybe (AsIxItem Word32 (ProposalProcedure ledgerEra))
-> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlutusPurpose AsIxItem ledgerEra
-> Maybe (AsIxItem Word32 (ProposalProcedure ledgerEra))
forall era (f :: * -> * -> *).
ConwayEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 (ProposalProcedure era))
forall (f :: * -> * -> *).
PlutusPurpose f ledgerEra
-> Maybe (f Word32 (ProposalProcedure ledgerEra))
L.toProposingPurpose PlutusPurpose AsIxItem ledgerEra
p
      ]

  dijkstraView
    :: Ledger.PlutusPurpose L.AsIxItem ledgerEra -> Maybe Aeson.Value
  dijkstraView :: forall ledgerEra. PlutusPurpose AsIxItem ledgerEra -> Maybe Value
dijkstraView PlutusPurpose AsIxItem ledgerEra
_ = [Char] -> Maybe Value
forall a. HasCallStack => [Char] -> a
error [Char]
"TODO Dijkstra"

renderScriptData
  :: ( L.AlonzoEraTxWits (Exp.LedgerEra era)
     , L.EraTx (Exp.LedgerEra era)
     )
  => Ledger.Tx C.TopTx (Exp.LedgerEra era) -> Aeson.Value
renderScriptData :: forall era.
(AlonzoEraTxWits (LedgerEra era), EraTx (LedgerEra era)) =>
Tx TopTx (LedgerEra era) -> Value
renderScriptData Tx TopTx (LedgerEra era)
tx =
  Array -> Value
Aeson.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$
    [Value] -> Array
forall a. [a] -> Vector a
Vector.fromList
      [ Object -> Value
Aeson.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$
          [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList
            [ Key
"script hash" Key -> ScriptHash -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ScriptHash
scriptHash
            , Key
"script data" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Script (LedgerEra era) -> Value
forall era.
AlonzoEraScript (LedgerEra era) =>
Script (LedgerEra era) -> Value
friendlyScript Script (LedgerEra era)
scriptData
            ]
      | (ScriptHash
scriptHash, Script (LedgerEra era)
scriptData) <- Map ScriptHash (Script (LedgerEra era))
-> [(ScriptHash, Script (LedgerEra era))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ScriptHash (Script (LedgerEra era))
 -> [(ScriptHash, Script (LedgerEra era))])
-> Map ScriptHash (Script (LedgerEra era))
-> [(ScriptHash, Script (LedgerEra era))]
forall a b. (a -> b) -> a -> b
$ Tx TopTx (LedgerEra era)
tx Tx TopTx (LedgerEra era)
-> Getting
     (Map ScriptHash (Script (LedgerEra era)))
     (Tx TopTx (LedgerEra era))
     (Map ScriptHash (Script (LedgerEra era)))
-> Map ScriptHash (Script (LedgerEra era))
forall s a. s -> Getting a s a -> a
^. (TxWits (LedgerEra era)
 -> Const
      (Map ScriptHash (Script (LedgerEra era))) (TxWits (LedgerEra era)))
-> Tx TopTx (LedgerEra era)
-> Const
     (Map ScriptHash (Script (LedgerEra era)))
     (Tx TopTx (LedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l (LedgerEra era)) (TxWits (LedgerEra era))
Ledger.witsTxL ((TxWits (LedgerEra era)
  -> Const
       (Map ScriptHash (Script (LedgerEra era))) (TxWits (LedgerEra era)))
 -> Tx TopTx (LedgerEra era)
 -> Const
      (Map ScriptHash (Script (LedgerEra era)))
      (Tx TopTx (LedgerEra era)))
-> ((Map ScriptHash (Script (LedgerEra era))
     -> Const
          (Map ScriptHash (Script (LedgerEra era)))
          (Map ScriptHash (Script (LedgerEra era))))
    -> TxWits (LedgerEra era)
    -> Const
         (Map ScriptHash (Script (LedgerEra era))) (TxWits (LedgerEra era)))
-> Getting
     (Map ScriptHash (Script (LedgerEra era)))
     (Tx TopTx (LedgerEra era))
     (Map ScriptHash (Script (LedgerEra era)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Script (LedgerEra era))
 -> Const
      (Map ScriptHash (Script (LedgerEra era)))
      (Map ScriptHash (Script (LedgerEra era))))
-> TxWits (LedgerEra era)
-> Const
     (Map ScriptHash (Script (LedgerEra era))) (TxWits (LedgerEra era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens'
  (TxWits (LedgerEra era)) (Map ScriptHash (Script (LedgerEra era)))
Ledger.scriptTxWitsL
      ]

renderDats
  :: ( L.AlonzoEraTxWits (Exp.LedgerEra era)
     , L.EraTx (Exp.LedgerEra era)
     )
  => Ledger.Tx C.TopTx (Exp.LedgerEra era) -> Aeson.Value
renderDats :: forall era.
(AlonzoEraTxWits (LedgerEra era), EraTx (LedgerEra era)) =>
Tx TopTx (LedgerEra era) -> Value
renderDats Tx TopTx (LedgerEra era)
tx =
  let Ledger.TxDats Map (SafeHash EraIndependentData) (Data (LedgerEra era))
dats = Tx TopTx (LedgerEra era)
tx Tx TopTx (LedgerEra era)
-> Getting
     (TxDats (LedgerEra era))
     (Tx TopTx (LedgerEra era))
     (TxDats (LedgerEra era))
-> TxDats (LedgerEra era)
forall s a. s -> Getting a s a -> a
^. (TxWits (LedgerEra era)
 -> Const (TxDats (LedgerEra era)) (TxWits (LedgerEra era)))
-> Tx TopTx (LedgerEra era)
-> Const (TxDats (LedgerEra era)) (Tx TopTx (LedgerEra era))
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel).
Lens' (Tx l (LedgerEra era)) (TxWits (LedgerEra era))
Ledger.witsTxL ((TxWits (LedgerEra era)
  -> Const (TxDats (LedgerEra era)) (TxWits (LedgerEra era)))
 -> Tx TopTx (LedgerEra era)
 -> Const (TxDats (LedgerEra era)) (Tx TopTx (LedgerEra era)))
-> ((TxDats (LedgerEra era)
     -> Const (TxDats (LedgerEra era)) (TxDats (LedgerEra era)))
    -> TxWits (LedgerEra era)
    -> Const (TxDats (LedgerEra era)) (TxWits (LedgerEra era)))
-> Getting
     (TxDats (LedgerEra era))
     (Tx TopTx (LedgerEra era))
     (TxDats (LedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats (LedgerEra era)
 -> Const (TxDats (LedgerEra era)) (TxDats (LedgerEra era)))
-> TxWits (LedgerEra era)
-> Const (TxDats (LedgerEra era)) (TxWits (LedgerEra era))
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits (LedgerEra era)) (TxDats (LedgerEra era))
Ledger.datsTxWitsL
   in Array -> Value
Aeson.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$
        [Value] -> Array
forall a. [a] -> Vector a
Vector.fromList
          [ Object -> Value
Aeson.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$
              [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList
                [ Key
"datum hash" Key -> SafeHash EraIndependentData -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SafeHash EraIndependentData
datHash
                , Key
"datum" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Data (LedgerEra era) -> Value
forall era. Era era => Data era -> Value
friendlyDatum Data (LedgerEra era)
dat
                ]
          | (SafeHash EraIndependentData
datHash, Data (LedgerEra era)
dat) <- Map (SafeHash EraIndependentData) (Data (LedgerEra era))
-> [(SafeHash EraIndependentData, Data (LedgerEra era))]
forall k a. Map k a -> [(k, a)]
Map.toList Map (SafeHash EraIndependentData) (Data (LedgerEra era))
dats
          ]

-- | Create a friendly JSON out of a script
friendlyScript
  :: L.AlonzoEraScript (Exp.LedgerEra era)
  => Ledger.Script (Exp.LedgerEra era) -> Aeson.Value
friendlyScript :: forall era.
AlonzoEraScript (LedgerEra era) =>
Script (LedgerEra era) -> Value
friendlyScript Script (LedgerEra era)
script = Object -> Value
Aeson.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$
  [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$
    case Script (LedgerEra era) -> Maybe (NativeScript (LedgerEra era))
forall era. EraScript era => Script era -> Maybe (NativeScript era)
Ledger.getNativeScript Script (LedgerEra era)
script of
      Just NativeScript (LedgerEra era)
nativeScript ->
        [ (Key
"type", Value
"native")
        , (Key
"script", Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ NativeScript (LedgerEra era) -> [Char]
forall era. AllegraEraScript era => NativeScript era -> [Char]
Ledger.showTimelock NativeScript (LedgerEra era)
nativeScript)
        ]
      Maybe (NativeScript (LedgerEra era))
Nothing ->
        ( case Script (LedgerEra era) -> Maybe (PlutusScript (LedgerEra era))
forall era.
AlonzoEraScript era =>
Script era -> Maybe (PlutusScript era)
Ledger.toPlutusScript Script (LedgerEra era)
script of
            Just PlutusScript (LedgerEra era)
plutusScript ->
              PlutusScript (LedgerEra era)
-> (forall (l :: Language).
    PlutusLanguage l =>
    Plutus l -> [(Key, Value)])
-> [(Key, Value)]
forall era a.
AlonzoEraScript era =>
PlutusScript era
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a) -> a
forall a.
PlutusScript (LedgerEra era)
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a) -> a
Ledger.withPlutusScript PlutusScript (LedgerEra era)
plutusScript ((forall (l :: Language).
  PlutusLanguage l =>
  Plutus l -> [(Key, Value)])
 -> [(Key, Value)])
-> (forall (l :: Language).
    PlutusLanguage l =>
    Plutus l -> [(Key, Value)])
-> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$
                Language -> Plutus l -> [(Key, Value)]
forall (l :: Language). Language -> Plutus l -> [(Key, Value)]
friendlyPlutusScript (Language -> Plutus l -> [(Key, Value)])
-> Language -> Plutus l -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$
                  PlutusScript (LedgerEra era) -> Language
forall era. AlonzoEraScript era => PlutusScript era -> Language
Ledger.plutusScriptLanguage PlutusScript (LedgerEra era)
plutusScript
            Maybe (PlutusScript (LedgerEra era))
Nothing -> [(Key
"error", Text -> Value
Aeson.String Text
"Unsupported script type")]
        )
 where
  friendlyPlutusScript :: Ledger.Language -> Ledger.Plutus l -> [(KeyMap.Key, Aeson.Value)]
  friendlyPlutusScript :: forall (l :: Language). Language -> Plutus l -> [(Key, Value)]
friendlyPlutusScript Language
language Plutus l
plutusScript =
    [ (Key
"type", Value
"plutus")
    , (Key
"plutus version", Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Language -> Text
Ledger.languageToText Language
language)
    , (Key
"script", Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ PlutusBinary -> Text
forall a. ToCBOR a => a -> Text
Ledger.serializeAsHexText (PlutusBinary -> Text) -> PlutusBinary -> Text
forall a b. (a -> b) -> a -> b
$ Plutus l -> PlutusBinary
forall (l :: Language). Plutus l -> PlutusBinary
Ledger.plutusBinary Plutus l
plutusScript)
    ]

-- | Create a friendly JSON out of a datum
friendlyDatum :: L.Era era => Alonzo.Data era -> Aeson.Value
friendlyDatum :: forall era. Era era => Data era -> Value
friendlyDatum (Alonzo.Data Data
datum) = Text -> Value
Aeson.String ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Data -> [Char]
forall a. Show a => a -> [Char]
show Data
datum)

friendlyReturnCollateral
  :: forall era
   . Exp.Era era
  -> L.StrictMaybe (L.TxOut (Exp.LedgerEra era))
  -> Aeson.Value
friendlyReturnCollateral :: forall era. Era era -> StrictMaybe (TxOut (LedgerEra era)) -> Value
friendlyReturnCollateral Era era
era = \case
  StrictMaybe (TxOut (LedgerEra era))
L.SNothing -> Value
Aeson.Null
  L.SJust TxOut (LedgerEra era)
collOut ->
    Era era -> (EraCommonConstraints era => Value) -> Value
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era => Value) -> Value)
-> (EraCommonConstraints era => Value) -> Value
forall a b. (a -> b) -> a -> b
$
      let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era :: ShelleyBasedEra era
       in Era era -> TxOut CtxTx era -> Value
forall era. Era era -> TxOut CtxTx era -> Value
friendlyTxOut Era era
era (TxOut CtxUTxO era -> TxOut CtxTx era
forall era. TxOut CtxUTxO era -> TxOut CtxTx era
fromCtxUTxOTxOut (ShelleyBasedEra era
-> TxOut (ShelleyLedgerEra era) -> TxOut CtxUTxO era
forall era ctx.
ShelleyBasedEra era
-> TxOut (ShelleyLedgerEra era) -> TxOut ctx era
fromShelleyTxOut ShelleyBasedEra era
sbe TxOut (ShelleyLedgerEra era)
TxOut (LedgerEra era)
collOut))

friendlyExtraKeyWits :: Set.Set (L.KeyHash L.Guard) -> Aeson.Value
friendlyExtraKeyWits :: Set (KeyHash Guard) -> Value
friendlyExtraKeyWits Set (KeyHash Guard)
keyhashes
  | Set (KeyHash Guard) -> Bool
forall a. Set a -> Bool
Set.null Set (KeyHash Guard)
keyhashes = Value
Null
  | Bool
otherwise = [Hash PaymentKey] -> Value
forall a. ToJSON a => a -> Value
toJSON [KeyHash Payment -> Hash PaymentKey
PaymentKeyHash (KeyHash Guard -> KeyHash Payment
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole KeyHash Guard
kh) | KeyHash Guard
kh <- Set (KeyHash Guard) -> [KeyHash Guard]
forall a. Set a -> [a]
Set.toList Set (KeyHash Guard)
keyhashes]

friendlyWithdrawals :: L.Withdrawals -> Aeson.Value
friendlyWithdrawals :: Withdrawals -> Value
friendlyWithdrawals (L.Withdrawals Map AccountAddress Coin
ws)
  | Map AccountAddress Coin -> Bool
forall k a. Map k a -> Bool
Map.null Map AccountAddress Coin
ws = Value
Null
  | Bool
otherwise =
      [Value] -> Value
array
        [ [(Key, Value)] -> Value
object ([(Key, Value)] -> Value) -> [(Key, Value)] -> Value
forall a b. (a -> b) -> a -> b
$
            Key
"address" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StakeAddress -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress StakeAddress
addr
              (Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
: Key
"amount" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin -> Value
friendlyLovelace Coin
amount
              (Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
: StakeAddress -> [(Key, Value)]
friendlyStakeAddress StakeAddress
addr
        | (AccountAddress
rewardAccount, Coin
amount) <- Map AccountAddress Coin -> [(AccountAddress, Coin)]
forall k a. Map k a -> [(k, a)]
Map.toList Map AccountAddress Coin
ws
        , let addr :: StakeAddress
addr = AccountAddress -> StakeAddress
fromShelleyStakeAddr AccountAddress
rewardAccount
        ]

friendlyStakeAddress :: StakeAddress -> [Aeson.Pair]
friendlyStakeAddress :: StakeAddress -> [(Key, Value)]
friendlyStakeAddress (StakeAddress Network
net Credential Staking
cred) =
  [ Key
"network" Key -> Network -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Network
net
  , Credential Staking -> (Key, Value)
friendlyStakeCredential Credential Staking
cred
  ]

friendlyTxOut :: Exp.Era era -> TxOut CtxTx era -> Aeson.Value
friendlyTxOut :: forall era. Era era -> TxOut CtxTx era -> Value
friendlyTxOut Era era
era (TxOut AddressInEra era
addr TxOutValue era
amount TxOutDatum CtxTx era
mdatum ReferenceScript era
script) =
  Era era -> (EraCommonConstraints era => Value) -> Value
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era => Value) -> Value)
-> (EraCommonConstraints era => Value) -> Value
forall a b. (a -> b) -> a -> b
$
    [(Key, Value)] -> Value
object ([(Key, Value)] -> Value) -> [(Key, Value)] -> Value
forall a b. (a -> b) -> a -> b
$
      case AddressInEra era
addr of
        AddressInEra AddressTypeInEra addrtype era
ByronAddressInAnyEra Address addrtype
byronAdr ->
          [ Key
"address era" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Byron"
          , Key
"address" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Address addrtype -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress Address addrtype
byronAdr
          , Key
"amount" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Era era -> TxOutValue era -> Value
forall era. Era era -> TxOutValue era -> Value
friendlyTxOutValue Era era
era TxOutValue era
amount
          ]
        AddressInEra (ShelleyAddressInEra ShelleyBasedEra era
_) saddr :: Address addrtype
saddr@(ShelleyAddress Network
net Credential Payment
cred StakeReference
stake) ->
          let preAlonzo :: [(Key, Value)]
preAlonzo =
                PaymentCredential -> (Key, Value)
friendlyPaymentCredential (Credential Payment -> PaymentCredential
fromShelleyPaymentCredential Credential Payment
cred)
                  (Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
: [ Key
"address era" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Aeson.String Text
"Shelley"
                    , Key
"network" Key -> Network -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Network
net
                    , Key
"address" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Address addrtype -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress Address addrtype
saddr
                    , Key
"amount" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Era era -> TxOutValue era -> Value
forall era. Era era -> TxOutValue era -> Value
friendlyTxOutValue Era era
era TxOutValue era
amount
                    , Key
"stake reference" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StakeAddressReference -> Value
friendlyStakeReference (StakeReference -> StakeAddressReference
fromShelleyStakeReference StakeReference
stake)
                    ]
              datum :: [(Key, Value)]
datum = [Key
"datum" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
d | Value
d <- Maybe Value -> [Value]
forall a. Maybe a -> [a]
maybeToList (Maybe Value -> [Value]) -> Maybe Value -> [Value]
forall a b. (a -> b) -> a -> b
$ TxOutDatum CtxTx era -> Maybe Value
forall era. TxOutDatum CtxTx era -> Maybe Value
renderDatum TxOutDatum CtxTx era
mdatum]
              sinceAlonzo :: [(Key, Value)]
sinceAlonzo = [Key
"reference script" Key -> ReferenceScript era -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReferenceScript era
script]
           in [(Key, Value)]
preAlonzo [(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. [a] -> [a] -> [a]
++ [(Key, Value)]
datum [(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. [a] -> [a] -> [a]
++ [(Key, Value)]
sinceAlonzo
 where
  renderDatum :: TxOutDatum CtxTx era -> Maybe Aeson.Value
  renderDatum :: forall era. TxOutDatum CtxTx era -> Maybe Value
renderDatum = \case
    TxOutDatum CtxTx era
TxOutDatumNone -> Maybe Value
forall a. Maybe a
Nothing
    TxOutDatumHash AlonzoEraOnwards era
_ Hash ScriptData
h -> Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Hash ScriptData -> Value
forall a. ToJSON a => a -> Value
toJSON Hash ScriptData
h
    TxOutSupplementalDatum AlonzoEraOnwards era
_ HashableScriptData
sData -> Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ ScriptDataJsonSchema -> HashableScriptData -> Value
scriptDataToJson ScriptDataJsonSchema
ScriptDataJsonDetailedSchema HashableScriptData
sData
    TxOutDatumInline BabbageEraOnwards era
_ HashableScriptData
sData -> Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ ScriptDataJsonSchema -> HashableScriptData -> Value
scriptDataToJson ScriptDataJsonSchema
ScriptDataJsonDetailedSchema HashableScriptData
sData

friendlyStakeReference :: StakeAddressReference -> Aeson.Value
friendlyStakeReference :: StakeAddressReference -> Value
friendlyStakeReference = \case
  StakeAddressReference
NoStakeAddress -> Value
Null
  StakeAddressByPointer StakeAddressPointer
ptr -> Text -> Value
String (StakeAddressPointer -> Text
forall a. Show a => a -> Text
textShow StakeAddressPointer
ptr)
  StakeAddressByValue StakeCredential
cred -> [(Key, Value)] -> Value
object [Credential Staking -> (Key, Value)
friendlyStakeCredential (Credential Staking -> (Key, Value))
-> Credential Staking -> (Key, Value)
forall a b. (a -> b) -> a -> b
$ StakeCredential -> Credential Staking
toShelleyStakeCredential StakeCredential
cred]

friendlyCertificate :: Exp.Era era -> Exp.Certificate (Exp.LedgerEra era) -> Aeson.Value
friendlyCertificate :: forall era. Era era -> Certificate (LedgerEra era) -> Value
friendlyCertificate Era era
era =
  Era era
-> (EraCommonConstraints era =>
    Certificate (LedgerEra era) -> Value)
-> Certificate (LedgerEra era)
-> Value
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era => Certificate (LedgerEra era) -> Value)
 -> Certificate (LedgerEra era) -> Value)
-> (EraCommonConstraints era =>
    Certificate (LedgerEra era) -> Value)
-> Certificate (LedgerEra era)
-> Value
forall a b. (a -> b) -> a -> b
$
    [(Key, Value)] -> Value
object ([(Key, Value)] -> Value)
-> (Certificate (LedgerEra era) -> [(Key, Value)])
-> Certificate (LedgerEra era)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
: []) ((Key, Value) -> [(Key, Value)])
-> (Certificate (LedgerEra era) -> (Key, Value))
-> Certificate (LedgerEra era)
-> [(Key, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Era era -> Certificate (LedgerEra era) -> (Key, Value)
forall era. Era era -> Certificate (LedgerEra era) -> (Key, Value)
renderCertificate Era era
era

renderCertificate
  :: Exp.Era era -> Exp.Certificate (Exp.LedgerEra era) -> (Aeson.Key, Aeson.Value)
renderCertificate :: forall era. Era era -> Certificate (LedgerEra era) -> (Key, Value)
renderCertificate Era era
era (Exp.Certificate TxCert (LedgerEra era)
c) =
  case Era era
era of
    Era era
Exp.ConwayEra -> ConwayTxCert (LedgerEra ConwayEra) -> (Key, Value)
renderConwayCertificate TxCert (LedgerEra era)
ConwayTxCert (LedgerEra ConwayEra)
c
    Era era
Exp.DijkstraEra -> [Char] -> (Key, Value)
forall a. HasCallStack => [Char] -> a
error [Char]
"renderCertificate: TODO Dijkstra era not supported"

renderDrepCredential
  :: ()
  => L.Credential L.DRepRole
  -> Aeson.Value
renderDrepCredential :: Credential DRepRole -> Value
renderDrepCredential =
  [(Key, Value)] -> Value
object ([(Key, Value)] -> Value)
-> (Credential DRepRole -> [(Key, Value)])
-> Credential DRepRole
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    L.ScriptHashObj ScriptHash
sHash -> [Key
"scriptHash" Key -> ScriptHash -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ScriptHash
sHash]
    L.KeyHashObj KeyHash DRepRole
keyHash -> [Key
"keyHash" Key -> KeyHash DRepRole -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash DRepRole
keyHash]

delegateeJson
  :: L.Delegatee
  -> Aeson.Value
delegateeJson :: Delegatee -> Value
delegateeJson =
  [(Key, Value)] -> Value
object ([(Key, Value)] -> Value)
-> (Delegatee -> [(Key, Value)]) -> Delegatee -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    L.DelegStake hk :: KeyHash StakePool
hk@L.KeyHash{} ->
      [ Key
"delegatee type" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"stake"
      , Key
"key hash" Key -> KeyHash StakePool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash StakePool
hk
      ]
    L.DelegVote DRep
drep -> do
      [Key
"delegatee type" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"vote", Key
"DRep" Key -> DRep -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DRep
drep]
    L.DelegStakeVote KeyHash StakePool
kh DRep
drep ->
      [ Key
"delegatee type" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"stake vote"
      , Key
"key hash" Key -> KeyHash StakePool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash StakePool
kh
      , Key
"DRep" Key -> DRep -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DRep
drep
      ]

renderConwayCertificate
  :: Ledger.ConwayTxCert (Exp.LedgerEra ConwayEra) -> (Aeson.Key, Aeson.Value)
renderConwayCertificate :: ConwayTxCert (LedgerEra ConwayEra) -> (Key, Value)
renderConwayCertificate ConwayTxCert (LedgerEra ConwayEra)
cert =
  case ConwayTxCert (LedgerEra ConwayEra)
cert of
    L.RegDRepTxCert Credential DRepRole
credential Coin
coin StrictMaybe Anchor
mAnchor ->
      Key
"Drep registration certificate"
        Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
          [ Key
"deposit" Key -> Coin -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
coin
          , Key
"certificate" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential DRepRole -> Value
renderDrepCredential Credential DRepRole
credential
          , Key
"anchor" Key -> StrictMaybe Anchor -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Anchor
mAnchor
          ]
    L.UnRegDRepTxCert Credential DRepRole
credential Coin
coin ->
      Key
"Drep unregistration certificate"
        Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
          [ Key
"refund" Key -> Coin -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
coin
          , Key
"certificate" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential DRepRole -> Value
renderDrepCredential Credential DRepRole
credential
          ]
    L.AuthCommitteeHotKeyTxCert Credential ColdCommitteeRole
coldCred Credential HotCommitteeRole
hotCred
      | L.ScriptHashObj ScriptHash
sh <- Credential ColdCommitteeRole
coldCred ->
          Key
"Cold committee authorization"
            Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
              [Key
"script hash" Key -> ScriptHash -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ScriptHash
sh]
      | L.ScriptHashObj ScriptHash
sh <- Credential HotCommitteeRole
hotCred ->
          Key
"Hot committee authorization"
            Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
              [Key
"script hash" Key -> ScriptHash -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ScriptHash
sh]
      | L.KeyHashObj ck :: KeyHash ColdCommitteeRole
ck@L.KeyHash{} <- Credential ColdCommitteeRole
coldCred
      , L.KeyHashObj hk :: KeyHash HotCommitteeRole
hk@L.KeyHash{} <- Credential HotCommitteeRole
hotCred ->
          Key
"Constitutional committee member hot key registration"
            Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
              [ Key
"cold key hash" Key -> KeyHash ColdCommitteeRole -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash ColdCommitteeRole
ck
              , Key
"hot key hash" Key -> KeyHash HotCommitteeRole -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash HotCommitteeRole
hk
              ]
    L.ResignCommitteeColdTxCert Credential ColdCommitteeRole
cred StrictMaybe Anchor
anchor -> case Credential ColdCommitteeRole
cred of
      L.ScriptHashObj ScriptHash
sh ->
        Key
"Cold committee resignation"
          Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
            [ Key
"script hash" Key -> ScriptHash -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ScriptHash
sh
            , Key
"anchor" Key -> StrictMaybe Anchor -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Anchor
anchor
            ]
      L.KeyHashObj ck :: KeyHash ColdCommitteeRole
ck@L.KeyHash{} ->
        Key
"Constitutional committee cold key resignation"
          Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
            [ Key
"cold key hash" Key -> KeyHash ColdCommitteeRole -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash ColdCommitteeRole
ck
            ]
    L.RegTxCert Credential Staking
stakeCredential ->
      Key
"Stake address registration"
        Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
          [ Key
"stake credential" Key -> Credential Staking -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential Staking
stakeCredential
          ]
    L.UnRegTxCert Credential Staking
stakeCredential ->
      Key
"Stake address deregistration"
        Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
          [ Key
"stake credential" Key -> Credential Staking -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential Staking
stakeCredential
          ]
    L.RegDepositTxCert Credential Staking
stakeCredential Coin
deposit ->
      Key
"Stake address registration"
        Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
          [ Key
"stake credential" Key -> Credential Staking -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential Staking
stakeCredential
          , Key
"deposit" Key -> Coin -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
deposit
          ]
    L.UnRegDepositTxCert Credential Staking
stakeCredential Coin
refund ->
      Key
"Stake address deregistration"
        Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
          [ Key
"stake credential" Key -> Credential Staking -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential Staking
stakeCredential
          , Key
"refund" Key -> Coin -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
refund
          ]
    L.DelegTxCert Credential Staking
stakeCredential Delegatee
delegatee ->
      Key
"Stake address delegation"
        Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
          [ Key
"stake credential" Key -> Credential Staking -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential Staking
stakeCredential
          , Key
"delegatee" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Delegatee -> Value
delegateeJson Delegatee
delegatee
          ]
    L.RegDepositDelegTxCert Credential Staking
stakeCredential Delegatee
delegatee Coin
deposit ->
      Key
"Stake address registration and delegation"
        Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
          [ Key
"stake credential" Key -> Credential Staking -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential Staking
stakeCredential
          , Key
"delegatee" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Delegatee -> Value
delegateeJson Delegatee
delegatee
          , Key
"deposit" Key -> Coin -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
deposit
          ]
    L.RegPoolTxCert StakePoolParams
poolParams ->
      Key
"Pool registration"
        Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
          [ Key
"pool params" Key -> StakePoolParams -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StakePoolParams
poolParams
          ]
    L.RetirePoolTxCert kh :: KeyHash StakePool
kh@L.KeyHash{} EpochNo
epoch ->
      Key
"Pool retirement"
        Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
          [ Key
"stake pool key hash" Key -> KeyHash StakePool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash StakePool
kh
          , Key
"epoch" Key -> EpochNo -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EpochNo
epoch
          ]
    L.UpdateDRepTxCert Credential DRepRole
drepCredential StrictMaybe Anchor
mbAnchor ->
      Key
"Drep certificate update"
        Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object
          [ Key
"Drep credential" Key -> Credential DRepRole -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential DRepRole
drepCredential
          , Key
"anchor " Key -> StrictMaybe Anchor -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Anchor
mbAnchor
          ]
    ConwayTxCert (LedgerEra ConwayEra)
_ -> Key
"unsupported certificate" Key -> Value -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ConwayTxCert ConwayEra -> [Char]
forall a. Show a => a -> [Char]
show ConwayTxCert (LedgerEra ConwayEra)
ConwayTxCert ConwayEra
cert)

friendlyStakeCredential
  :: L.Credential L.Staking -> Aeson.Pair
friendlyStakeCredential :: Credential Staking -> (Key, Value)
friendlyStakeCredential = \case
  L.KeyHashObj KeyHash Staking
keyHash ->
    Key
"stake credential key hash" Key -> KeyHash Staking -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash Staking
keyHash
  L.ScriptHashObj ScriptHash
scriptHash ->
    Key
"stake credential script hash" Key -> ScriptHash -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ScriptHash
scriptHash

friendlyPaymentCredential :: PaymentCredential -> Aeson.Pair
friendlyPaymentCredential :: PaymentCredential -> (Key, Value)
friendlyPaymentCredential = \case
  PaymentCredentialByKey Hash PaymentKey
keyHash ->
    Key
"payment credential key hash" Key -> Hash PaymentKey -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Hash PaymentKey
keyHash
  PaymentCredentialByScript ScriptHash
scriptHash ->
    Key
"payment credential script hash" Key -> ScriptHash -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ScriptHash
scriptHash

friendlyLovelace :: Lovelace -> Aeson.Value
friendlyLovelace :: Coin -> Value
friendlyLovelace Coin
value = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> Text
docToText (Coin -> Doc AnsiStyle
forall ann. Coin -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Coin
value)

friendlyTxOutValue :: Exp.Era era -> TxOutValue era -> Aeson.Value
friendlyTxOutValue :: forall era. Era era -> TxOutValue era -> Value
friendlyTxOutValue Era era
era = \case
  TxOutValueByron Coin
lovelace -> Coin -> Value
friendlyLovelace Coin
lovelace
  TxOutValueShelleyBased ShelleyBasedEra era
_ Value (ShelleyLedgerEra era)
v ->
    Era era -> (EraCommonConstraints era => Value) -> Value
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era => Value) -> Value)
-> (EraCommonConstraints era => Value) -> Value
forall a b. (a -> b) -> a -> b
$ Era era -> Value (LedgerEra era) -> Value
forall era. Era era -> Value (LedgerEra era) -> Value
friendlyLedgerValue Era era
era Value (ShelleyLedgerEra era)
Value (LedgerEra era)
v

friendlyLedgerValue
  :: ()
  => Exp.Era era
  -> L.Value (Exp.LedgerEra era)
  -> Aeson.Value
friendlyLedgerValue :: forall era. Era era -> Value (LedgerEra era) -> Value
friendlyLedgerValue Era era
era Value (LedgerEra era)
v =
  Era era -> (EraCommonConstraints era => Value) -> Value
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era => Value) -> Value)
-> (EraCommonConstraints era => Value) -> Value
forall a b. (a -> b) -> a -> b
$
    Value -> Value
friendlyValue (ShelleyBasedEra era -> Value (ShelleyLedgerEra era) -> Value
forall era.
ShelleyBasedEra era -> Value (ShelleyLedgerEra era) -> Value
Api.fromLedgerValue (Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era) Value (ShelleyLedgerEra era)
Value (LedgerEra era)
v)

friendlyValue :: Api.Value -> Aeson.Value
friendlyValue :: Value -> Value
friendlyValue Value
v =
  [(Key, Value)] -> Value
object
    [ case ValueNestedBundle
bundle of
        ValueNestedBundleAda Quantity
q -> Key
"lovelace" Key -> Quantity -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Quantity
q
        ValueNestedBundle PolicyId
policy Map AssetName Quantity
assets ->
          Text -> Key
Aeson.fromText (PolicyId -> Text
friendlyPolicyId PolicyId
policy) Key -> Map Text Quantity -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map AssetName Quantity -> Map Text Quantity
forall {a}. Map AssetName a -> Map Text a
friendlyAssets Map AssetName Quantity
assets
    | ValueNestedBundle
bundle <- [ValueNestedBundle]
bundles
    ]
 where
  ValueNestedRep [ValueNestedBundle]
bundles = Value -> ValueNestedRep
valueToNestedRep Value
v

  friendlyPolicyId :: PolicyId -> Text
friendlyPolicyId = (Text
"policy " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (PolicyId -> Text) -> PolicyId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolicyId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText

  friendlyAssets :: Map AssetName a -> Map Text a
friendlyAssets = (AssetName -> Text) -> Map AssetName a -> Map Text a
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys AssetName -> Text
friendlyAssetName

  friendlyAssetName :: AssetName -> Text
friendlyAssetName = \case
    UnsafeAssetName ByteString
"" -> Text
"default asset"
    name :: AssetName
name@(UnsafeAssetName ByteString
nameBS) ->
      Text
"asset " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AssetName -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText AssetName
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameAsciiSuffix
     where
      nameAsciiSuffix :: Text
nameAsciiSuffix
        | Bool
nameIsAscii = Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameAscii Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        | Bool
otherwise = Text
""
      nameIsAscii :: Bool
nameIsAscii = (Char -> Bool) -> ByteString -> Bool
BSC.all (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c) ByteString
nameBS
      nameAscii :: Text
nameAscii = [Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
BSC.unpack ByteString
nameBS

friendlyMetadata
  :: forall era
   . L.EraTxAuxData era
  => Maybe (L.TxAuxData era) -> Aeson.Value
friendlyMetadata :: forall era. EraTxAuxData era => Maybe (TxAuxData era) -> Value
friendlyMetadata Maybe (TxAuxData era)
Nothing = Value
Null
friendlyMetadata (Just TxAuxData era
auxData) =
  let m :: Map Word64 Metadatum
m = TxAuxData era
auxData TxAuxData era
-> Getting
     (Map Word64 Metadatum) (TxAuxData era) (Map Word64 Metadatum)
-> Map Word64 Metadatum
forall s a. s -> Getting a s a -> a
^. Getting
  (Map Word64 Metadatum) (TxAuxData era) (Map Word64 Metadatum)
forall era.
EraTxAuxData era =>
Lens' (TxAuxData era) (Map Word64 Metadatum)
Lens' (TxAuxData era) (Map Word64 Metadatum)
L.metadataTxAuxDataL
   in if Map Word64 Metadatum -> Bool
forall k a. Map k a -> Bool
Map.null Map Word64 Metadatum
m
        then Value
Null
        else Map Word64 Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Map Word64 Value -> Value) -> Map Word64 Value -> Value
forall a b. (a -> b) -> a -> b
$ Metadatum -> Value
friendlyMetadatum (Metadatum -> Value) -> Map Word64 Metadatum -> Map Word64 Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Word64 Metadatum
m

friendlyMetadatum :: L.Metadatum -> Aeson.Value
friendlyMetadatum :: Metadatum -> Value
friendlyMetadatum = \case
  L.I Integer
int -> Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
int
  L.B ByteString
bytes -> Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a. Show a => a -> Text
textShow ByteString
bytes
  L.List [Metadatum]
lst -> [Value] -> Value
array ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (Metadatum -> Value) -> [Metadatum] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Metadatum -> Value
friendlyMetadatum [Metadatum]
lst
  L.Map [(Metadatum, Metadatum)]
m ->
    [Value] -> Value
array
      [[Value] -> Value
array [Metadatum -> Value
friendlyMetadatum Metadatum
k, Metadatum -> Value
friendlyMetadatum Metadatum
v] | (Metadatum
k, Metadatum
v) <- [(Metadatum, Metadatum)]
m]
  L.S Text
text -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
text

-- | Render aux-data scripts. Conway+ aux data exposes native (timelock) and
-- Plutus scripts. Matches the old API's @textShow scripts@ shape.
friendlyAuxScripts
  :: Exp.Era era
  -> Maybe (L.TxAuxData (Exp.LedgerEra era))
  -> Aeson.Value
friendlyAuxScripts :: forall era. Era era -> Maybe (TxAuxData (LedgerEra era)) -> Value
friendlyAuxScripts Era era
_ Maybe (TxAuxData (LedgerEra era))
Nothing = Value
Null
friendlyAuxScripts Era era
era (Just TxAuxData (LedgerEra era)
aux) = case Era era
era of
  Era era
Exp.ConwayEra -> TxAuxData ConwayEra -> Value
forall ledgerEra.
(AlonzoEraTxAuxData ledgerEra, Show (NativeScript ledgerEra)) =>
TxAuxData ledgerEra -> Value
renderAux TxAuxData (LedgerEra era)
TxAuxData ConwayEra
aux
  Era era
Exp.DijkstraEra -> TxAuxData DijkstraEra -> Value
forall ledgerEra.
(AlonzoEraTxAuxData ledgerEra, Show (NativeScript ledgerEra)) =>
TxAuxData ledgerEra -> Value
renderAux TxAuxData (LedgerEra era)
TxAuxData DijkstraEra
aux
 where
  renderAux
    :: ( L.AlonzoEraTxAuxData ledgerEra
       , Show (C.NativeScript ledgerEra)
       )
    => L.TxAuxData ledgerEra -> Aeson.Value
  renderAux :: forall ledgerEra.
(AlonzoEraTxAuxData ledgerEra, Show (NativeScript ledgerEra)) =>
TxAuxData ledgerEra -> Value
renderAux TxAuxData ledgerEra
ad =
    let nat :: StrictSeq (NativeScript ledgerEra)
nat = TxAuxData ledgerEra
ad TxAuxData ledgerEra
-> Getting
     (StrictSeq (NativeScript ledgerEra))
     (TxAuxData ledgerEra)
     (StrictSeq (NativeScript ledgerEra))
-> StrictSeq (NativeScript ledgerEra)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (NativeScript ledgerEra))
  (TxAuxData ledgerEra)
  (StrictSeq (NativeScript ledgerEra))
forall era.
AllegraEraTxAuxData era =>
Lens' (TxAuxData era) (StrictSeq (NativeScript era))
Lens' (TxAuxData ledgerEra) (StrictSeq (NativeScript ledgerEra))
L.nativeScriptsTxAuxDataL
        plut :: Map Language (NonEmpty PlutusBinary)
plut = TxAuxData ledgerEra
ad TxAuxData ledgerEra
-> Getting
     (Map Language (NonEmpty PlutusBinary))
     (TxAuxData ledgerEra)
     (Map Language (NonEmpty PlutusBinary))
-> Map Language (NonEmpty PlutusBinary)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map Language (NonEmpty PlutusBinary))
  (TxAuxData ledgerEra)
  (Map Language (NonEmpty PlutusBinary))
forall era.
AlonzoEraTxAuxData era =>
Lens' (TxAuxData era) (Map Language (NonEmpty PlutusBinary))
Lens' (TxAuxData ledgerEra) (Map Language (NonEmpty PlutusBinary))
L.plutusScriptsTxAuxDataL
     in if StrictSeq (NativeScript ledgerEra) -> Bool
forall a. StrictSeq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null StrictSeq (NativeScript ledgerEra)
nat Bool -> Bool -> Bool
&& Map Language (NonEmpty PlutusBinary) -> Bool
forall k a. Map k a -> Bool
Map.null Map Language (NonEmpty PlutusBinary)
plut
          then Value
Null
          else Text -> Value
String ((StrictSeq (NativeScript ledgerEra),
 Map Language (NonEmpty PlutusBinary))
-> Text
forall a. Show a => a -> Text
textShow (StrictSeq (NativeScript ledgerEra)
nat, Map Language (NonEmpty PlutusBinary)
plut))

friendlyDRep :: L.DRep -> Aeson.Value
friendlyDRep :: DRep -> Value
friendlyDRep DRep
L.DRepAlwaysAbstain = Value
"alwaysAbstain"
friendlyDRep DRep
L.DRepAlwaysNoConfidence = Value
"alwaysNoConfidence"
friendlyDRep (L.DRepCredential sch :: Credential DRepRole
sch@(L.ScriptHashObj (C.ScriptHash Hash ADDRHASH EraIndependentScript
_))) =
  [(Key, Value)] -> Value
Aeson.object
    [ Key
"scriptHash" Key -> Maybe ScriptHash -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential DRepRole -> Maybe ScriptHash
forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash Credential DRepRole
sch
    , Key
"cip129Hex" Key -> ByteString -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential DRepRole -> ByteString
forall a. Cip129 a => a -> ByteString
cip129SerialiseRaw Credential DRepRole
sch
    , Key
"cip129Bech32" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential DRepRole -> Text
forall a. Cip129 a => a -> Text
serialiseToBech32Cip129 Credential DRepRole
sch
    ]
friendlyDRep (L.DRepCredential kh :: Credential DRepRole
kh@(L.KeyHashObj (C.KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
_))) =
  [(Key, Value)] -> Value
Aeson.object
    [ Key
"keyHash" Key -> Maybe (KeyHash DRepRole) -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential DRepRole -> Maybe (KeyHash DRepRole)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash r)
credKeyHash Credential DRepRole
kh
    , Key
"cip129Hex" Key -> ByteString -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential DRepRole -> ByteString
forall a. Cip129 a => a -> ByteString
cip129SerialiseRaw Credential DRepRole
kh
    , Key
"cip129Bech32" Key -> Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Credential DRepRole -> Text
forall a. Cip129 a => a -> Text
serialiseToBech32Cip129 Credential DRepRole
kh
    ]