{-# 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.Internal.HasTypeProxy
import Cardano.Api.Internal.Orphans.Misc
import Cardano.Api.Internal.Pretty (Pretty (..), prettyException, (<+>))
import Cardano.Api.Internal.SerialiseRaw
import Cardano.Api.Internal.TxIn
import Cardano.Api.Internal.Via.ShowOf
import Cardano.Api.Ledger qualified as Ledger

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.Rules qualified as L
import Cardano.Ledger.Alonzo.PParams qualified as Ledger
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.Babbage.PParams qualified as Ledger
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.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.HKD (NoUpdate (..))
import Cardano.Ledger.Hashes qualified as L hiding (KeyHash)
import Cardano.Ledger.Keys qualified as L.Keys
import Cardano.Ledger.Mary.Value qualified as L
import Cardano.Ledger.Shelley.API.Mempool qualified as L
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 (..), 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 Base16
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.Maybe.Strict (StrictMaybe (..))
import Data.Monoid
import Data.Text qualified as T
import Data.Text.Encoding qualified as Text
import Data.Typeable (Typeable)
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 Prettyprinter (punctuate, viaShow)
import Text.Read

deriving instance Generic (L.ApplyTxError era)

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.PredicateFailure (L.EraRule "UTXOW" ledgerera))
  , ToJSON (L.PredicateFailure (L.EraRule "DELEGS" ledgerera))
  )
  => 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)

deriving anyclass instance
  ( ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera))
  , ToJSON (L.PlutusPurpose L.AsItem ledgerera)
  , ToJSON (L.PlutusPurpose L.AsIx ledgerera)
  )
  => ToJSON (L.AlonzoUtxowPredFailure ledgerera)

deriving anyclass 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)

deriving anyclass instance
  ToJSON (L.PredicateFailure (L.EraRule "LEDGER" ledgerera))
  => ToJSON (L.ApplyTxError ledgerera)

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)) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ Hash ADDRHASH EraIndependentScript -> String
forall h a. Hash h a -> String
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 Consensus.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 => Consensus.StakeSnapshots -> [a]
stakeSnapshotsToPair :: forall e a. KeyValue e a => StakeSnapshots -> [a]
stakeSnapshotsToPair
  Consensus.StakeSnapshots
    { Map (KeyHash 'StakePool) StakeSnapshot
ssStakeSnapshots :: Map (KeyHash 'StakePool) StakeSnapshot
ssStakeSnapshots :: StakeSnapshots -> Map (KeyHash 'StakePool) StakeSnapshot
Consensus.ssStakeSnapshots
    , Coin
ssMarkTotal :: Coin
ssMarkTotal :: StakeSnapshots -> Coin
Consensus.ssMarkTotal
    , Coin
ssSetTotal :: Coin
ssSetTotal :: StakeSnapshots -> Coin
Consensus.ssSetTotal
    , Coin
ssGoTotal :: Coin
ssGoTotal :: StakeSnapshots -> Coin
Consensus.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 -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
ssMarkTotal
          , Key
"stakeSet" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
ssSetTotal
          , Key
"stakeGo" Key -> Coin -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
ssGoTotal
          ]
    ]

instance ToJSON Consensus.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 => Consensus.StakeSnapshot -> [a]
stakeSnapshotToPair :: forall e a. KeyValue e a => StakeSnapshot -> [a]
stakeSnapshotToPair
  Consensus.StakeSnapshot
    { Coin
ssMarkPool :: Coin
ssMarkPool :: StakeSnapshot -> Coin
Consensus.ssMarkPool
    , Coin
ssSetPool :: Coin
ssSetPool :: StakeSnapshot -> Coin
Consensus.ssSetPool
    , Coin
ssGoPool :: Coin
ssGoPool :: StakeSnapshot -> Coin
Consensus.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 ShelleyHash

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 = String -> (Text -> Parser ParamName) -> Value -> Parser ParamName
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"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 -> String -> f a
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f a) -> String -> f a
forall a b. (a -> b) -> a -> b
$ String
"Cannot parse cost model parameter name: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
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 ->
          String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError
            (String
"Unable to deserialise Credential ColdCommitteeRole: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DecoderError -> String
forall a. Show a => a -> String
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 ->
          String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError
            (String
"Unable to deserialise Credential HotCommitteeRole: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DecoderError -> String
forall a. Show a => a -> String
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 ->
          String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError (String
"Unable to deserialise Credential DRepRole: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DecoderError -> String
forall a. Show a => a -> String
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.GovActionId where
  data AsType L.GovActionId = AsGovActionId
  proxyToAsType :: Proxy GovActionId -> AsType GovActionId
proxyToAsType Proxy GovActionId
_ = AsType GovActionId
AsGovActionId

instance SerialiseAsRawBytes L.GovActionId where
  serialiseToRawBytes :: GovActionId -> ByteString
serialiseToRawBytes (L.GovActionId TxId
txid (L.GovActionIx Word16
actionIx)) =
    let hex :: ByteString
hex = ByteString -> ByteString
Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Word16 -> String
forall a. Show a => a -> String
show Word16
actionIx
     in [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [TxId -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes (TxId -> ByteString) -> TxId -> ByteString
forall a b. (a -> b) -> a -> b
$ TxId -> TxId
fromShelleyTxId TxId
txid, ByteString
hex]
  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
txid <- AsType TxId -> ByteString -> Either SerialiseAsRawBytesError TxId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType TxId
AsTxId ByteString
txidBs
    let asciiIndex :: String
asciiIndex = ByteString -> String
C8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base16.decodeLenient ByteString
index
    case String -> Maybe Word16
forall a. Read a => String -> Maybe a
readMaybe String
asciiIndex of
      Just Word16
actionIx -> GovActionId -> Either SerialiseAsRawBytesError GovActionId
forall a. a -> Either SerialiseAsRawBytesError a
forall (m :: * -> *) a. Monad m => a -> m a
return (GovActionId -> Either SerialiseAsRawBytesError GovActionId)
-> GovActionId -> Either SerialiseAsRawBytesError GovActionId
forall a b. (a -> b) -> a -> b
$ TxId -> GovActionIx -> GovActionId
L.GovActionId (TxId -> TxId
toShelleyTxId TxId
txid) (Word16 -> GovActionIx
L.GovActionIx Word16
actionIx)
      Maybe Word16
Nothing ->
        SerialiseAsRawBytesError
-> Either SerialiseAsRawBytesError GovActionId
forall a b. a -> Either a b
Left (SerialiseAsRawBytesError
 -> Either SerialiseAsRawBytesError GovActionId)
-> SerialiseAsRawBytesError
-> Either SerialiseAsRawBytesError GovActionId
forall a b. (a -> b) -> a -> b
$ String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError (String -> SerialiseAsRawBytesError)
-> String -> SerialiseAsRawBytesError
forall a b. (a -> b) -> a -> b
$ String
"Unable to deserialise GovActionId: invalid index: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
asciiIndex