Skip to content

Commit

Permalink
Merge pull request #254 from input-output-hk/newhoggy/replace-OnlyAda…
Browse files Browse the repository at this point in the history
…SupportedInEra-and-MultiAssetSupportedInEra-with-eons

Replace only `AdaSupportedInEra` and `MultiAssetSupportedInEra` with eons
  • Loading branch information
newhoggy committed Sep 22, 2023
2 parents 6ef9f28 + 6c802c1 commit fc48ece
Show file tree
Hide file tree
Showing 18 changed files with 765 additions and 419 deletions.
4 changes: 4 additions & 0 deletions cardano-api/cardano-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,11 @@ library internal
Cardano.Api.Eon.AlonzoEraOnwards
Cardano.Api.Eon.BabbageEraOnwards
Cardano.Api.Eon.ByronEraOnly
Cardano.Api.Eon.ByronToAllegraEra
Cardano.Api.Eon.ByronToAlonzoEra
Cardano.Api.Eon.ByronToMaryEra
Cardano.Api.Eon.ConwayEraOnwards
Cardano.Api.Eon.MaryEraOnwards
Cardano.Api.Eon.ShelleyBasedEra
Cardano.Api.Eon.ShelleyToAllegraEra
Cardano.Api.Eon.ShelleyToAlonzoEra
Expand Down
62 changes: 30 additions & 32 deletions cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -98,7 +98,6 @@ module Test.Gen.Cardano.Api.Typed
, genVerificationKeyHash
, genUpdateProposal
, genProtocolParametersUpdate
, genScriptDataSupportedInAlonzoEra
, genTxOutDatumHashTxContext
, genTxOutDatumHashUTxOContext
, genTxOutValue
Expand Down Expand Up @@ -500,10 +499,10 @@ genTxIndex :: Gen TxIx
genTxIndex = TxIx . fromIntegral <$> Gen.word16 Range.constantBounded

genTxOutValue :: CardanoEra era -> Gen (TxOutValue era)
genTxOutValue era =
case multiAssetSupportedInEra era of
Left adaOnlyInEra -> TxOutAdaOnly adaOnlyInEra <$> genPositiveLovelace
Right multiAssetInEra -> TxOutValue multiAssetInEra <$> genValueForTxOut
genTxOutValue =
caseByronToAllegraOrMaryEraOnwards
(\w -> TxOutAdaOnly w <$> genPositiveLovelace)
(\w -> TxOutValue w <$> genValueForTxOut)

genTxOutTxContext :: CardanoEra era -> Gen (TxOut CtxTx era)
genTxOutTxContext era =
Expand All @@ -521,9 +520,10 @@ genTxOutUTxOContext era =

genReferenceScript :: CardanoEra era -> Gen (ReferenceScript era)
genReferenceScript era =
case refInsScriptsAndInlineDatsSupportedInEra era of
Nothing -> return ReferenceScriptNone
Just _ -> scriptInEraToRefScript <$> genScriptInEra era
caseByronToAlonzoOrBabbageEraOnwards
(const (return ReferenceScriptNone))
(const (scriptInEraToRefScript <$> genScriptInEra era))
era

genUTxO :: CardanoEra era -> Gen (UTxO era)
genUTxO era =
Expand Down Expand Up @@ -636,14 +636,15 @@ genTxUpdateProposal era =
]

genTxMintValue :: CardanoEra era -> Gen (TxMintValue BuildTx era)
genTxMintValue era =
case multiAssetSupportedInEra era of
Left _ -> pure TxMintNone
Right supported ->
genTxMintValue =
caseByronToAllegraOrMaryEraOnwards
(const (pure TxMintNone))
(\supported ->
Gen.choice
[ pure TxMintNone
, TxMintValue supported <$> genValueForMinting <*> return (BuildTxWith mempty)
]
)

genTxBodyContent :: CardanoEra era -> Gen (TxBodyContent BuildTx era)
genTxBodyContent era = do
Expand Down Expand Up @@ -700,10 +701,10 @@ genTxInsCollateral era =
]

genTxInsReference :: CardanoEra era -> Gen (TxInsReference BuildTx era)
genTxInsReference era =
case refInsScriptsAndInlineDatsSupportedInEra era of
Nothing -> pure TxInsReferenceNone
Just supported -> TxInsReference supported <$> Gen.list (Range.linear 0 10) genTxIn
genTxInsReference =
caseByronToAlonzoOrBabbageEraOnwards
(const (pure TxInsReferenceNone))
(\w -> TxInsReference w <$> Gen.list (Range.linear 0 10) genTxIn)

genTxReturnCollateral :: CardanoEra era -> Gen (TxReturnCollateral CtxTx era)
genTxReturnCollateral era =
Expand Down Expand Up @@ -1013,20 +1014,20 @@ genTxOutDatumHashTxContext era = case era of
MaryEra -> pure TxOutDatumNone
AlonzoEra -> Gen.choice
[ pure TxOutDatumNone
, TxOutDatumHash ScriptDataInAlonzoEra <$> genHashScriptData
, TxOutDatumInTx ScriptDataInAlonzoEra <$> genHashableScriptData
, TxOutDatumHash AlonzoEraOnwardsAlonzo <$> genHashScriptData
, TxOutDatumInTx AlonzoEraOnwardsAlonzo <$> genHashableScriptData
]
BabbageEra -> Gen.choice
[ pure TxOutDatumNone
, TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData
, TxOutDatumInTx ScriptDataInBabbageEra <$> genHashableScriptData
, TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genHashableScriptData
, TxOutDatumHash AlonzoEraOnwardsBabbage <$> genHashScriptData
, TxOutDatumInTx AlonzoEraOnwardsBabbage <$> genHashableScriptData
, TxOutDatumInline BabbageEraOnwardsBabbage <$> genHashableScriptData
]
ConwayEra -> Gen.choice
[ pure TxOutDatumNone
, TxOutDatumHash ScriptDataInConwayEra <$> genHashScriptData
, TxOutDatumInTx ScriptDataInConwayEra <$> genHashableScriptData
, TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInConwayEra <$> genHashableScriptData
, TxOutDatumHash AlonzoEraOnwardsConway <$> genHashScriptData
, TxOutDatumInTx AlonzoEraOnwardsConway <$> genHashableScriptData
, TxOutDatumInline BabbageEraOnwardsConway <$> genHashableScriptData
]

genTxOutDatumHashUTxOContext :: CardanoEra era -> Gen (TxOutDatum CtxUTxO era)
Expand All @@ -1037,17 +1038,17 @@ genTxOutDatumHashUTxOContext era = case era of
MaryEra -> pure TxOutDatumNone
AlonzoEra -> Gen.choice
[ pure TxOutDatumNone
, TxOutDatumHash ScriptDataInAlonzoEra <$> genHashScriptData
, TxOutDatumHash AlonzoEraOnwardsAlonzo <$> genHashScriptData
]
BabbageEra -> Gen.choice
[ pure TxOutDatumNone
, TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData
, TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genHashableScriptData
, TxOutDatumHash AlonzoEraOnwardsBabbage <$> genHashScriptData
, TxOutDatumInline BabbageEraOnwardsBabbage <$> genHashableScriptData
]
ConwayEra -> Gen.choice
[ pure TxOutDatumNone
, TxOutDatumHash ScriptDataInConwayEra <$> genHashScriptData
, TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInConwayEra <$> genHashableScriptData
, TxOutDatumHash AlonzoEraOnwardsConway <$> genHashScriptData
, TxOutDatumInline BabbageEraOnwardsConway <$> genHashableScriptData
]

mkDummyHash :: forall h a. CRYPTO.HashAlgorithm h => Int -> CRYPTO.Hash h a
Expand All @@ -1056,9 +1057,6 @@ mkDummyHash = coerce . CRYPTO.hashWithSerialiser @h CBOR.toCBOR
genHashScriptData :: Gen (Cardano.Api.Hash ScriptData)
genHashScriptData = ScriptDataHash . unsafeMakeSafeHash . mkDummyHash <$> Gen.int (Range.linear 0 10)

genScriptDataSupportedInAlonzoEra :: Gen (ScriptDataSupportedInEra AlonzoEra)
genScriptDataSupportedInAlonzoEra = pure ScriptDataInAlonzoEra

genGovernancePoll :: Gen GovernancePoll
genGovernancePoll =
GovernancePoll
Expand Down
84 changes: 84 additions & 0 deletions cardano-api/internal/Cardano/Api/Eon/ByronToAllegraEra.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,84 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Api.Eon.ByronToAllegraEra
( ByronToAllegraEra(..)
, IsByronToAllegraEra(..)
, AnyByronToAllegraEra(..)
, byronToAllegraEraConstraints
, byronToAllegraEraToCardanoEra

, ByronToAllegraEraConstraints
) where

import Cardano.Api.Eras.Core

import Data.Typeable (Typeable)

class IsByronToAllegraEra era where
byronToAllegraEra :: ByronToAllegraEra era

data ByronToAllegraEra era where
ByronToAllegraEraByron :: ByronToAllegraEra ByronEra
ByronToAllegraEraShelley :: ByronToAllegraEra ShelleyEra
ByronToAllegraEraAllegra :: ByronToAllegraEra AllegraEra

deriving instance Show (ByronToAllegraEra era)
deriving instance Eq (ByronToAllegraEra era)

instance IsByronToAllegraEra ByronEra where
byronToAllegraEra = ByronToAllegraEraByron

instance IsByronToAllegraEra ShelleyEra where
byronToAllegraEra = ByronToAllegraEraShelley

instance IsByronToAllegraEra AllegraEra where
byronToAllegraEra = ByronToAllegraEraAllegra

instance Eon ByronToAllegraEra where
inEonForEra no yes = \case
ByronEra -> yes ByronToAllegraEraByron
ShelleyEra -> yes ByronToAllegraEraShelley
AllegraEra -> yes ByronToAllegraEraAllegra
MaryEra -> no
AlonzoEra -> no
BabbageEra -> no
ConwayEra -> no

instance ToCardanoEra ByronToAllegraEra where
toCardanoEra = \case
ByronToAllegraEraByron -> ByronEra
ByronToAllegraEraShelley -> ShelleyEra
ByronToAllegraEraAllegra -> AllegraEra

type ByronToAllegraEraConstraints era =
( IsCardanoEra era
, IsByronToAllegraEra era
, Typeable era
)

data AnyByronToAllegraEra where
AnyByronToAllegraEra :: ByronToAllegraEra era -> AnyByronToAllegraEra

deriving instance Show AnyByronToAllegraEra

byronToAllegraEraConstraints :: ()
=> ByronToAllegraEra era
-> (ByronToAllegraEraConstraints era => a)
-> a
byronToAllegraEraConstraints = \case
ByronToAllegraEraByron -> id
ByronToAllegraEraShelley -> id
ByronToAllegraEraAllegra -> id

byronToAllegraEraToCardanoEra :: ByronToAllegraEra era -> CardanoEra era
byronToAllegraEraToCardanoEra = \case
ByronToAllegraEraByron -> ByronEra
ByronToAllegraEraShelley -> ShelleyEra
ByronToAllegraEraAllegra -> AllegraEra
98 changes: 98 additions & 0 deletions cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,98 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Api.Eon.ByronToAlonzoEra
( ByronToAlonzoEra(..)
, IsByronToAlonzoEra(..)
, AnyByronToAlonzoEra(..)
, byronToAlonzoEraConstraints
, byronToAlonzoEraToCardanoEra

, ByronToAlonzoEraConstraints
) where

import Cardano.Api.Eras.Core

import Data.Typeable (Typeable)

class IsByronToAlonzoEra era where
byronToAlonzoEra :: ByronToAlonzoEra era

data ByronToAlonzoEra era where
ByronToAlonzoEraByron :: ByronToAlonzoEra ByronEra
ByronToAlonzoEraShelley :: ByronToAlonzoEra ShelleyEra
ByronToAlonzoEraAllegra :: ByronToAlonzoEra AllegraEra
ByronToAlonzoEraMary :: ByronToAlonzoEra MaryEra
ByronToAlonzoEraAlonzo :: ByronToAlonzoEra AlonzoEra

deriving instance Show (ByronToAlonzoEra era)
deriving instance Eq (ByronToAlonzoEra era)

instance IsByronToAlonzoEra ByronEra where
byronToAlonzoEra = ByronToAlonzoEraByron

instance IsByronToAlonzoEra ShelleyEra where
byronToAlonzoEra = ByronToAlonzoEraShelley

instance IsByronToAlonzoEra AllegraEra where
byronToAlonzoEra = ByronToAlonzoEraAllegra

instance IsByronToAlonzoEra MaryEra where
byronToAlonzoEra = ByronToAlonzoEraMary

instance IsByronToAlonzoEra AlonzoEra where
byronToAlonzoEra = ByronToAlonzoEraAlonzo

instance Eon ByronToAlonzoEra where
inEonForEra no yes = \case
ByronEra -> yes ByronToAlonzoEraByron
ShelleyEra -> yes ByronToAlonzoEraShelley
AllegraEra -> yes ByronToAlonzoEraAllegra
MaryEra -> yes ByronToAlonzoEraMary
AlonzoEra -> yes ByronToAlonzoEraAlonzo
BabbageEra -> no
ConwayEra -> no

instance ToCardanoEra ByronToAlonzoEra where
toCardanoEra = \case
ByronToAlonzoEraByron -> ByronEra
ByronToAlonzoEraShelley -> ShelleyEra
ByronToAlonzoEraAllegra -> AllegraEra
ByronToAlonzoEraMary -> MaryEra
ByronToAlonzoEraAlonzo -> AlonzoEra

type ByronToAlonzoEraConstraints era =
( IsCardanoEra era
, IsByronToAlonzoEra era
, Typeable era
)

data AnyByronToAlonzoEra where
AnyByronToAlonzoEra :: ByronToAlonzoEra era -> AnyByronToAlonzoEra

deriving instance Show AnyByronToAlonzoEra

byronToAlonzoEraConstraints :: ()
=> ByronToAlonzoEra era
-> (ByronToAlonzoEraConstraints era => a)
-> a
byronToAlonzoEraConstraints = \case
ByronToAlonzoEraByron -> id
ByronToAlonzoEraShelley -> id
ByronToAlonzoEraAllegra -> id
ByronToAlonzoEraMary -> id
ByronToAlonzoEraAlonzo -> id

byronToAlonzoEraToCardanoEra :: ByronToAlonzoEra era -> CardanoEra era
byronToAlonzoEraToCardanoEra = \case
ByronToAlonzoEraByron -> ByronEra
ByronToAlonzoEraShelley -> ShelleyEra
ByronToAlonzoEraAllegra -> AllegraEra
ByronToAlonzoEraMary -> MaryEra
ByronToAlonzoEraAlonzo -> AlonzoEra
Loading

0 comments on commit fc48ece

Please sign in to comment.