content: --  This Source Code Form is subject to the terms of the Mozilla Public
  --  License, v. 2.0. If a copy of the MPL was not distributed with this
  --  file, You can obtain one at http://mozilla.org/MPL/2.0/.
  {-# LANGUAGE TypeOperators #-}
  
  module Ogmios.Data.Json.Conway where
  
  import Ogmios.Data.Json.Prelude
  
  import Cardano.Ledger.Api
      ( AsItem (..)
      , AsIx (..)
      , PlutusPurpose
      )
  import Cardano.Ledger.BaseTypes
      ( BoundedRational (..)
      , EpochNo
      , NonNegativeInterval
      , ProtVer
      )
  import Cardano.Ledger.Binary
      ( sizedValue
      )
  import Cardano.Ledger.Conway.PParams
      ( THKD (..)
      )
  import Cardano.Ledger.Hashes
      ( extractHash
      )
  import Cardano.Ledger.HKD
      ( HKDFunctor (..)
      )
  import Cardano.Ledger.Keys
      ( KeyRole (..)
      )
  import Ouroboros.Consensus.Shelley.Ledger.Block
      ( ShelleyBlock (..)
      )
  import Ouroboros.Consensus.Shelley.Protocol.Praos
      ()
  
  import qualified Data.Map as Map
  
  import qualified Cardano.Ledger.Api as Ledger
  import qualified Cardano.Ledger.Block as Ledger
  import qualified Cardano.Ledger.Core as Ledger
  import qualified Cardano.Ledger.Credential as Ledger
  import qualified Cardano.Ledger.DRep as Ledger
  import qualified Cardano.Ledger.HKD as Ledger
  
  import qualified Cardano.Ledger.Shelley.PParams as Sh
  
  import qualified Cardano.Ledger.Alonzo.PParams as Al
  import qualified Cardano.Ledger.Alonzo.TxSeq as Al
  
  import qualified Cardano.Ledger.Babbage.Core as Ba
  import qualified Cardano.Ledger.Babbage.Tx as Ba
  
  import qualified Cardano.Ledger.Conway.Genesis as Cn
  import qualified Cardano.Ledger.Conway.Governance as Cn
  import qualified Cardano.Ledger.Conway.PParams as Cn
  import qualified Cardano.Ledger.Conway.Tx as Cn
  import qualified Cardano.Ledger.Conway.TxBody as Cn
  import qualified Cardano.Ledger.Conway.TxCert as Cn
  
  import qualified Cardano.Ledger.Alonzo.Plutus.TxInfo as Al
  import qualified Cardano.Ledger.Alonzo.Scripts as Al
  import qualified Cardano.Ledger.Api.State.Query as Cn
  import qualified Cardano.Ledger.Babbage.TxInfo as Ba
  import qualified Cardano.Ledger.Conway.Scripts as Cn
  import qualified Cardano.Ledger.Conway.TxInfo as Cn
  import Cardano.Ledger.Plutus
      ( TxOutSource (..)
      )
  import qualified Ogmios.Data.Json.Allegra as Allegra
  import qualified Ogmios.Data.Json.Alonzo as Alonzo
  import qualified Ogmios.Data.Json.Babbage as Babbage
  import qualified Ogmios.Data.Json.Mary as Mary
  import qualified Ogmios.Data.Json.Shelley as Shelley
  
  encodeAnchor
      :: Cn.Anchor
      -> Json
  encodeAnchor x = encodeObject
      ( "url" .=
          encodeUrl (Cn.anchorUrl x)
     <> "hash" .=
          Shelley.encodeHash (extractHash (Cn.anchorDataHash x))
      )
  
  encodeBlock
      :: (MetadataFormat, IncludeCbor)
      -> ShelleyBlock (Praos StandardCrypto) ConwayEra
      -> Json
  encodeBlock opts (ShelleyBlock (Ledger.Block blkHeader txs) headerHash) =
      encodeObject
          ( "type" .= encodeText "praos"
          <>
            "era" .= encodeText "conway"
          <>
            "id" .= Shelley.encodeShelleyHash headerHash
          <>
            Babbage.encodeHeader blkHeader
          <>
            "transactions" .= encodeFoldable (encodeTx opts) (Al.txSeqTxns txs)
          )
  
  encodeCommittee
      :: Cn.Committee ConwayEra
      -> Json
  encodeCommittee x = encodeObject
      ( "members" .=
          encodeMapAsList (\k -> encodeConstitutionalCommitteeMember k . SJust) (Cn.committeeMembers x)
     <> "quorum" .=
          encodeUnitInterval (Cn.committeeThreshold x)
      )
  
  encodeCommitteeMembersState
      :: Cn.CommitteeMembersState
      -> Json
  encodeCommitteeMembersState x = encodeObject
      ( "members" .=
          encodeMapAsList encodeConstitutionalCommitteeMemberState (Cn.csCommittee x)
     <> "quorum" .=
          encodeMaybe encodeUnitInterval (Cn.csThreshold x)
      )
  
  encodeConstitutionalCommitteeMemberState
      :: Ledger.Credential 'ColdCommitteeRole
      -> Cn.CommitteeMemberState
      -> Json
  encodeConstitutionalCommitteeMemberState memberId st = encodeObject
      ( "id" `Shelley.encodeCredential` memberId
     <> "delegate" .=
          encodeHotCredAuthStatus (Cn.cmsHotCredAuthStatus st)
     <> "status" .=
          encodeMemberStatus (Cn.cmsStatus st)
     <> "mandate" .=? OmitWhenNothing
          (encodeSingleton "epoch" . encodeEpochNo) (maybeToStrictMaybe (Cn.cmsExpiration st))
     <> "next" .=? OmitWhenNothing
         identity (encodeNextEpochChange (Cn.cmsNextEpochChange st))
      )
  
  encodeMemberStatus :: Cn.MemberStatus -> Json
  encodeMemberStatus = encodeText . \case
      -- Votes of this member will count during ratification
      Cn.Active -> "active"
      Cn.Expired -> "expired"
      -- This can happen when a hot credential for an unknown cold credential exists.
      -- Such Committee member will be either removed from the state at the next
      -- epoch boundary or enacted as a new member.
      Cn.Unrecognized -> "unrecognized"
  
  encodeHotCredAuthStatus
      :: Cn.HotCredAuthStatus
      -> Json
  encodeHotCredAuthStatus = \case
      Cn.MemberNotAuthorized ->
          encodeObject
              ( "status" .= encodeText "none"
              )
      Cn.MemberAuthorized hot ->
          encodeObject
              ( "status" .= encodeText "authorized"
             <> "id" `Shelley.encodeCredential` hot
              )
      Cn.MemberResigned anchor ->
          encodeObject
              (  "status" .= encodeText "resigned"
              <> "metadata" .=? OmitWhenNothing
                  encodeAnchor (maybeToStrictMaybe anchor)
              )
  
  encodeNextEpochChange
      :: Cn.NextEpochChange
      -> StrictMaybe Json
  encodeNextEpochChange = fmap encodeObject . \case
      Cn.NoChangeExpected ->
          SNothing
      Cn.ToBeEnacted ->
          SJust
              ( "change" .= encodeText "toBeEnacted"
              )
      Cn.ToBeRemoved ->
          SJust
              ( "change" .= encodeText "toBeRemoved"
              )
      Cn.ToBeExpired ->
          SJust
              ( "change" .= encodeText "expiring"
              )
      Cn.TermAdjusted mandate ->
          SJust
              ( "change" .= encodeText "adjustingMandate"
             <> "mandate" .= encodeSingleton "epoch" (encodeEpochNo mandate)
              )
  
  encodeContextError
      :: ( PlutusPurpose AsIx era ~ Cn.ConwayPlutusPurpose AsIx era
         )
      => Cn.ConwayContextError era
      -> Json
  encodeContextError err = encodeText $ case err of
      Cn.CertificateNotSupported{} ->
          "A certificate in the transaction isn't supported in neither plutus:v1 nor plutus:v2. Use plutus:v3 or higher."
      Cn.PlutusPurposeNotSupported{}  ->
          "A script purpose in the transaction isn't supported in neither plutus:v1 nor plutus:v2. Use plutus:v3 or higher."
      Cn.CurrentTreasuryFieldNotSupported{} ->
          "Unsupported field in transaction: 'treasury'. Use plutus:v3 or higher, or remove this field."
      Cn.VotingProceduresFieldNotSupported{} ->
          "Unsupported field in transaction: 'votes'. Use plutus:v3 or higher, or remove this field."
      Cn.ProposalProceduresFieldNotSupported{} ->
          "Unsupported field in transaction: 'proposals'. Use plutus:v3 or higher, or remove this field."
      Cn.TreasuryDonationFieldNotSupported{} ->
          "Unsupported field in transaction: 'donation'. Use plutus:v3 or higher, or remove this field."
      Cn.BabbageContextError (Ba.ByronTxOutInContext TxOutFromInput{}) ->
          "Found inputs locked by a (legacy) Byron/Bootstrap address. Don't use those."
      Cn.BabbageContextError (Ba.ByronTxOutInContext TxOutFromOutput{}) ->
          "Found outputs to a (legacy) Byron/Bootstrap address. Don't use those."
      Cn.BabbageContextError (Ba.InlineDatumsNotSupported{}) ->
         "Inline datums not supported in plutus:v1. Use plutus:v2 or higher."
      Cn.BabbageContextError (Ba.ReferenceScriptsNotSupported{}) ->
         "Reference scripts not supported in plutus:v1. Use plutus:v2 or higher."
      Cn.BabbageContextError (Ba.ReferenceInputsNotSupported{}) ->
         "Reference inputs not supported in plutus:v1. Use plutus:v2 or higher."
      Cn.BabbageContextError (Ba.RedeemerPointerPointsToNothing purpose) ->
          let (title, ptr) =
                  case purpose of
                      Cn.ConwaySpending (AsIx ix) -> ("spending input", ix)
                      Cn.ConwayMinting (AsIx ix) -> ("minting policy", ix)
                      Cn.ConwayCertifying (AsIx ix) -> ("publishing certificate", ix)
                      Cn.ConwayRewarding (AsIx ix) -> ("withdrawing from account", ix)
                      Cn.ConwayVoting (AsIx ix) -> ("voting as voter", ix)
                      Cn.ConwayProposing (AsIx ix) -> ("proposing governance proposal", ix)
            in "Couldn't find corresponding redeemer for " <> title <> " #" <> show ptr <> ". Verify your transaction's construction."
      Cn.BabbageContextError (Ba.AlonzoContextError (Al.TimeTranslationPastHorizon e)) ->
          "Uncomputable slot arithmetic; transaction's validity bounds go beyond the foreseeable end of the current era: " <> e
      Cn.BabbageContextError (Ba.AlonzoContextError (Al.TranslationLogicMissingInput i)) ->
          "Unknown transaction input (missing from UTxO set): " <> Shelley.stringifyTxIn i
  
  encodeConstitution
      :: Cn.Constitution era
      -> Series
  encodeConstitution x =
      "metadata" .=
          encodeAnchor (Cn.constitutionAnchor x) <>
      "guardrails" .=
          encodeStrictMaybe
              (\s -> encodeObject ("hash" .= Shelley.encodeScriptHash s))
              (Cn.constitutionScript x)
  
  encodeConstitutionalCommitteeMember
      :: Ledger.Credential 'ColdCommitteeRole
      -> StrictMaybe EpochNo
      -> Json
  encodeConstitutionalCommitteeMember memberId mandate =
      encodeObject
          ( "id" `Shelley.encodeCredential` memberId
         <> "mandate" .=? OmitWhenNothing
              (encodeSingleton "epoch" . encodeEpochNo) mandate
          )
  
  encodeConwayGovCert
      :: Cn.ConwayGovCert
      -> Series
  encodeConwayGovCert = \case
      Cn.ConwayRegDRep credential deposit anchor ->
          "type" .=
              encodeText "delegateRepresentativeRegistration"
         <>
          "delegateRepresentative" .=
              encodeObject (encodeDRep (Ledger.DRepCredential credential))
         <>
          "deposit" .=
              encodeCoin deposit
         <>
          "metadata" .=? OmitWhenNothing
              encodeAnchor anchor
      Cn.ConwayUnRegDRep credential deposit ->
          "type" .=
              encodeText "delegateRepresentativeRetirement"
         <>
          "delegateRepresentative" .=
              encodeObject (encodeDRep (Ledger.DRepCredential credential))
         <>
          "deposit" .=
              encodeCoin deposit
      Cn.ConwayUpdateDRep credential anchor ->
          "type" .=
              encodeText "delegateRepresentativeUpdate"
         <>
          "delegateRepresentative" .=
              encodeObject (encodeDRep (Ledger.DRepCredential credential))
         <>
          "metadata" .=
              encodeStrictMaybe encodeAnchor anchor
      Cn.ConwayAuthCommitteeHotKey cold hot ->
          "type" .=
              encodeText "constitutionalCommitteeDelegation"
         <>
          "member" .=
              encodeConstitutionalCommitteeMember cold SNothing
         <>
          "delegate" .= encodeHotCredAuthStatus (Cn.MemberAuthorized hot)
      Cn.ConwayResignCommitteeColdKey cold anchor ->
          "type" .=
              encodeText "constitutionalCommitteeRetirement"
         <>
          "member" .=
              encodeConstitutionalCommitteeMember cold SNothing
         <>
          "metadata" .=? OmitWhenNothing
              encodeAnchor anchor
  
  encodeDelegCert
      :: Cn.ConwayDelegCert
      -> NonEmpty Series
  encodeDelegCert = \case
      Cn.ConwayRegCert credential deposit ->
          ( "type" .=
              encodeText "stakeCredentialRegistration"
         <> "credential" `Shelley.encodeCredential` credential
         <> "deposit" .=? OmitWhenNothing
              encodeCoin deposit
          ) :| []
      Cn.ConwayUnRegCert credential deposit ->
          ( "type" .=
              encodeText "stakeCredentialDeregistration"
          <> "credential" `Shelley.encodeCredential` credential
          <> "deposit" .=? OmitWhenNothing
              encodeCoin deposit
          ) :| []
      Cn.ConwayDelegCert credential delegatee ->
          ( "type" .=
              encodeText "stakeDelegation"
          <> "credential" `Shelley.encodeCredential` credential
          <> encodeDelegatee delegatee
          ) :| []
      Cn.ConwayRegDelegCert credential delegatee deposit ->
          ( "type" .=
              encodeText "stakeCredentialRegistration"
         <> "credential" `Shelley.encodeCredential` credential
         <> "deposit" .=
              encodeCoin deposit
          ) :|
          [ "type" .=
              encodeText "stakeDelegation"
         <> "credential" `Shelley.encodeCredential` credential
         <> encodeDelegatee delegatee
          ]
  
  encodeDelegatee
      :: Cn.Delegatee
      -> Series
  encodeDelegatee = \case
      Cn.DelegStake poolId ->
          "stakePool" .= encodeSingleton "id" (Shelley.encodePoolId poolId)
      Cn.DelegVote drep ->
          "delegateRepresentative" .= encodeObject (encodeDRep drep)
      Cn.DelegStakeVote poolId drep ->
          "stakePool" .= encodeSingleton "id" (Shelley.encodePoolId poolId)
          <>
          "delegateRepresentative" .= encodeObject (encodeDRep drep)
  
  encodeDRep
      :: Ledger.DRep
      -> Series
  encodeDRep = \case
      Ledger.DRepCredential credential ->
          "type" .= encodeText "registered" <>
          "id" `Shelley.encodeCredential` credential
      Ledger.DRepAlwaysAbstain ->
          "type" .= encodeText "abstain"
      Ledger.DRepAlwaysNoConfidence ->
          "type" .= encodeText "noConfidence"
  
  encodeGenesis
      :: Cn.ConwayGenesis
      -> Json
  encodeGenesis x =
     encodeObject
         ( "era" .= encodeText "conway"
        <> "constitution" .= encodeObject (encodeConstitution (Cn.cgConstitution x))
        <> "constitutionalCommittee" .= encodeCommittee (Cn.cgCommittee x)
        <> "updatableParameters" .= encodeObject
             ( "stakePoolVotingThresholds" .=
                 encodePoolVotingThresholds (Cn.ucppPoolVotingThresholds (Cn.cgUpgradePParams x))
            <> "delegateRepresentativeVotingThresholds" .=
                 encodeDRepVotingThresholds (Cn.ucppDRepVotingThresholds (Cn.cgUpgradePParams x))
            <> "constitutionalCommitteeMinSize" .=
                 encodeWord16 (Cn.ucppCommitteeMinSize (Cn.cgUpgradePParams x))
            <> "constitutionalCommitteeMaxTermLength" .=
                 encodeEpochInterval (Cn.ucppCommitteeMaxTermLength (Cn.cgUpgradePParams x))
            <> "governanceActionLifetime" .=
                 encodeEpochInterval (Cn.ucppGovActionLifetime (Cn.cgUpgradePParams x))
            <> "governanceActionDeposit" .=
                 encodeCoin (Cn.ucppGovActionDeposit (Cn.cgUpgradePParams x))
            <> "delegateRepresentativeDeposit" .=
                 encodeCoin (Cn.ucppDRepDeposit (Cn.cgUpgradePParams x))
            <> "delegateRepresentativeMaxIdleTime" .=
                 encodeEpochInterval (Cn.ucppDRepActivity (Cn.cgUpgradePParams x))
             )
         )
  
  encodeGovAction
      :: Cn.GovAction ConwayEra
      -> Json
  encodeGovAction = \case
      Cn.ParameterChange ancestor pparamsUpdate guardrails ->
          encodeObject
              ( "type" .=
                  encodeText "protocolParametersUpdate"
             <> "ancestor" .=? OmitWhenNothing
                  (encodeGovActionId . Cn.unGovPurposeId) ancestor
             <> "parameters" .=
                  encodePParamsUpdate pparamsUpdate
             <> "guardrails" .=
                  encodeStrictMaybe (\s -> encodeObject ("hash" .= Shelley.encodeScriptHash s)) guardrails
              )
      Cn.HardForkInitiation ancestor version ->
          encodeObject
              ( "type" .=
                  encodeText "hardForkInitiation"
             <> "ancestor" .=? OmitWhenNothing
                 (encodeGovActionId . Cn.unGovPurposeId) ancestor
             <> "version" .=
                  Shelley.encodeProtVer version
              )
      Cn.TreasuryWithdrawals withdrawals guardrails ->
          encodeObject
              ( "type" .=
                  encodeText "treasuryWithdrawals"
             <> "withdrawals" .=
                  encodeMap Shelley.stringifyRewardAcnt encodeCoin withdrawals
             <> "guardrails" .=
                  encodeStrictMaybe (\s -> encodeObject ("hash" .= Shelley.encodeScriptHash s)) guardrails
              )
      Cn.UpdateCommittee ancestor removed added quorum ->
          encodeObject
              ( "type" .=
                  encodeText "constitutionalCommittee"
             <> "ancestor" .=? OmitWhenNothing
                  (encodeGovActionId . Cn.unGovPurposeId) ancestor
             <> "members" .= encodeObject
                  ( "added" .=
                      encodeMapAsList (\k -> encodeConstitutionalCommitteeMember k . SJust) added
                 <> "removed" .=
                      encodeFoldable (`encodeConstitutionalCommitteeMember` SNothing) removed
                  )
             <> "quorum" .=
                  encodeUnitInterval quorum
              )
      Cn.NewConstitution ancestor constitution  ->
          encodeObject
              ( "type" .=
                  encodeText "constitution"
             <> "ancestor" .=? OmitWhenNothing
                 (encodeGovActionId . Cn.unGovPurposeId) ancestor
             <> encodeConstitution constitution
              )
      Cn.NoConfidence ancestor ->
          encodeObject
              ( "type" .=
                  encodeText "noConfidence"
             <> "ancestor" .=? OmitWhenNothing
                  (encodeGovActionId . Cn.unGovPurposeId) ancestor
              )
      Cn.InfoAction ->
          encodeObject
              ( "type" .=
                  encodeText "information"
              )
  
  encodeGovActionId
      :: Cn.GovActionId
      -> Json
  encodeGovActionId x =
      encodeObject
          ( "transaction" .=
              encodeObject (Shelley.encodeTxId (Cn.gaidTxId x))
          <> "index" .=
              encodeGovActionIx (Cn.gaidGovActionIx x)
          )
  
  encodeGovActionIx
      :: Cn.GovActionIx
      -> Json
  encodeGovActionIx (Cn.GovActionIx ix) =
      encodeWord16 ix
  
  encodeGovActionPurpose
      :: Cn.GovActionPurpose
      -> Json
  encodeGovActionPurpose = \case
    Cn.PParamUpdatePurpose ->
        encodeText "protocolParametersUpdate"
    Cn.HardForkPurpose ->
        encodeText "hardForkInitiation"
    Cn.CommitteePurpose ->
        encodeText "constitutionalCommittee"
    Cn.ConstitutionPurpose ->
        encodeText "constitution"
  
  encodePParams
      :: (Ledger.PParamsHKD Identity era ~ Cn.ConwayPParams Identity era)
      => Ledger.PParams era
      -> Json
  encodePParams (Ledger.PParams x) =
      encodePParamsHKD (\k encode v -> k .= encode v) identity x
  
  encodePParamsUpdate
      :: (Ledger.PParamsHKD StrictMaybe era ~ Cn.ConwayPParams StrictMaybe era)
      => Ledger.PParamsUpdate era
      -> Json
  encodePParamsUpdate (Ledger.PParamsUpdate x) =
      encodePParamsHKD (\k encode v -> k .=? OmitWhenNothing encode v) (const SNothing) x
  
  encodeProposedPPUpdates
      :: forall era.
          ( Ledger.PParamsHKD StrictMaybe era ~ Cn.ConwayPParams StrictMaybe era
          )
      => Sh.ProposedPPUpdates era
      -> Json
  encodeProposedPPUpdates (Sh.ProposedPPUpdates m) =
      encodeFoldable
          (\(Ledger.PParamsUpdate x) ->
              encodePParamsHKD
                  (\k encode v -> k .=? OmitWhenNothing encode v)
                  (const SNothing)
                  x
          )
          m
  encodePParamsHKD
      :: forall f era. (HKDFunctor f)
      => (forall a. Text -> (a -> Json) -> Ledger.HKD f a -> Series)
      -> (forall a. a -> Ledger.HKD f a)
      -> Cn.ConwayPParams f era
      -> Json
  encodePParamsHKD encode pure_ x =
      encode "minFeeCoefficient"
          (encodeInteger . unCoin) (unTHKD (Cn.cppMinFeeA x)) <>
      encode "minFeeConstant"
          encodeCoin (unTHKD (Cn.cppMinFeeB x)) <>
      encode "minFeeReferenceScripts"
          (\(base :: NonNegativeInterval) -> encodeObject
              -- NOTE: This will very likely always be an integer. The ledger
              -- represent this as a 'NonNegativeInterval', which technically
              -- allow any _Rational_ value between 0 and +INFINITY, but it is
              -- highly impractical to manipulate a Rationale here from an API
              -- standpoint.
              --
              -- So this is a debatable choice, but I believe it's better for
              -- users to convert to a Double so that it is directly a number in
              -- JSON, and we can still accomodate decimal representation so long
              -- as they don't get _too precise_ (which should be a fair
              -- assumption in this context).
              ( "base" .= encodeDouble (fromRational (unboundRational base))
              <>
                "range" .= encodeWord32 25600
              <>
                "multiplier" .= encodeDouble 1.2
              )
          )
          (unTHKD (Cn.cppMinFeeRefScriptCostPerByte x))
          <>
      encode "maxBlockBodySize"
          (encodeSingleton "bytes" . encodeWord32) (unTHKD (Cn.cppMaxBBSize x)) <>
      encode "maxBlockHeaderSize"
          (encodeSingleton "bytes" . encodeWord16) (unTHKD (Cn.cppMaxBHSize x)) <>
      encode "maxTransactionSize"
          (encodeSingleton "bytes" . encodeWord32) (unTHKD (Cn.cppMaxTxSize x)) <>
      encode "maxReferenceScriptsSize"
          (encodeSingleton "bytes" . encodeWord32) (pure_ @Word32 204800) <> -- NOTE: Hard-coded in Conway.
      encode "stakeCredentialDeposit"
          encodeCoin (unTHKD (Cn.cppKeyDeposit x)) <>
      encode "stakePoolDeposit"
          encodeCoin (unTHKD (Cn.cppPoolDeposit x)) <>
      encode "stakePoolRetirementEpochBound"
          encodeEpochInterval (unTHKD (Cn.cppEMax x)) <>
      encode "desiredNumberOfStakePools"
          encodeWord16 (unTHKD (Cn.cppNOpt x)) <>
      encode "stakePoolPledgeInfluence"
          encodeNonNegativeInterval (unTHKD (Cn.cppA0 x)) <>
      encode "monetaryExpansion"
          encodeUnitInterval (unTHKD (Cn.cppRho x)) <>
      encode "treasuryExpansion"
          encodeUnitInterval (unTHKD (Cn.cppTau x)) <>
      encode "minStakePoolCost"
          encodeCoin (unTHKD (Cn.cppMinPoolCost x)) <>
      encode "minUtxoDepositConstant"
          encodeCoin (pure_ (Coin 0)) <>
      encode "minUtxoDepositCoefficient"
          (encodeInteger . unCoin . Ba.unCoinPerByte) (unTHKD (Cn.cppCoinsPerUTxOByte x)) <>
      encode "plutusCostModels"
          Alonzo.encodeCostModels (unTHKD (Cn.cppCostModels x)) <>
      encode "scriptExecutionPrices"
          Alonzo.encodePrices (unTHKD (Cn.cppPrices x)) <>
      encode "maxExecutionUnitsPerTransaction"
          (Alonzo.encodeExUnits . Al.unOrdExUnits) (unTHKD (Cn.cppMaxTxExUnits x)) <>
      encode "maxExecutionUnitsPerBlock"
          (Alonzo.encodeExUnits . Al.unOrdExUnits) (unTHKD (Cn.cppMaxBlockExUnits x)) <>
      encode "maxValueSize"
          (encodeSingleton "bytes" . encodeWord32) (unTHKD (Cn.cppMaxValSize x)) <>
      encode "collateralPercentage"
          encodeWord16 (unTHKD (Cn.cppCollateralPercentage x)) <>
      encode "maxCollateralInputs"
          encodeWord16 (unTHKD (Cn.cppMaxCollateralInputs x)) <>
      encode "version"
          Shelley.encodeProtVer (fromNoUpdate @f @ProtVer (Cn.cppProtocolVersion x)) <>
      encode "stakePoolVotingThresholds"
          encodePoolVotingThresholds (unTHKD (Cn.cppPoolVotingThresholds x)) <>
      encode "delegateRepresentativeVotingThresholds"
          encodeDRepVotingThresholds (unTHKD (Cn.cppDRepVotingThresholds x)) <>
      encode "constitutionalCommitteeMinSize"
          encodeWord16 (unTHKD (Cn.cppCommitteeMinSize x)) <>
      encode "constitutionalCommitteeMaxTermLength"
          encodeEpochInterval (unTHKD (Cn.cppCommitteeMaxTermLength x)) <>
      encode "governanceActionLifetime"
          encodeEpochInterval (unTHKD (Cn.cppGovActionLifetime x)) <>
      encode "governanceActionDeposit"
          encodeCoin (unTHKD (Cn.cppGovActionDeposit x)) <>
      encode "delegateRepresentativeDeposit"
          encodeCoin (unTHKD (Cn.cppDRepDeposit x)) <>
      encode "delegateRepresentativeMaxIdleTime"
          encodeEpochInterval (unTHKD (Cn.cppDRepActivity x))
      & encodeObject
  
  encodeDRepVotingThresholds :: Cn.DRepVotingThresholds -> Json
  encodeDRepVotingThresholds x =
      "noConfidence" .= encodeUnitInterval (Cn.dvtMotionNoConfidence x) <>
      "constitutionalCommittee" .= encodeObject
          ( "default" .= encodeUnitInterval (Cn.dvtCommitteeNormal x)
         <> "stateOfNoConfidence" .= encodeUnitInterval (Cn.dvtCommitteeNoConfidence x)
          ) <>
      "constitution" .= encodeUnitInterval (Cn.dvtUpdateToConstitution x) <>
      "hardForkInitiation" .= encodeUnitInterval (Cn.dvtHardForkInitiation x) <>
      "protocolParametersUpdate" .= encodeObject
          ( "network" .= encodeUnitInterval (Cn.dvtPPNetworkGroup x)
         <> "economic" .= encodeUnitInterval (Cn.dvtPPEconomicGroup x)
         <> "technical" .= encodeUnitInterval (Cn.dvtPPTechnicalGroup x)
         <> "governance" .= encodeUnitInterval (Cn.dvtPPGovGroup x)
          ) <>
      "treasuryWithdrawals" .= encodeUnitInterval (Cn.dvtTreasuryWithdrawal x)
      & encodeObject
  
  encodePoolVotingThresholds :: Cn.PoolVotingThresholds -> Json
  encodePoolVotingThresholds x =
      "noConfidence" .= encodeUnitInterval (Cn.pvtMotionNoConfidence x) <>
      "constitutionalCommittee" .= encodeObject
          ( "default" .= encodeUnitInterval (Cn.pvtCommitteeNormal x)
         <> "stateOfNoConfidence" .= encodeUnitInterval (Cn.pvtCommitteeNoConfidence x)
          ) <>
      "hardForkInitiation" .= encodeUnitInterval (Cn.pvtHardForkInitiation x) <>
      "protocolParametersUpdate" .= encodeObject
          ( "security" .= encodeUnitInterval (Cn.pvtPPSecurityGroup x)
          )
      & encodeObject
  
  encodeProposalProcedure
      :: Cn.ProposalProcedure ConwayEra
      -> Series
  encodeProposalProcedure x =
        "deposit" .=
          encodeCoin (Cn.pProcDeposit x)
     <> "returnAccount" .=
          Shelley.encodeRewardAcnt (Cn.pProcReturnAddr x)
     <> "metadata" .=
         encodeAnchor (Cn.pProcAnchor x)
     <> "action" .=
          encodeGovAction (Cn.pProcGovAction x)
  
  encodeScriptPurposeIndex
      :: forall era. ()
      => Cn.ConwayPlutusPurpose AsIx era
      -> Json
  encodeScriptPurposeIndex = \case
      Cn.ConwaySpending ix ->
          translate (Al.AlonzoSpending ix)
      Cn.ConwayMinting ix ->
          translate (Al.AlonzoMinting ix)
      Cn.ConwayCertifying (AsIx (AsIx -> ix)) ->
          translate (Al.AlonzoCertifying ix)
      Cn.ConwayRewarding ix ->
          translate (Al.AlonzoRewarding ix)
      Cn.ConwayVoting (AsIx ix) ->
          encodeObject
              ( "index" .=
                  encodeWord32 ix
             <> "purpose" .=
                  encodeText "vote"
              )
      Cn.ConwayProposing (AsIx ix) ->
          encodeObject
              ( "index" .=
                  encodeWord32 ix
             <> "purpose" .=
                  encodeText "propose"
              )
    where
      translate = Alonzo.encodeScriptPurposeIndex @AlonzoEra
  
  encodeScriptPurposeItem
      :: Cn.ConwayPlutusPurpose AsItem ConwayEra
      -> Json
  encodeScriptPurposeItem = encodeObject . \case
      Cn.ConwaySpending (AsItem txIn) ->
          "purpose" .= encodeText "spend" <>
          "outputReference" .= encodeObject (Shelley.encodeTxIn txIn)
      Cn.ConwayMinting (AsItem policyId) ->
          "purpose" .= encodeText "mint" <>
          "policy" .= Mary.encodePolicyId policyId
      Cn.ConwayRewarding (AsItem acct) ->
          "purpose" .= encodeText "withdraw" <>
          "rewardAccount" .= Shelley.encodeRewardAcnt acct
      Cn.ConwayVoting (AsItem voter) ->
          "purpose" .= encodeText "vote" <>
          "issuer" .= encodeVoter voter
      Cn.ConwayProposing (AsItem proposal) ->
          "purpose" .= encodeText "propose" <>
          "proposal" .= encodeObject (encodeProposalProcedure proposal)
      Cn.ConwayCertifying (AsItem cert) ->
          case encodeTxCert @ConwayEra cert of
              -- Delegation certificate or credential de-registration certificate
              c :| [] ->
                  "purpose" .= encodeText "publish" <>
                  "certificate" .= encodeObject c
              -- Combination of credential registration & delegation certificate.
              --
              -- Registering credentials is not _scriptable_, so never associated
              -- with a purpose.
              _ :| (c : _) ->
                  "purpose" .= encodeText "publish" <>
                  "certificate" .= encodeObject c
  
  encodeTx
      :: (MetadataFormat, IncludeCbor)
      -> Ba.AlonzoTx ConwayEra
      -> Json
  encodeTx (fmt, opts) x =
      encodeObject
          ( Shelley.encodeTxId (Ledger.txIdTxBody @ConwayEra (Cn.body x))
         <>
          "spends" .= Alonzo.encodeIsValid (Cn.isValid x)
         <>
          encodeTxBody opts (Cn.body x) (strictMaybe mempty (Map.keys . snd) auxiliary)
         <>
          "metadata" .=? OmitWhenNothing fst auxiliary
         <>
          Alonzo.encodeWitnessSet opts (snd <$> auxiliary) encodeScriptPurposeIndex (Cn.wits x)
         <>
          if includeTransactionCbor opts then
             "cbor" .= encodeByteStringBase16 (encodeCbor @ConwayEra x)
          else
             mempty
          )
    where
      auxiliary = do
          hash <- Shelley.encodeAuxiliaryDataHash <$> Cn.ctbAdHash (Cn.body x)
          (labels, scripts) <- Alonzo.encodeAuxiliaryData (fmt, opts) <$> Ba.auxiliaryData x
          pure
              ( encodeObject ("hash" .= hash <> "labels" .= labels)
              , scripts
              )
  
  encodeTxBody
      :: IncludeCbor
      -> Cn.ConwayTxBody ConwayEra
      -> [Ledger.ScriptHash]
      -> Series
  encodeTxBody opts x scripts =
      "inputs" .=
          encodeFoldable (encodeObject . Shelley.encodeTxIn) (Cn.ctbSpendInputs x) <>
      "references" .=? OmitWhen null
          (encodeFoldable (encodeObject . Shelley.encodeTxIn)) (Cn.ctbReferenceInputs x) <>
      "outputs" .=
          encodeFoldable (encodeObject . Babbage.encodeTxOut opts . sizedValue) (Cn.ctbOutputs x) <>
      "collaterals" .=? OmitWhen null
          (encodeFoldable (encodeObject . Shelley.encodeTxIn)) (Cn.ctbCollateralInputs x) <>
      "collateralReturn" .=? OmitWhenNothing
          (encodeObject . Babbage.encodeTxOut opts . sizedValue) (Cn.ctbCollateralReturn x) <>
      "totalCollateral" .=? OmitWhenNothing
          encodeCoin (Cn.ctbTotalCollateral x) <>
      "certificates" .=? OmitWhen null
          (encodeConcatNonEmptyFoldable (fmap encodeObject . encodeTxCert)) (Cn.ctbCerts x) <>
      "withdrawals" .=? OmitWhen (null . Ledger.unWithdrawals)
          Shelley.encodeWdrl (Cn.ctbWithdrawals x) <>
      "mint" .=? OmitWhen (== mempty)
          (encodeObject . Mary.encodeMultiAsset) (Cn.ctbMint x) <>
      "requiredExtraSignatories" .=? OmitWhen null
          (encodeFoldable Shelley.encodeKeyHash) (Cn.ctbReqSignerHashes x) <>
      "requiredExtraScripts" .=? OmitWhen null
          (encodeFoldable Shelley.encodeScriptHash) scripts <>
      "network" .=? OmitWhenNothing
          Shelley.encodeNetwork (Cn.ctbTxNetworkId x) <>
      "scriptIntegrityHash" .=? OmitWhenNothing
          Alonzo.encodeScriptIntegrityHash (Cn.ctbScriptIntegrityHash x) <>
      "fee" .=
          encodeCoin (Cn.ctbTxfee x) <>
      "validityInterval" .=
          Allegra.encodeValidityInterval (Cn.ctbVldt x) <>
      "proposals" .=? OmitWhen null
          (encodeFoldable (encodeObject . encodeProposalProcedure))
          (Cn.ctbProposalProcedures x) <>
      "votes" .=? OmitWhen (null . Cn.unVotingProcedures)
          encodeVotingProcedures
          (Cn.ctbVotingProcedures x) <>
      "treasury" .=? OmitWhen (\_ -> isSJust (Cn.ctbCurrentTreasuryValue x) || Cn.ctbTreasuryDonation x /= mempty)
          identity
          (encodeObject
              ( "value" .=? OmitWhenNothing
                  encodeCoin (Cn.ctbCurrentTreasuryValue x)
             <> "donation" .=? OmitWhen (== mempty)
                  encodeCoin (Cn.ctbTreasuryDonation x)
              )
          )
  
  encodeTxCert
      :: Cn.ConwayTxCert era
      -> NonEmpty Series
  encodeTxCert = \case
      Cn.ConwayTxCertDeleg dCert ->
          encodeDelegCert dCert
      Cn.ConwayTxCertPool pCert ->
          Shelley.encodePoolCert pCert :| []
      Cn.ConwayTxCertGov cCert ->
          encodeConwayGovCert cCert :| []
  
  encodeVotingProcedures
      :: Cn.VotingProcedures ConwayEra
      -> Json
  encodeVotingProcedures =
      encodeList identity . Map.foldrWithKey encodeProcedures mempty . Cn.unVotingProcedures
    where
      encodeProcedures issuer =
          flip $ Map.foldrWithKey
              (\govActionId  -> (:) . encodeVotingProcedure issuer govActionId)
  
  encodeVotingProcedure
      :: Cn.Voter
      -> Cn.GovActionId
      -> Cn.VotingProcedure ConwayEra
      -> Json
  encodeVotingProcedure issuer govActionId x =
      encodeObject
          ( "proposal" .=
              encodeGovActionId govActionId
         <> "issuer" .=
             encodeVoter issuer
         <> "vote" .=
             encodeVote (Cn.vProcVote x)
         <> "metadata" .=? OmitWhenNothing
              encodeAnchor (Cn.vProcAnchor x)
          )
  
  encodeVote
      :: Cn.Vote
      -> Json
  encodeVote = \case
      Cn.VoteYes -> encodeText "yes"
      Cn.VoteNo -> encodeText "no"
      Cn.Abstain -> encodeText "abstain"
  
  encodeVoter
      :: Cn.Voter
      -> Json
  encodeVoter = encodeObject . \case
      Cn.CommitteeVoter credential ->
          "role" .= encodeText "constitutionalCommittee" <>
          "id" `Shelley.encodeCredential` credential
      Cn.DRepVoter credential ->
          "role" .= encodeText "delegateRepresentative" <>
          "id" `Shelley.encodeCredential` credential
      Cn.StakePoolVoter poolId ->
          "role" .= encodeText "stakePoolOperator" <>
          "id" .= Shelley.encodePoolId poolId
  