Merge pull request #771 from IntersectMBO/query-interpreter

Add `HasTextEnvelope` instance for `EraHistory`

Author: palas

cardano-api/cardano-api.cabal

@@ -165,6 +165,7 @@ library
     prettyprinter-ansi-terminal,
     prettyprinter-configurable ^>=1.36,
     random,
+    reflection,
     safe-exceptions,
     scientific,
     serialise,

cardano-api/src/Cardano/Api/Internal/Query.hs

@@ -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
@@ -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 (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
@@ -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)
@@ -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