Skip to content

Commit

Permalink
We introduce the Convert type class as an alternative to cardano-le…
Browse files Browse the repository at this point in the history
…dger's `Inject` typeclass.

While `Inject` is more general, `Convert` is specifically designed for transformations between era-indexed types,
making the intent clearer at call sites where we're converting between eons.
  • Loading branch information
Jimbo4350 committed Nov 25, 2024
1 parent 4dde2e6 commit a16541b
Show file tree
Hide file tree
Showing 24 changed files with 179 additions and 147 deletions.
1 change: 1 addition & 0 deletions cardano-api/cardano-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -71,6 +71,7 @@ library internal
Cardano.Api.Eon.AlonzoEraOnwards
Cardano.Api.Eon.BabbageEraOnwards
Cardano.Api.Eon.ByronToAlonzoEra
Cardano.Api.Eon.Convert
Cardano.Api.Eon.ConwayEraOnwards
Cardano.Api.Eon.MaryEraOnwards
Cardano.Api.Eon.ShelleyBasedEra
Expand Down
19 changes: 9 additions & 10 deletions cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -145,6 +145,7 @@ import qualified Cardano.Binary as CBOR
import qualified Cardano.Crypto.Hash as Crypto
import qualified Cardano.Crypto.Hash.Class as CRYPTO
import qualified Cardano.Crypto.Seed as Crypto
import Cardano.Api.Eon.Convert
import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
import qualified Cardano.Ledger.BaseTypes as Ledger
import qualified Cardano.Ledger.Core as Ledger
Expand Down Expand Up @@ -391,15 +392,13 @@ genLedgerValue w genAId genQuant =
genValueDefault :: MaryEraOnwards era -> Gen (L.Value (ShelleyLedgerEra era))
genValueDefault w = genLedgerValue w genAssetId genSignedNonZeroQuantity

genValueForRole :: forall era. MaryEraOnwards era -> ParserValueRole -> Gen Value
genValueForRole :: MaryEraOnwards era -> ParserValueRole -> Gen Value
genValueForRole w =
\case
RoleMint ->
genValueForMinting
RoleUTxO ->
fromLedgerValue sbe <$> genValueForTxOut sbe
where
sbe = inject w :: ShelleyBasedEra era
fromLedgerValue (convert w) <$> genValueForTxOut (convert w)

-- | Generate a 'Value' suitable for minting, i.e. non-ADA asset ID and a
-- positive or negative quantity.
Expand Down Expand Up @@ -468,7 +467,7 @@ genOperationalCertificateWithCounter = do
Gen.either (genSigningKey AsStakePoolKey) (genSigningKey AsGenesisDelegateExtendedKey)
kesP <- genKESPeriod
c <- Gen.integral $ Range.linear 0 1000
let stakePoolVer = either getVerificationKey (convert . getVerificationKey) stkPoolOrGenDelExtSign
let stakePoolVer = either getVerificationKey (convert' . getVerificationKey) stkPoolOrGenDelExtSign
iCounter = OperationalCertificateIssueCounter c stakePoolVer

case issueOperationalCertificate kesVKey stkPoolOrGenDelExtSign kesP iCounter of
Expand All @@ -477,10 +476,10 @@ genOperationalCertificateWithCounter = do
Left err -> error $ docToString $ prettyError err
Right pair -> return pair
where
convert
convert'
:: VerificationKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
convert =
convert' =
( castVerificationKey
:: VerificationKey GenesisDelegateKey
-> VerificationKey StakePoolKey
Expand Down Expand Up @@ -599,7 +598,7 @@ genTxAuxScripts era =
TxAuxScripts w
<$> Gen.list
(Range.linear 0 3)
(genScriptInEra (inject w))
(genScriptInEra $ convert w)
)

genTxWithdrawals :: CardanoEra era -> Gen (TxWithdrawals build era)
Expand Down Expand Up @@ -1169,7 +1168,7 @@ genProposals w = conwayEraOnwardsConstraints w $ do
-- We're doing it for the complete representation of possible values space of TxProposalProcedures.
-- Proposal procedures code in cardano-api should handle such invalid values just fine.
extraProposals <- Gen.list (Range.constant 0 10) (genProposal w)
let sbe = inject w
let sbe = convert w
proposalsWithWitnesses <-
forM (extraProposals <> proposalsToBeWitnessed) $ \proposal ->
(proposal,) <$> genScriptWitnessForStake sbe
Expand All @@ -1184,7 +1183,7 @@ genVotingProcedures :: Applicative (BuildTxWith build)
-> Gen (Api.TxVotingProcedures build era)
genVotingProcedures w = conwayEraOnwardsConstraints w $ do
voters <- Gen.list (Range.constant 0 10) Q.arbitrary
let sbe = inject w
let sbe = convert w
votersWithWitnesses <- fmap fromList . forM voters $ \voter ->
(voter,) <$> genScriptWitnessForStake sbe
Api.TxVotingProcedures <$> Q.arbitrary <*> pure (pure votersWithWitnesses)
Expand Down
5 changes: 3 additions & 2 deletions cardano-api/internal/Cardano/Api/Certificate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -78,6 +78,7 @@ where

import Cardano.Api.Address
import Cardano.Api.DRepMetadata
import Cardano.Api.Eon.Convert
import Cardano.Api.Eon.ConwayEraOnwards
import Cardano.Api.Eon.ShelleyBasedEra
import Cardano.Api.Eon.ShelleyToBabbageEra
Expand Down Expand Up @@ -515,10 +516,10 @@ selectStakeCredentialWitness
selectStakeCredentialWitness = \case
ShelleyRelatedCertificate stbEra shelleyCert ->
shelleyToBabbageEraConstraints stbEra $
getTxCertWitness (inject stbEra) shelleyCert
getTxCertWitness (convert stbEra) shelleyCert
ConwayCertificate cEra conwayCert ->
conwayEraOnwardsConstraints cEra $
getTxCertWitness (inject cEra) conwayCert
getTxCertWitness (convert cEra) conwayCert

filterUnRegCreds
:: Certificate era -> Maybe StakeCredential
Expand Down
13 changes: 7 additions & 6 deletions cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ module Cardano.Api.Eon.AllegraEraOnwards
)
where

import Cardano.Api.Eon.Convert
import Cardano.Api.Eon.ShelleyBasedEra
import Cardano.Api.Eras.Core
import Cardano.Api.Modes
Expand Down Expand Up @@ -67,11 +68,11 @@ instance ToCardanoEra AllegraEraOnwards where
AllegraEraOnwardsBabbage -> BabbageEra
AllegraEraOnwardsConway -> ConwayEra

instance Inject (AllegraEraOnwards era) (CardanoEra era) where
inject = toCardanoEra
instance Convert AllegraEraOnwards CardanoEra where
convert = toCardanoEra

instance Inject (AllegraEraOnwards era) (ShelleyBasedEra era) where
inject = \case
instance Convert AllegraEraOnwards ShelleyBasedEra where
convert = \case
AllegraEraOnwardsAllegra -> ShelleyBasedEraAllegra
AllegraEraOnwardsMary -> ShelleyBasedEraMary
AllegraEraOnwardsAlonzo -> ShelleyBasedEraAlonzo
Expand Down Expand Up @@ -115,9 +116,9 @@ allegraEraOnwardsConstraints = \case
AllegraEraOnwardsBabbage -> id
AllegraEraOnwardsConway -> id

{-# DEPRECATED allegraEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-}
{-# DEPRECATED allegraEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-}
allegraEraOnwardsToShelleyBasedEra :: AllegraEraOnwards era -> ShelleyBasedEra era
allegraEraOnwardsToShelleyBasedEra = inject
allegraEraOnwardsToShelleyBasedEra = convert

class IsShelleyBasedEra era => IsAllegraBasedEra era where
allegraBasedEra :: AllegraEraOnwards era
Expand Down
13 changes: 7 additions & 6 deletions cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ module Cardano.Api.Eon.AlonzoEraOnwards
)
where

import Cardano.Api.Eon.Convert
import Cardano.Api.Eon.MaryEraOnwards
import Cardano.Api.Eon.ShelleyBasedEra
import Cardano.Api.Eras.Core
Expand Down Expand Up @@ -71,11 +72,11 @@ instance ToCardanoEra AlonzoEraOnwards where
AlonzoEraOnwardsBabbage -> BabbageEra
AlonzoEraOnwardsConway -> ConwayEra

instance Inject (AlonzoEraOnwards era) (CardanoEra era) where
inject = toCardanoEra
instance Convert AlonzoEraOnwards CardanoEra where
convert = toCardanoEra

instance Inject (AlonzoEraOnwards era) (ShelleyBasedEra era) where
inject = \case
instance Convert AlonzoEraOnwards ShelleyBasedEra where
convert = \case
AlonzoEraOnwardsAlonzo -> ShelleyBasedEraAlonzo
AlonzoEraOnwardsBabbage -> ShelleyBasedEraBabbage
AlonzoEraOnwardsConway -> ShelleyBasedEraConway
Expand Down Expand Up @@ -124,9 +125,9 @@ alonzoEraOnwardsConstraints = \case
AlonzoEraOnwardsBabbage -> id
AlonzoEraOnwardsConway -> id

{-# DEPRECATED alonzoEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-}
{-# DEPRECATED alonzoEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-}
alonzoEraOnwardsToShelleyBasedEra :: AlonzoEraOnwards era -> ShelleyBasedEra era
alonzoEraOnwardsToShelleyBasedEra = inject
alonzoEraOnwardsToShelleyBasedEra = convert

class IsMaryBasedEra era => IsAlonzoBasedEra era where
alonzoBasedEra :: AlonzoEraOnwards era
Expand Down
20 changes: 11 additions & 9 deletions cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,6 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

Expand All @@ -21,6 +20,7 @@ module Cardano.Api.Eon.BabbageEraOnwards
where

import Cardano.Api.Eon.AlonzoEraOnwards
import Cardano.Api.Eon.Convert
import Cardano.Api.Eon.MaryEraOnwards
import Cardano.Api.Eon.ShelleyBasedEra
import Cardano.Api.Eras.Core
Expand Down Expand Up @@ -70,14 +70,16 @@ instance ToCardanoEra BabbageEraOnwards where
BabbageEraOnwardsBabbage -> BabbageEra
BabbageEraOnwardsConway -> ConwayEra

instance Inject (BabbageEraOnwards era) (CardanoEra era) where
inject = toCardanoEra
instance Convert BabbageEraOnwards CardanoEra where
convert = toCardanoEra

instance Inject (BabbageEraOnwards era) (ShelleyBasedEra era) where
inject = inject @(MaryEraOnwards era) . inject
instance Convert BabbageEraOnwards ShelleyBasedEra where
convert = \case
BabbageEraOnwardsBabbage -> ShelleyBasedEraBabbage
BabbageEraOnwardsConway -> ShelleyBasedEraConway

instance Inject (BabbageEraOnwards era) (MaryEraOnwards era) where
inject = \case
instance Convert BabbageEraOnwards MaryEraOnwards where
convert = \case
BabbageEraOnwardsBabbage -> MaryEraOnwardsBabbage
BabbageEraOnwardsConway -> MaryEraOnwardsConway

Expand Down Expand Up @@ -124,9 +126,9 @@ babbageEraOnwardsConstraints = \case
BabbageEraOnwardsBabbage -> id
BabbageEraOnwardsConway -> id

{-# DEPRECATED babbageEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-}
{-# DEPRECATED babbageEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-}
babbageEraOnwardsToShelleyBasedEra :: BabbageEraOnwards era -> ShelleyBasedEra era
babbageEraOnwardsToShelleyBasedEra = inject
babbageEraOnwardsToShelleyBasedEra = convert

class IsAlonzoBasedEra era => IsBabbageBasedEra era where
babbageBasedEra :: BabbageEraOnwards era
Expand Down
5 changes: 3 additions & 2 deletions cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@ module Cardano.Api.Eon.ByronToAlonzoEra
)
where

import Cardano.Api.Eon.Convert
import Cardano.Api.Eras.Core

import Data.Typeable (Typeable)
Expand Down Expand Up @@ -48,8 +49,8 @@ instance ToCardanoEra ByronToAlonzoEra where
ByronToAlonzoEraMary -> MaryEra
ByronToAlonzoEraAlonzo -> AlonzoEra

instance Inject (ByronToAlonzoEra era) (CardanoEra era) where
inject = toCardanoEra
instance Convert ByronToAlonzoEra CardanoEra where
convert = toCardanoEra

type ByronToAlonzoEraConstraints era =
( IsCardanoEra era
Expand Down
16 changes: 16 additions & 0 deletions cardano-api/internal/Cardano/Api/Eon/Convert.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}

module Cardano.Api.Eon.Convert
( Convert (..)
)
where

import Data.Kind (Type)

-- | The Convert class is aimed at exposing a single interface that lets us
-- convert between eons. However this is generalizable to any injective
-- relationship between types.
class Convert (f :: a -> Type) (g :: a -> Type) where
convert :: forall era. f era -> g era
21 changes: 11 additions & 10 deletions cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,7 @@ module Cardano.Api.Eon.ConwayEraOnwards
where

import Cardano.Api.Eon.BabbageEraOnwards
import Cardano.Api.Eon.Convert
import Cardano.Api.Eon.ShelleyBasedEra
import Cardano.Api.Eras.Core
import Cardano.Api.Modes
Expand Down Expand Up @@ -67,15 +68,15 @@ instance ToCardanoEra ConwayEraOnwards where
toCardanoEra = \case
ConwayEraOnwardsConway -> ConwayEra

instance Inject (ConwayEraOnwards era) (CardanoEra era) where
inject = toCardanoEra
instance Convert ConwayEraOnwards CardanoEra where
convert = toCardanoEra

instance Inject (ConwayEraOnwards era) (ShelleyBasedEra era) where
inject = \case
instance Convert ConwayEraOnwards ShelleyBasedEra where
convert = \case
ConwayEraOnwardsConway -> ShelleyBasedEraConway

instance Inject (ConwayEraOnwards era) (BabbageEraOnwards era) where
inject = \case
instance Convert ConwayEraOnwards BabbageEraOnwards where
convert = \case
ConwayEraOnwardsConway -> BabbageEraOnwardsConway

type ConwayEraOnwardsConstraints era =
Expand Down Expand Up @@ -125,13 +126,13 @@ conwayEraOnwardsConstraints
conwayEraOnwardsConstraints = \case
ConwayEraOnwardsConway -> id

{-# DEPRECATED conwayEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-}
{-# DEPRECATED conwayEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-}
conwayEraOnwardsToShelleyBasedEra :: ConwayEraOnwards era -> ShelleyBasedEra era
conwayEraOnwardsToShelleyBasedEra = inject
conwayEraOnwardsToShelleyBasedEra = convert

{-# DEPRECATED conwayEraOnwardsToBabbageEraOnwards "Use 'inject' instead." #-}
{-# DEPRECATED conwayEraOnwardsToBabbageEraOnwards "Use 'convert' instead." #-}
conwayEraOnwardsToBabbageEraOnwards :: ConwayEraOnwards era -> BabbageEraOnwards era
conwayEraOnwardsToBabbageEraOnwards = inject
conwayEraOnwardsToBabbageEraOnwards = convert

class IsBabbageBasedEra era => IsConwayBasedEra era where
conwayBasedEra :: ConwayEraOnwards era
Expand Down
13 changes: 7 additions & 6 deletions cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ module Cardano.Api.Eon.MaryEraOnwards
where

import Cardano.Api.Eon.AllegraEraOnwards
import Cardano.Api.Eon.Convert
import Cardano.Api.Eon.ShelleyBasedEra
import Cardano.Api.Eras.Core
import Cardano.Api.Modes
Expand Down Expand Up @@ -68,11 +69,11 @@ instance ToCardanoEra MaryEraOnwards where
MaryEraOnwardsBabbage -> BabbageEra
MaryEraOnwardsConway -> ConwayEra

instance Inject (MaryEraOnwards era) (CardanoEra era) where
inject = toCardanoEra
instance Convert MaryEraOnwards CardanoEra where
convert = toCardanoEra

instance Inject (MaryEraOnwards era) (ShelleyBasedEra era) where
inject = \case
instance Convert MaryEraOnwards ShelleyBasedEra where
convert = \case
MaryEraOnwardsMary -> ShelleyBasedEraMary
MaryEraOnwardsAlonzo -> ShelleyBasedEraAlonzo
MaryEraOnwardsBabbage -> ShelleyBasedEraBabbage
Expand Down Expand Up @@ -116,9 +117,9 @@ maryEraOnwardsConstraints = \case
MaryEraOnwardsBabbage -> id
MaryEraOnwardsConway -> id

{-# DEPRECATED maryEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-}
{-# DEPRECATED maryEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-}
maryEraOnwardsToShelleyBasedEra :: MaryEraOnwards era -> ShelleyBasedEra era
maryEraOnwardsToShelleyBasedEra = inject
maryEraOnwardsToShelleyBasedEra = convert

class IsAllegraBasedEra era => IsMaryBasedEra era where
maryBasedEra :: MaryEraOnwards era
Expand Down
5 changes: 3 additions & 2 deletions cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,7 @@ module Cardano.Api.Eon.ShelleyBasedEra
)
where

import Cardano.Api.Eon.Convert
import Cardano.Api.Eras.Core
import Cardano.Api.Modes
import Cardano.Api.Orphans ()
Expand Down Expand Up @@ -179,8 +180,8 @@ instance ToCardanoEra ShelleyBasedEra where
ShelleyBasedEraBabbage -> BabbageEra
ShelleyBasedEraConway -> ConwayEra

instance Inject (ShelleyBasedEra era) (CardanoEra era) where
inject = toCardanoEra
instance Convert ShelleyBasedEra CardanoEra where
convert = toCardanoEra

-- | The class of eras that are based on Shelley. This allows uniform handling
-- of Shelley-based eras, but also non-uniform by making case distinctions on
Expand Down
13 changes: 7 additions & 6 deletions cardano-api/internal/Cardano/Api/Eon/ShelleyEraOnly.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@ module Cardano.Api.Eon.ShelleyEraOnly
)
where

import Cardano.Api.Eon.Convert
import Cardano.Api.Eon.ShelleyBasedEra
import Cardano.Api.Eras.Core
import Cardano.Api.Modes
Expand Down Expand Up @@ -60,11 +61,11 @@ instance ToCardanoEra ShelleyEraOnly where
toCardanoEra = \case
ShelleyEraOnlyShelley -> ShelleyEra

instance Inject (ShelleyEraOnly era) (CardanoEra era) where
inject = toCardanoEra
instance Convert ShelleyEraOnly CardanoEra where
convert = toCardanoEra

instance Inject (ShelleyEraOnly era) (ShelleyBasedEra era) where
inject = \case
instance Convert ShelleyEraOnly ShelleyBasedEra where
convert = \case
ShelleyEraOnlyShelley -> ShelleyBasedEraShelley

type ShelleyEraOnlyConstraints era =
Expand Down Expand Up @@ -107,6 +108,6 @@ shelleyEraOnlyConstraints
shelleyEraOnlyConstraints = \case
ShelleyEraOnlyShelley -> id

{-# DEPRECATED shelleyEraOnlyToShelleyBasedEra "Use 'inject' instead." #-}
{-# DEPRECATED shelleyEraOnlyToShelleyBasedEra "Use 'convert' instead." #-}
shelleyEraOnlyToShelleyBasedEra :: ShelleyEraOnly era -> ShelleyBasedEra era
shelleyEraOnlyToShelleyBasedEra = inject
shelleyEraOnlyToShelleyBasedEra = convert
Loading

0 comments on commit a16541b

Please sign in to comment.