Skip to content
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

Jump to bottom

More shelleyBasedEraConstraint constraints #149

Merged
merged 1 commit into from
Jul 31, 2023
Merged

More shelleyBasedEraConstraint constraints #149

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
2 changes: 2 additions & 0 deletions cardano-api/internal/Cardano/Api/Eras/Constraints.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,7 @@ module Cardano.Api.Eras.Constraints

import Cardano.Api.Eras.Core
import Cardano.Api.Modes
import Cardano.Api.Orphans ()
import Cardano.Api.Query.Types

import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
Expand Down Expand Up @@ -68,6 +69,7 @@ type ShelleyBasedEraConstraints era ledgerera =
, FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
, FromCBOR (DebugLedgerState era)
, IsShelleyBasedEra era
, ToJSON (Consensus.ChainDepState (ConsensusProtocol era))
, ToJSON (DebugLedgerState era)
, Typeable era
)
Expand Down
76 changes: 75 additions & 1 deletion cardano-api/internal/Cardano/Api/Orphans.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,20 +1,46 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can we avoid this extension? Why it's needed?

Copy link
Collaborator Author

@newhoggy newhoggy Jul 28, 2023 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is why we need it:


internal/Cardano/Api/Orphans.hs:97:10: error:
    • Illegal nested constraint ‘ToJSON (HeaderHash blk)’
      (Use UndecidableInstances to permit this)
    • In the instance declaration for ‘ToJSON (Tip blk)’
   |
97 | instance ToJSON (HeaderHash blk) => ToJSON (Tip blk) where
   |          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Note, the offending instance already exists in cardano-cli. This PR merely moves it here.

See https://github.com/input-output-hk/cardano-cli/blob/newhoggy/use-AnyShelleyToBabbageEra-from-cardano-api-instead/cardano-cli/src/Cardano/CLI/Orphans.hs#L48

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Your link returns 404 error for me.


{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Api.Orphans () where

import Cardano.Binary (DecoderError (..))
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import qualified Cardano.Ledger.Crypto as Crypto
import qualified Cardano.Protocol.TPraos.API as Ledger
import Cardano.Protocol.TPraos.BHeader (HashHeader (..))
import qualified Cardano.Protocol.TPraos.Rules.Prtcl as Ledger
import qualified Cardano.Protocol.TPraos.Rules.Tickn as Ledger
import Ouroboros.Consensus.Byron.Ledger.Block (ByronHash (..))
import Ouroboros.Consensus.HardFork.Combinator (OneEraHash (..))
import Ouroboros.Consensus.Protocol.Praos (PraosState)
import qualified Ouroboros.Consensus.Protocol.Praos as Consensus
import Ouroboros.Consensus.Protocol.TPraos (TPraosState)
import qualified Ouroboros.Consensus.Protocol.TPraos as Consensus
import Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyHash (..))
import qualified Ouroboros.Consensus.Shelley.Ledger.Query as Consensus
import Ouroboros.Network.Block (HeaderHash, Tip (..))

import qualified Codec.Binary.Bech32 as Bech32
import qualified Codec.CBOR.Read as CBOR
import Data.Aeson (ToJSON (..), object, pairs, (.=))
import Data.Aeson (KeyValue ((.=)), ToJSON (..), object, pairs, (.=))
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Short as SBS
import Data.Data (Data)
import qualified Data.Text.Encoding as Text

deriving instance Data DecoderError
deriving instance Data CBOR.DeserialiseFailure
Expand Down Expand Up @@ -57,3 +83,51 @@ stakeSnapshotToPair Consensus.StakeSnapshot
, "stakeSet" .= ssSetPool
, "stakeGo" .= ssGoPool
]

instance ToJSON (OneEraHash xs) where
toJSON = toJSON
. Text.decodeLatin1
. Base16.encode
. SBS.fromShort
. getOneEraHash

deriving newtype instance ToJSON ByronHash

-- This instance is temporarily duplicated in cardano-config

instance ToJSON (HeaderHash blk) => ToJSON (Tip blk) where
toJSON TipGenesis = Aeson.object [ "genesis" .= True ]
toJSON (Tip slotNo headerHash blockNo) =
Aeson.object
[ "slotNo" .= slotNo
, "headerHash" .= headerHash
, "blockNo" .= blockNo
]

--
-- Simple newtype wrappers JSON conversion
--

deriving newtype instance CC.Crypto crypto => ToJSON (ShelleyHash crypto)
deriving newtype instance CC.Crypto crypto => ToJSON (HashHeader crypto)

deriving instance ToJSON (Ledger.PrtclState StandardCrypto)
deriving instance ToJSON Ledger.TicknState
deriving instance ToJSON (Ledger.ChainDepState StandardCrypto)

instance ToJSON (TPraosState StandardCrypto) where
toJSON s = Aeson.object
[ "lastSlot" .= Consensus.tpraosStateLastSlot s
, "chainDepState" .= Consensus.tpraosStateChainDepState s
]

instance ToJSON (PraosState StandardCrypto) where
toJSON s = Aeson.object
[ "lastSlot" .= Consensus.praosStateLastSlot s
, "oCertCounters" .= Consensus.praosStateOCertCounters s
, "evolvingNonce" .= Consensus.praosStateEvolvingNonce s
, "candidateNonce" .= Consensus.praosStateCandidateNonce s
, "epochNonce" .= Consensus.praosStateEpochNonce s
, "labNonce" .= Consensus.praosStateLabNonce s
, "lastEpochBlockNonce" .= Consensus.praosStateLastEpochBlockNonce s
]