Skip to content

Add HasTextEnvelope instance for EraHistory #771

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Mar 6, 2025
Merged

Add HasTextEnvelope instance for EraHistory #771

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
3249ba5
Add `HasTextEnvelope` instance for `EraHistory`
palas Mar 3, 2025
43e7751
Add Haddock comment about why we need `HasTextEnvelope` instance for …
palas Mar 6, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions cardano-api/cardano-api.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -165,6 +165,7 @@ library
prettyprinter-ansi-terminal,
prettyprinter-configurable ^>=1.36,
random,
reflection,
safe-exceptions,
scientific,
serialise,
Expand Down
34 changes: 34 additions & 0 deletions cardano-api/src/Cardano/Api/Internal/Query.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,12 +3,14 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- The Shelley ledger uses promoted data kinds which we have to use, but we do
Expand Down Expand Up @@ -71,16 +73,23 @@ import Cardano.Api.Internal.Eon.ShelleyBasedEra
import Cardano.Api.Internal.Eras.Case
import Cardano.Api.Internal.Eras.Core
import Cardano.Api.Internal.GenesisParameters
import Cardano.Api.Internal.HasTypeProxy (HasTypeProxy (..), Proxy)
import Cardano.Api.Internal.IPC.Version
import Cardano.Api.Internal.Keys.Shelley
import Cardano.Api.Internal.Modes
import Cardano.Api.Internal.NetworkId
import Cardano.Api.Internal.ProtocolParameters
import Cardano.Api.Internal.Query.Types
import Cardano.Api.Internal.ReexposeLedger qualified as Ledger
import Cardano.Api.Internal.SerialiseCBOR (SerialiseAsCBOR (deserialiseFromCBOR, serialiseToCBOR))
import Cardano.Api.Internal.SerialiseTextEnvelope
( HasTextEnvelope (textEnvelopeType)
, TextEnvelopeType
)
import Cardano.Api.Internal.Tx.Body
import Cardano.Api.Internal.Tx.UTxO

import Cardano.Binary qualified as CBOR
import Cardano.Chain.Update.Validation.Interface qualified as Byron.Update
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.Api.State.Query qualified as L
Expand Down Expand Up @@ -116,13 +125,16 @@ import Ouroboros.Network.NodeToClient.Version (NodeToClientVersion (..))
import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot)
import Ouroboros.Network.Protocol.LocalStateQuery.Client (Some (..))

import Codec.Serialise qualified as CBOR
import Control.Monad.Trans.Except
import Data.Bifunctor (bimap, first)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as LBS
import Data.Either.Combinators (rightToMaybe)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (mapMaybe)
import Data.Reflection (give)
import Data.SOP.Constraint (SListI)
import Data.Sequence (Seq)
import Data.Set (Set)
Expand Down Expand Up @@ -167,6 +179,28 @@ data EraHistory where
=> History.Interpreter xs
-> EraHistory

instance HasTypeProxy EraHistory where
data AsType EraHistory = AsEraHistory

proxyToAsType :: Proxy EraHistory -> AsType EraHistory
proxyToAsType _ = AsEraHistory

instance SerialiseAsCBOR EraHistory where
serialiseToCBOR :: EraHistory -> BS.ByteString
serialiseToCBOR (EraHistory interpreter) = CBOR.toStrictByteString (give History.EraParamsWithGenesisWindow (CBOR.encode interpreter))

deserialiseFromCBOR :: AsType EraHistory -> BS.ByteString -> Either DecoderError EraHistory
deserialiseFromCBOR _ bs =
EraHistory
<$> CBOR.decodeFullDecoder' "EraHistory" (give History.EraParamsWithGenesisWindow CBOR.decode) bs

-- | The @HasTextEnvelope@ instance for @EraHistory@ is required by the
-- @transaction calculate-plutus-script-cost@ command in @cartdano-cli and it
-- can be obtained through the @query era-history@ command.
instance HasTextEnvelope EraHistory where
textEnvelopeType :: AsType EraHistory -> TextEnvelopeType
textEnvelopeType _ = "EraHistory"

getProgress
:: ()
=> SlotNo
Expand Down
Loading