{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans -Wno-unused-imports #-}

module Cardano.Api.Internal.Orphans.Serialisation
  ( AsType
        ( AsColdCommitteeCredential
        , AsHotCommitteeCredential
        , AsDrepCredential
        , AsGovActionId
        )
  )
where

import Cardano.Api.HasTypeProxy
import Cardano.Api.Internal.Orphans.Misc
import Cardano.Api.Ledger qualified as Ledger
import Cardano.Api.Monad.Error (MonadError (..), (?!))
import Cardano.Api.Pretty (Pretty (..), prettyException, (<+>))
import Cardano.Api.Pretty.Internal.ShowOf
import Cardano.Api.Serialise.Raw
import Cardano.Api.Tx.Internal.TxIn

import Cardano.Binary (DecoderError (..))
import Cardano.Binary qualified as CBOR
import Cardano.Chain.Byron.API qualified as L
import Cardano.Chain.Common qualified as L
import Cardano.Chain.Delegation.Validation.Scheduling qualified as L.Scheduling
import Cardano.Chain.UTxO.UTxO qualified as L
import Cardano.Chain.UTxO.Validation qualified as L
import Cardano.Chain.Update qualified as L
import Cardano.Chain.Update.Validation.Endorsement qualified as L.Endorsement
import Cardano.Chain.Update.Validation.Interface qualified as L.Interface
import Cardano.Chain.Update.Validation.Registration qualified as L.Registration
import Cardano.Chain.Update.Validation.Voting qualified as L.Voting
import Cardano.Crypto.Hash qualified as Crypto
import Cardano.Ledger.Allegra qualified as Allegra (ApplyTxError (..))
import Cardano.Ledger.Allegra.Rules qualified as L
import Cardano.Ledger.Alonzo qualified as Alonzo (ApplyTxError (..))
import Cardano.Ledger.Alonzo.PParams qualified as Ledger
import Cardano.Ledger.Alonzo.Rules qualified as Alonzo
import Cardano.Ledger.Alonzo.Rules qualified as L
import Cardano.Ledger.Alonzo.Tx qualified as L
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.Api.State.Query qualified as Ledger
import Cardano.Ledger.Babbage qualified as Babbage (ApplyTxError (..))
import Cardano.Ledger.Babbage.PParams qualified as Ledger
import Cardano.Ledger.Babbage.Rules qualified as Babbage
import Cardano.Ledger.Babbage.Rules qualified as L
import Cardano.Ledger.BaseTypes (strictMaybeToMaybe)
import Cardano.Ledger.BaseTypes qualified as L
import Cardano.Ledger.BaseTypes qualified as Ledger
import Cardano.Ledger.Binary
import Cardano.Ledger.Binary.Plain qualified as Plain
import Cardano.Ledger.Coin qualified as L
import Cardano.Ledger.Conway qualified as Conway (ApplyTxError (..))
import Cardano.Ledger.Conway.PParams qualified as Ledger
import Cardano.Ledger.Conway.Rules qualified as L
import Cardano.Ledger.Conway.TxCert qualified as L
import Cardano.Ledger.Core qualified as L hiding (KeyHash)
import Cardano.Ledger.Dijkstra qualified as Dijkstra (ApplyTxError (..))
import Cardano.Ledger.Dijkstra.Rules qualified as L
import Cardano.Ledger.HKD (NoUpdate (..))
import Cardano.Ledger.Hashes qualified as L hiding (KeyHash)
import Cardano.Ledger.Keys qualified as L.Keys
import Cardano.Ledger.Mary qualified as Mary (ApplyTxError (..))
import Cardano.Ledger.Mary.Value qualified as L
import Cardano.Ledger.Plutus.Language qualified as L
import Cardano.Ledger.Shelley.API.Mempool qualified as L
import Cardano.Ledger.Shelley.API.Mempool qualified as Shelley (ApplyTxError (..))
import Cardano.Ledger.Shelley.PParams qualified as Ledger
import Cardano.Ledger.Shelley.Rules qualified as L
import Cardano.Ledger.Shelley.TxBody qualified as L
import Cardano.Ledger.Shelley.TxCert qualified as L
import Cardano.Protocol.Crypto qualified as P
import Cardano.Protocol.TPraos.API qualified as Ledger
import Cardano.Protocol.TPraos.BHeader (HashHeader (..))
import Cardano.Protocol.TPraos.Rules.Prtcl qualified as L
import Cardano.Protocol.TPraos.Rules.Prtcl qualified as Ledger
import Cardano.Protocol.TPraos.Rules.Tickn qualified as Ledger
import Ouroboros.Consensus.Byron.Ledger.Block (ByronHash (..))
import Ouroboros.Consensus.HardFork.Combinator (OneEraHash (..))
import Ouroboros.Consensus.Protocol.Praos (PraosState)
import Ouroboros.Consensus.Protocol.Praos qualified as Consensus
import Ouroboros.Consensus.Protocol.TPraos (TPraosState)
import Ouroboros.Consensus.Protocol.TPraos qualified as Consensus
import Ouroboros.Consensus.Shelley.Eras qualified as Consensus
import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyHash (..))
import Ouroboros.Consensus.Shelley.Ledger.Query qualified as Consensus
import Ouroboros.Network.Block (HeaderHash, Tip (..))
import Ouroboros.Network.Protocol.LocalTxSubmission.Type qualified as Net.Tx
import PlutusLedgerApi.Common qualified as P
import PlutusLedgerApi.V2 qualified as V2

import Codec.Binary.Bech32 qualified as Bech32
import Codec.CBOR.Read qualified as CBOR
import Data.Aeson
  ( KeyValue ((.=))
  , ToJSON (..)
  , ToJSONKey (..)
  , decode
  , defaultOptions
  , encode
  , genericToJSON
  , object
  , pairs
  )
import Data.Aeson qualified as A
import Data.Aeson qualified as Aeson
import Data.Bifunctor
import Data.ByteString qualified as BS
import Data.ByteString.Base16 qualified as B16
import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Builder qualified as BSB
import Data.ByteString.Char8 qualified as C8
import Data.ByteString.Short qualified as SBS
import Data.Data (Data)
import Data.Kind (Constraint, Type)
import Data.ListMap (ListMap)
import Data.ListMap qualified as ListMap
import Data.Map.NonEmpty (NonEmptyMap)
import Data.Map.NonEmpty qualified as NonEmptyMap
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Monoid
import Data.Set.NonEmpty (NonEmptySet)
import Data.Set.NonEmpty qualified as NonEmptySet
import Data.Text qualified as T
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.Typeable (Typeable)
import Data.Word (Word16)
import GHC.Exts (IsList (..), IsString (..))
import GHC.Generics
import GHC.Stack (HasCallStack)
import GHC.TypeLits
import Lens.Micro
import Network.Mux qualified as Mux
import Numeric (showHex)
import Prettyprinter (punctuate, viaShow)
import Text.Read

deriving instance Generic (L.Registration.TooLarge a)

deriving instance Generic L.ApplicationNameError

deriving instance Generic L.ApplyMempoolPayloadErr

deriving instance Generic L.Endorsement.Error

deriving instance Generic L.Interface.Error

deriving instance Generic L.LovelaceError

deriving instance Generic L.Registration.Adopted

deriving instance Generic L.Registration.Error

deriving instance Generic L.Scheduling.Error

deriving instance Generic L.SoftwareVersionError

deriving instance Generic L.SystemTagError

deriving instance Generic L.TxValidationError

deriving instance Generic L.UTxOError

deriving instance Generic L.UTxOValidationError

deriving instance Generic L.Voting.Error

deriving anyclass instance ToJSON L.ApplicationNameError

deriving anyclass instance ToJSON L.ApplyMempoolPayloadErr

deriving anyclass instance ToJSON L.Endorsement.Error

deriving anyclass instance ToJSON L.Interface.Error

deriving anyclass instance ToJSON L.LovelaceError

deriving anyclass instance ToJSON L.Registration.Adopted

deriving anyclass instance ToJSON L.Registration.ApplicationVersion

deriving anyclass instance ToJSON L.Registration.Error

deriving anyclass instance ToJSON L.Scheduling.Error

deriving anyclass instance ToJSON L.SoftwareVersionError

deriving anyclass instance ToJSON L.SystemTagError

deriving anyclass instance ToJSON L.TxValidationError

deriving anyclass instance ToJSON L.UTxOError

deriving anyclass instance ToJSON L.UTxOValidationError

deriving anyclass instance ToJSON L.Voting.Error

deriving anyclass instance ToJSON L.VotingPeriod

deriving anyclass instance ToJSON L.Withdrawals

instance (ToJSONKey k, ToJSON v) => ToJSON (NonEmptyMap k v) where
  toJSON :: NonEmptyMap k v -> Value
toJSON = Map k v -> Value
forall a. ToJSON a => a -> Value
toJSON (Map k v -> Value)
-> (NonEmptyMap k v -> Map k v) -> NonEmptyMap k v -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMap k v -> Map k v
forall k v. NonEmptyMap k v -> Map k v
NonEmptyMap.toMap

instance ToJSON v => ToJSON (NonEmptySet v) where
  toJSON :: NonEmptySet v -> Value
toJSON = Set v -> Value
forall a. ToJSON a => a -> Value
toJSON (Set v -> Value)
-> (NonEmptySet v -> Set v) -> NonEmptySet v -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptySet v -> Set v
forall a. NonEmptySet a -> Set a
NonEmptySet.toSet

deriving anyclass instance
  ( ToJSON (L.PredicateFailure (L.EraRule "UTXOW" ledgerera))
  , ToJSON (L.PredicateFailure (L.EraRule "DELEGS" ledgerera))
  , ToJSON (NonEmptyMap L.AccountAddress (Ledger.Mismatch Ledger.RelEQ L.Coin))
  )
  => ToJSON (L.ShelleyLedgerPredFailure ledgerera)

deriving anyclass instance
  ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera))
  => ToJSON (L.ShelleyUtxowPredFailure ledgerera)

deriving anyclass instance
  ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera))
  => ToJSON (L.ShelleyPpupPredFailure ledgerera)

instance
  ( ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera))
  , ToJSON (L.PlutusPurpose L.AsItem ledgerera)
  , ToJSON (L.PlutusPurpose L.AsIx ledgerera)
  )
  => ToJSON (L.AlonzoUtxowPredFailure ledgerera)
  where
  toJSON :: AlonzoUtxowPredFailure ledgerera -> Value
toJSON = Options -> AlonzoUtxowPredFailure ledgerera -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions

instance ToJSON C8.ByteString where
  toJSON :: ByteString -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (ByteString -> Text) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode

instance
  ( ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera))
  , ToJSON (L.TxCert ledgerera)
  , ToJSON (L.PlutusPurpose L.AsItem ledgerera)
  , ToJSON (L.PlutusPurpose L.AsIx ledgerera)
  )
  => ToJSON (L.BabbageUtxowPredFailure ledgerera)
  where
  toJSON :: BabbageUtxowPredFailure ledgerera -> Value
toJSON = Options -> BabbageUtxowPredFailure ledgerera -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions

deriving newtype instance ToJSON (Shelley.ApplyTxError Consensus.ShelleyEra)

deriving newtype instance ToJSON (Allegra.ApplyTxError Consensus.AllegraEra)

deriving newtype instance ToJSON (Mary.ApplyTxError Consensus.MaryEra)

deriving newtype instance ToJSON (Alonzo.ApplyTxError Consensus.AlonzoEra)

deriving newtype instance ToJSON (Babbage.ApplyTxError Consensus.BabbageEra)

deriving newtype instance ToJSON (Conway.ApplyTxError Consensus.ConwayEra)

-- TODO: fix this instance when the Dijkstra era is stable in Ledger
instance ToJSON (Dijkstra.ApplyTxError Consensus.DijkstraEra) where
  toJSON :: ApplyTxError DijkstraEra -> Value
toJSON = [Char] -> ApplyTxError DijkstraEra -> Value
forall a. HasCallStack => [Char] -> a
error [Char]
"Dijkstra era is not active yet"

deriving via
  ShowOf (L.Keys.VKey L.Keys.Witness)
  instance
    ToJSON (L.Keys.VKey L.Keys.Witness)

deriving via
  ShowOf (L.AllegraUtxoPredFailure ledgerera)
  instance
    Show (L.AllegraUtxoPredFailure ledgerera) => ToJSON (L.AllegraUtxoPredFailure ledgerera)

deriving via
  ShowOf (L.AlonzoUtxoPredFailure ledgerera)
  instance
    Show (L.AlonzoUtxoPredFailure ledgerera) => ToJSON (L.AlonzoUtxoPredFailure ledgerera)

deriving via
  ShowOf (L.BabbageUtxoPredFailure ledgerera)
  instance
    Show (L.BabbageUtxoPredFailure ledgerera) => ToJSON (L.BabbageUtxoPredFailure ledgerera)

deriving via
  ShowOf (L.ConwayLedgerPredFailure ledgerera)
  instance
    Show (L.ConwayLedgerPredFailure ledgerera) => ToJSON (L.ConwayLedgerPredFailure ledgerera)

deriving via
  ShowOf (L.ShelleyDelegsPredFailure ledgerera)
  instance
    Show (L.ShelleyDelegsPredFailure ledgerera) => ToJSON (L.ShelleyDelegsPredFailure ledgerera)

deriving via
  ShowOf (L.ShelleyUtxoPredFailure ledgerera)
  instance
    Show (L.ShelleyUtxoPredFailure ledgerera) => ToJSON (L.ShelleyUtxoPredFailure ledgerera)

deriving instance ToJSON a => ToJSON (L.Registration.TooLarge a)

deriving via ShowOf L.KeyHash instance ToJSON L.KeyHash

deriving via ShowOf L.ApplicationName instance ToJSONKey L.ApplicationName

instance Pretty L.Coin where
  pretty :: forall ann. Coin -> Doc ann
pretty (L.Coin Integer
n) = Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"Lovelace"

instance Pretty L.MultiAsset where
  pretty :: forall ann. MultiAsset -> Doc ann
pretty (L.MultiAsset Map PolicyID (Map AssetName Integer)
assetsMap) =
    [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
      Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate
        Doc ann
", "
        [ Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
quantity Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PolicyID -> Doc ann
forall ann. PolicyID -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty PolicyID
pId Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"." Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> AssetName -> Doc ann
forall ann. AssetName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty AssetName
name
        | (PolicyID
pId, Map AssetName Integer
assets) <- Map PolicyID (Map AssetName Integer)
-> [Item (Map PolicyID (Map AssetName Integer))]
forall l. IsList l => l -> [Item l]
toList Map PolicyID (Map AssetName Integer)
assetsMap
        , (AssetName
name, Integer
quantity) <- Map AssetName Integer -> [Item (Map AssetName Integer)]
forall l. IsList l => l -> [Item l]
toList Map AssetName Integer
assets
        ]

instance Pretty L.PolicyID where
  pretty :: forall ann. PolicyID -> Doc ann
pretty (L.PolicyID (L.ScriptHash Hash ADDRHASH EraIndependentScript
sh)) = [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann) -> [Char] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Hash ADDRHASH EraIndependentScript -> [Char]
forall h a. Hash h a -> [Char]
Crypto.hashToStringAsHex Hash ADDRHASH EraIndependentScript
sh

instance Pretty L.AssetName where
  pretty :: forall ann. AssetName -> Doc ann
pretty = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (AssetName -> Text) -> AssetName -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetName -> Text
L.assetNameToTextAsHex

-- Orphan instances involved in the JSON output of the API queries.
-- We will remove/replace these as we provide more API wrapper types

instance ToJSON Ledger.StakeSnapshots where
  toJSON :: StakeSnapshots -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (StakeSnapshots -> [Pair]) -> StakeSnapshots -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeSnapshots -> [Pair]
forall e a. KeyValue e a => StakeSnapshots -> [a]
stakeSnapshotsToPair
  toEncoding :: StakeSnapshots -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (StakeSnapshots -> Series) -> StakeSnapshots -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (StakeSnapshots -> [Series]) -> StakeSnapshots -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeSnapshots -> [Series]
forall e a. KeyValue e a => StakeSnapshots -> [a]
stakeSnapshotsToPair

stakeSnapshotsToPair
  :: Aeson.KeyValue e a => Ledger.StakeSnapshots -> [a]
stakeSnapshotsToPair :: forall e a. KeyValue e a => StakeSnapshots -> [a]
stakeSnapshotsToPair
  Ledger.StakeSnapshots
    { Map (KeyHash StakePool) StakeSnapshot
ssStakeSnapshots :: Map (KeyHash StakePool) StakeSnapshot
ssStakeSnapshots :: StakeSnapshots -> Map (KeyHash StakePool) StakeSnapshot
Ledger.ssStakeSnapshots
    , NonZero Coin
ssMarkTotal :: NonZero Coin
ssMarkTotal :: StakeSnapshots -> NonZero Coin
Ledger.ssMarkTotal
    , NonZero Coin
ssSetTotal :: NonZero Coin
ssSetTotal :: StakeSnapshots -> NonZero Coin
Ledger.ssSetTotal
    , NonZero Coin
ssGoTotal :: NonZero Coin
ssGoTotal :: StakeSnapshots -> NonZero Coin
Ledger.ssGoTotal
    } =
    [ Key
"pools" Key -> Map (KeyHash StakePool) StakeSnapshot -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash StakePool) StakeSnapshot
ssStakeSnapshots
    , Key
"total"
        Key -> Value -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
          [ Key
"stakeMark" Key -> NonZero Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonZero Coin
ssMarkTotal
          , Key
"stakeSet" Key -> NonZero Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonZero Coin
ssSetTotal
          , Key
"stakeGo" Key -> NonZero Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonZero Coin
ssGoTotal
          ]
    ]

instance ToJSON Ledger.StakeSnapshot where
  toJSON :: StakeSnapshot -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (StakeSnapshot -> [Pair]) -> StakeSnapshot -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeSnapshot -> [Pair]
forall e a. KeyValue e a => StakeSnapshot -> [a]
stakeSnapshotToPair
  toEncoding :: StakeSnapshot -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (StakeSnapshot -> Series) -> StakeSnapshot -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (StakeSnapshot -> [Series]) -> StakeSnapshot -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeSnapshot -> [Series]
forall e a. KeyValue e a => StakeSnapshot -> [a]
stakeSnapshotToPair

stakeSnapshotToPair :: Aeson.KeyValue e a => Ledger.StakeSnapshot -> [a]
stakeSnapshotToPair :: forall e a. KeyValue e a => StakeSnapshot -> [a]
stakeSnapshotToPair
  Ledger.StakeSnapshot
    { Coin
ssMarkPool :: Coin
ssMarkPool :: StakeSnapshot -> Coin
Ledger.ssMarkPool
    , Coin
ssSetPool :: Coin
ssSetPool :: StakeSnapshot -> Coin
Ledger.ssSetPool
    , Coin
ssGoPool :: Coin
ssGoPool :: StakeSnapshot -> Coin
Ledger.ssGoPool
    } =
    [ Key
"stakeMark" Key -> Coin -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
ssMarkPool
    , Key
"stakeSet" Key -> Coin -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
ssSetPool
    , Key
"stakeGo" Key -> Coin -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
ssGoPool
    ]

instance ToJSON (OneEraHash xs) where
  toJSON :: OneEraHash xs -> Value
toJSON =
    Text -> Value
forall a. ToJSON a => a -> Value
toJSON
      (Text -> Value)
-> (OneEraHash xs -> Text) -> OneEraHash xs -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeLatin1
      (ByteString -> Text)
-> (OneEraHash xs -> ByteString) -> OneEraHash xs -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode
      (ByteString -> ByteString)
-> (OneEraHash xs -> ByteString) -> OneEraHash xs -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort
      (ShortByteString -> ByteString)
-> (OneEraHash xs -> ShortByteString)
-> OneEraHash xs
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraHash xs -> ShortByteString
forall k (xs :: [k]). OneEraHash xs -> ShortByteString
getOneEraHash

deriving newtype instance ToJSON ByronHash

-- This instance is temporarily duplicated in cardano-config

instance ToJSON (HeaderHash blk) => ToJSON (Tip blk) where
  toJSON :: Tip blk -> Value
toJSON Tip blk
TipGenesis = [Pair] -> Value
Aeson.object [Key
"genesis" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True]
  toJSON (Tip SlotNo
slotNo HeaderHash blk
headerHash BlockNo
blockNo) =
    [Pair] -> Value
Aeson.object
      [ Key
"slotNo" Key -> SlotNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slotNo
      , Key
"headerHash" Key -> HeaderHash blk -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeaderHash blk
headerHash
      , Key
"blockNo" Key -> BlockNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BlockNo
blockNo
      ]

--
-- Simple newtype wrappers JSON conversion
--

deriving newtype instance ToJSON HashHeader

deriving instance ToJSON Ledger.PrtclState

deriving instance ToJSON Ledger.TicknState

deriving instance ToJSON Ledger.ChainDepState

instance ToJSON TPraosState where
  toJSON :: TPraosState -> Value
toJSON TPraosState
s =
    [Pair] -> Value
Aeson.object
      [ Key
"lastSlot" Key -> WithOrigin SlotNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TPraosState -> WithOrigin SlotNo
Consensus.tpraosStateLastSlot TPraosState
s
      , Key
"chainDepState" Key -> ChainDepState -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TPraosState -> ChainDepState
Consensus.tpraosStateChainDepState TPraosState
s
      ]

instance ToJSON PraosState where
  toJSON :: PraosState -> Value
toJSON PraosState
s =
    [Pair] -> Value
Aeson.object
      [ Key
"lastSlot" Key -> WithOrigin SlotNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PraosState -> WithOrigin SlotNo
Consensus.praosStateLastSlot PraosState
s
      , Key
"oCertCounters" Key -> Map (KeyHash BlockIssuer) Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PraosState -> Map (KeyHash BlockIssuer) Word64
Consensus.praosStateOCertCounters PraosState
s
      , Key
"evolvingNonce" Key -> Nonce -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PraosState -> Nonce
Consensus.praosStateEvolvingNonce PraosState
s
      , Key
"candidateNonce" Key -> Nonce -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PraosState -> Nonce
Consensus.praosStateCandidateNonce PraosState
s
      , Key
"epochNonce" Key -> Nonce -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PraosState -> Nonce
Consensus.praosStateEpochNonce PraosState
s
      , Key
"labNonce" Key -> Nonce -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PraosState -> Nonce
Consensus.praosStateLabNonce PraosState
s
      , Key
"lastEpochBlockNonce" Key -> Nonce -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PraosState -> Nonce
Consensus.praosStateLastEpochBlockNonce PraosState
s
      ]

deriving instance Show a => Show (Net.Tx.SubmitResult a)

instance A.FromJSON V2.ParamName where
  parseJSON :: Value -> Parser ParamName
parseJSON = [Char] -> (Text -> Parser ParamName) -> Value -> Parser ParamName
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
A.withText [Char]
"ParamName" Text -> Parser ParamName
forall a (f :: * -> *). (IsParamName a, MonadFail f) => Text -> f a
parsePlutusParamName

instance A.FromJSONKey V2.ParamName where
  fromJSONKey :: FromJSONKeyFunction ParamName
fromJSONKey = (Text -> Parser ParamName) -> FromJSONKeyFunction ParamName
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
A.FromJSONKeyTextParser Text -> Parser ParamName
forall a (f :: * -> *). (IsParamName a, MonadFail f) => Text -> f a
parsePlutusParamName

parsePlutusParamName :: (P.IsParamName a, MonadFail f) => T.Text -> f a
parsePlutusParamName :: forall a (f :: * -> *). (IsParamName a, MonadFail f) => Text -> f a
parsePlutusParamName Text
t =
  case Text -> Maybe a
forall a. IsParamName a => Text -> Maybe a
P.readParamName Text
t of
    Just a
p -> a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
p
    Maybe a
Nothing -> [Char] -> f a
forall a. HasCallStack => [Char] -> f a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
[Char] -> m a
fail ([Char] -> f a) -> [Char] -> f a
forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot parse cost model parameter name: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
t

deriving instance Show V2.ParamName

instance HasTypeProxy (Ledger.Credential L.ColdCommitteeRole) where
  data AsType (Ledger.Credential L.ColdCommitteeRole) = AsColdCommitteeCredential
  proxyToAsType :: Proxy (Credential ColdCommitteeRole)
-> AsType (Credential ColdCommitteeRole)
proxyToAsType Proxy (Credential ColdCommitteeRole)
_ = AsType (Credential ColdCommitteeRole)
AsColdCommitteeCredential

instance SerialiseAsRawBytes (Ledger.Credential L.ColdCommitteeRole) where
  serialiseToRawBytes :: Credential ColdCommitteeRole -> ByteString
serialiseToRawBytes = Credential ColdCommitteeRole -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize'
  deserialiseFromRawBytes :: AsType (Credential ColdCommitteeRole)
-> ByteString
-> Either SerialiseAsRawBytesError (Credential ColdCommitteeRole)
deserialiseFromRawBytes AsType (Credential ColdCommitteeRole)
R:AsTypeCredential3
AsColdCommitteeCredential =
    (DecoderError -> SerialiseAsRawBytesError)
-> Either DecoderError (Credential ColdCommitteeRole)
-> Either SerialiseAsRawBytesError (Credential ColdCommitteeRole)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      ( \DecoderError
e ->
          [Char] -> SerialiseAsRawBytesError
SerialiseAsRawBytesError
            ([Char]
"Unable to deserialise Credential ColdCommitteeRole: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DecoderError -> [Char]
forall a. Show a => a -> [Char]
show DecoderError
e)
      )
      (Either DecoderError (Credential ColdCommitteeRole)
 -> Either SerialiseAsRawBytesError (Credential ColdCommitteeRole))
-> (ByteString
    -> Either DecoderError (Credential ColdCommitteeRole))
-> ByteString
-> Either SerialiseAsRawBytesError (Credential ColdCommitteeRole)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either DecoderError (Credential ColdCommitteeRole)
forall a. FromCBOR a => ByteString -> Either DecoderError a
CBOR.decodeFull'

instance HasTypeProxy (Ledger.Credential L.HotCommitteeRole) where
  data AsType (Ledger.Credential L.HotCommitteeRole) = AsHotCommitteeCredential
  proxyToAsType :: Proxy (Credential HotCommitteeRole)
-> AsType (Credential HotCommitteeRole)
proxyToAsType Proxy (Credential HotCommitteeRole)
_ = AsType (Credential HotCommitteeRole)
AsHotCommitteeCredential

instance SerialiseAsRawBytes (Ledger.Credential L.HotCommitteeRole) where
  serialiseToRawBytes :: Credential HotCommitteeRole -> ByteString
serialiseToRawBytes = Credential HotCommitteeRole -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize'
  deserialiseFromRawBytes :: AsType (Credential HotCommitteeRole)
-> ByteString
-> Either SerialiseAsRawBytesError (Credential HotCommitteeRole)
deserialiseFromRawBytes AsType (Credential HotCommitteeRole)
R:AsTypeCredential1
AsHotCommitteeCredential =
    (DecoderError -> SerialiseAsRawBytesError)
-> Either DecoderError (Credential HotCommitteeRole)
-> Either SerialiseAsRawBytesError (Credential HotCommitteeRole)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      ( \DecoderError
e ->
          [Char] -> SerialiseAsRawBytesError
SerialiseAsRawBytesError
            ([Char]
"Unable to deserialise Credential HotCommitteeRole: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DecoderError -> [Char]
forall a. Show a => a -> [Char]
show DecoderError
e)
      )
      (Either DecoderError (Credential HotCommitteeRole)
 -> Either SerialiseAsRawBytesError (Credential HotCommitteeRole))
-> (ByteString
    -> Either DecoderError (Credential HotCommitteeRole))
-> ByteString
-> Either SerialiseAsRawBytesError (Credential HotCommitteeRole)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either DecoderError (Credential HotCommitteeRole)
forall a. FromCBOR a => ByteString -> Either DecoderError a
CBOR.decodeFull'

instance HasTypeProxy (Ledger.Credential L.DRepRole) where
  data AsType (Ledger.Credential L.DRepRole) = AsDrepCredential
  proxyToAsType :: Proxy (Credential DRepRole) -> AsType (Credential DRepRole)
proxyToAsType Proxy (Credential DRepRole)
_ = AsType (Credential DRepRole)
AsDrepCredential

instance SerialiseAsRawBytes (Ledger.Credential L.DRepRole) where
  serialiseToRawBytes :: Credential DRepRole -> ByteString
serialiseToRawBytes = Credential DRepRole -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize'
  deserialiseFromRawBytes :: AsType (Credential DRepRole)
-> ByteString
-> Either SerialiseAsRawBytesError (Credential DRepRole)
deserialiseFromRawBytes AsType (Credential DRepRole)
R:AsTypeCredential
AsDrepCredential =
    (DecoderError -> SerialiseAsRawBytesError)
-> Either DecoderError (Credential DRepRole)
-> Either SerialiseAsRawBytesError (Credential DRepRole)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      ( \DecoderError
e ->
          [Char] -> SerialiseAsRawBytesError
SerialiseAsRawBytesError ([Char]
"Unable to deserialise Credential DRepRole: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ DecoderError -> [Char]
forall a. Show a => a -> [Char]
show DecoderError
e)
      )
      (Either DecoderError (Credential DRepRole)
 -> Either SerialiseAsRawBytesError (Credential DRepRole))
-> (ByteString -> Either DecoderError (Credential DRepRole))
-> ByteString
-> Either SerialiseAsRawBytesError (Credential DRepRole)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either DecoderError (Credential DRepRole)
forall a. FromCBOR a => ByteString -> Either DecoderError a
CBOR.decodeFull'

instance HasTypeProxy L.GovActionIx where
  data AsType L.GovActionIx = AsGovActionIx
  proxyToAsType :: Proxy GovActionIx -> AsType GovActionIx
proxyToAsType Proxy GovActionIx
_ = AsType GovActionIx
AsGovActionIx

instance HasTypeProxy L.GovActionId where
  data AsType L.GovActionId = AsGovActionId
  proxyToAsType :: Proxy GovActionId -> AsType GovActionId
proxyToAsType Proxy GovActionId
_ = AsType GovActionId
AsGovActionId

instance SerialiseAsRawBytes L.GovActionIx where
  serialiseToRawBytes :: GovActionIx -> ByteString
serialiseToRawBytes (L.GovActionIx Word16
actionIx) = Word16 -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes Word16
actionIx
  deserialiseFromRawBytes :: AsType GovActionIx
-> ByteString -> Either SerialiseAsRawBytesError GovActionIx
deserialiseFromRawBytes AsType GovActionIx
_ = (Word16 -> GovActionIx)
-> Either SerialiseAsRawBytesError Word16
-> Either SerialiseAsRawBytesError GovActionIx
forall a b.
(a -> b)
-> Either SerialiseAsRawBytesError a
-> Either SerialiseAsRawBytesError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> GovActionIx
L.GovActionIx (Either SerialiseAsRawBytesError Word16
 -> Either SerialiseAsRawBytesError GovActionIx)
-> (ByteString -> Either SerialiseAsRawBytesError Word16)
-> ByteString
-> Either SerialiseAsRawBytesError GovActionIx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType Word16
-> ByteString -> Either SerialiseAsRawBytesError Word16
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType Word16
AsWord16

instance SerialiseAsRawBytes L.GovActionId where
  serialiseToRawBytes :: GovActionId -> ByteString
serialiseToRawBytes (L.GovActionId TxId
txid GovActionIx
govActIx) =
    TxId -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes (TxId -> TxId
fromShelleyTxId TxId
txid) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> GovActionIx -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes GovActionIx
govActIx

  deserialiseFromRawBytes :: AsType GovActionId
-> ByteString -> Either SerialiseAsRawBytesError GovActionId
deserialiseFromRawBytes AsType GovActionId
R:AsTypeGovActionId
AsGovActionId ByteString
bytes = do
    let (ByteString
txIdBs, ByteString
index) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
32 ByteString
bytes
    TxId -> GovActionIx -> GovActionId
L.GovActionId (TxId -> GovActionIx -> GovActionId)
-> (TxId -> TxId) -> TxId -> GovActionIx -> GovActionId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> TxId
toShelleyTxId
      (TxId -> GovActionIx -> GovActionId)
-> Either SerialiseAsRawBytesError TxId
-> Either SerialiseAsRawBytesError (GovActionIx -> GovActionId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType TxId -> ByteString -> Either SerialiseAsRawBytesError TxId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType TxId
AsTxId ByteString
txIdBs
      Either SerialiseAsRawBytesError (GovActionIx -> GovActionId)
-> Either SerialiseAsRawBytesError GovActionIx
-> Either SerialiseAsRawBytesError GovActionId
forall a b.
Either SerialiseAsRawBytesError (a -> b)
-> Either SerialiseAsRawBytesError a
-> Either SerialiseAsRawBytesError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AsType GovActionIx
-> ByteString -> Either SerialiseAsRawBytesError GovActionIx
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType GovActionIx
AsGovActionIx ByteString
index

instance HasTypeProxy (L.SLanguage L.PlutusV1) where
  data AsType (L.SLanguage L.PlutusV1) = AsPlutusScriptV1
  proxyToAsType :: Proxy (SLanguage 'PlutusV1) -> AsType (SLanguage 'PlutusV1)
proxyToAsType Proxy (SLanguage 'PlutusV1)
_ = AsType (SLanguage 'PlutusV1)
AsPlutusScriptV1

instance HasTypeProxy (L.SLanguage L.PlutusV2) where
  data AsType (L.SLanguage L.PlutusV2) = AsPlutusScriptV2
  proxyToAsType :: Proxy (SLanguage 'PlutusV2) -> AsType (SLanguage 'PlutusV2)
proxyToAsType Proxy (SLanguage 'PlutusV2)
_ = AsType (SLanguage 'PlutusV2)
AsPlutusScriptV2

instance HasTypeProxy (L.SLanguage L.PlutusV3) where
  data AsType (L.SLanguage L.PlutusV3) = AsPlutusScriptV3
  proxyToAsType :: Proxy (SLanguage 'PlutusV3) -> AsType (SLanguage 'PlutusV3)
proxyToAsType Proxy (SLanguage 'PlutusV3)
_ = AsType (SLanguage 'PlutusV3)
AsPlutusScriptV3

instance HasTypeProxy (L.SLanguage L.PlutusV4) where
  data AsType (L.SLanguage L.PlutusV4) = AsPlutusScriptV4
  proxyToAsType :: Proxy (SLanguage 'PlutusV4) -> AsType (SLanguage 'PlutusV4)
proxyToAsType Proxy (SLanguage 'PlutusV4)
_ = AsType (SLanguage 'PlutusV4)
AsPlutusScriptV4