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.

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

Avoid IsShelleyBasedEra and IsCardanoEra where possible #313

Merged
merged 4 commits into from
Oct 18, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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: 0 additions & 1 deletion cardano-api/cardano-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -76,7 +76,6 @@ library internal
Cardano.Api.Eon.ShelleyToMaryEra
Cardano.Api.Eras
Cardano.Api.Eras.Case
Cardano.Api.Eras.Constraints
Cardano.Api.Eras.Core
Cardano.Api.Error
Cardano.Api.Feature
Expand Down
63 changes: 30 additions & 33 deletions cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -188,10 +188,10 @@ genAddressInEra era =
LegacyByronEra ->
byronAddressInEra <$> genAddressByron

ShelleyBasedEra _ ->
ShelleyBasedEra sbe ->
Gen.choice
[ byronAddressInEra <$> genAddressByron
, shelleyAddressInEra <$> genAddressShelley
[ byronAddressInEra <$> genAddressByron
, shelleyAddressInEra sbe <$> genAddressShelley
Copy link
Collaborator Author

Choose a reason for hiding this comment

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

shelleyAddressInEra is an example of a function that previously demanded a constraint, but now demands a witness instead. It is often the case that the witness is just available somewhere in the context.

]

genKESPeriod :: Gen KESPeriod
Expand Down Expand Up @@ -717,9 +717,9 @@ genTxFee =
(pure . TxFeeImplicit)
(\w -> TxFeeExplicit w <$> genLovelace)

genTxBody :: IsCardanoEra era => CardanoEra era -> Gen (TxBody era)
genTxBody :: CardanoEra era -> Gen (TxBody era)
genTxBody era = do
res <- Api.createAndValidateTransactionBody <$> genTxBodyContent era
res <- Api.createAndValidateTransactionBody era <$> genTxBodyContent era
case res of
Left err -> fail (displayError err)
Right txBody -> pure txBody
Expand Down Expand Up @@ -753,7 +753,9 @@ genTxScriptValidity =
genScriptValidity :: Gen ScriptValidity
genScriptValidity = Gen.element [ScriptInvalid, ScriptValid]

genTx :: forall era. IsCardanoEra era => CardanoEra era -> Gen (Tx era)
genTx :: ()
=> CardanoEra era
-> Gen (Tx era)
genTx era =
makeSignedTransaction
<$> genWitnesses era
Expand All @@ -762,12 +764,10 @@ genTx era =
genWitnesses :: CardanoEra era -> Gen [KeyWitness era]
genWitnesses era =
case cardanoEraStyle era of
LegacyByronEra -> Gen.list (Range.constant 1 10) genByronKeyWitness
ShelleyBasedEra _ -> do
bsWits <- Gen.list (Range.constant 0 10)
(genShelleyBootstrapWitness era)
keyWits <- Gen.list (Range.constant 0 10)
(genShelleyKeyWitness era)
LegacyByronEra -> Gen.list (Range.constant 1 10) genByronKeyWitness
ShelleyBasedEra sbe -> do
bsWits <- Gen.list (Range.constant 0 10) (genShelleyBootstrapWitness sbe)
keyWits <- Gen.list (Range.constant 0 10) (genShelleyKeyWitness sbe)
return $ bsWits ++ keyWits

genVerificationKey :: ()
Expand Down Expand Up @@ -806,33 +806,30 @@ genWitnessNetworkIdOrByronAddress =
, WitnessByronAddress <$> genAddressByron
]

genShelleyBootstrapWitness
:: IsShelleyBasedEra era
=> CardanoEra era
genShelleyBootstrapWitness :: ()
=> ShelleyBasedEra era
-> Gen (KeyWitness era)
genShelleyBootstrapWitness era =
makeShelleyBootstrapWitness
genShelleyBootstrapWitness sbe =
makeShelleyBootstrapWitness sbe
<$> genWitnessNetworkIdOrByronAddress
<*> genTxBody era
<*> genTxBody (shelleyBasedToCardanoEra sbe)
<*> genSigningKey AsByronKey

genShelleyKeyWitness
:: IsShelleyBasedEra era
=> CardanoEra era
genShelleyKeyWitness :: ()
=> ShelleyBasedEra era
-> Gen (KeyWitness era)
genShelleyKeyWitness era =
makeShelleyKeyWitness
<$> genTxBody era
genShelleyKeyWitness sbe =
makeShelleyKeyWitness sbe
<$> genTxBody (shelleyBasedToCardanoEra sbe)
<*> genShelleyWitnessSigningKey

genShelleyWitness
:: IsShelleyBasedEra era
=> CardanoEra era
genShelleyWitness :: ()
=> ShelleyBasedEra era
-> Gen (KeyWitness era)
genShelleyWitness era =
genShelleyWitness sbe =
Gen.choice
[ genShelleyKeyWitness era
, genShelleyBootstrapWitness era
[ genShelleyKeyWitness sbe
, genShelleyBootstrapWitness sbe
]

genShelleyWitnessSigningKey :: Gen ShelleyWitnessSigningKey
Expand All @@ -845,12 +842,12 @@ genShelleyWitnessSigningKey =
, WitnessGenesisUTxOKey <$> genSigningKey AsGenesisUTxOKey
]

genCardanoKeyWitness
:: CardanoEra era
genCardanoKeyWitness :: ()
=> CardanoEra era
-> Gen (KeyWitness era)
genCardanoKeyWitness era = case cardanoEraStyle era of
LegacyByronEra -> genByronKeyWitness
ShelleyBasedEra _ -> genShelleyWitness era
ShelleyBasedEra sbe -> genShelleyWitness sbe

genSeed :: Int -> Gen Crypto.Seed
genSeed n = Crypto.mkSeedFromBytes <$> Gen.bytes (Range.singleton n)
Expand Down
63 changes: 36 additions & 27 deletions cardano-api/internal/Cardano/Api/Address.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

{- HLINT ignore "Avoid lambda using `infix`" -}
Expand Down Expand Up @@ -373,9 +374,11 @@ instance IsCardanoEra era => ToJSON (AddressInEra era) where
toJSON = Aeson.String . serialiseAddress

instance IsShelleyBasedEra era => FromJSON (AddressInEra era) where
parseJSON = withText "AddressInEra" $ \txt -> do
addressAny <- runParsecParser parseAddressAny txt
pure $ anyAddressInShelleyBasedEra addressAny
parseJSON =
Copy link
Collaborator Author

Choose a reason for hiding this comment

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

We still retain the use of IsShelleyBasedEra and IsCardanoEra constraints for type class instances for now because we don't yet have a way to express these.

let sbe = shelleyBasedEra @era in
withText "AddressInEra" $ \txt -> do
addressAny <- runParsecParser parseAddressAny txt
pure $ anyAddressInShelleyBasedEra sbe addressAny

parseAddressAny :: Parsec.Parser AddressAny
parseAddressAny = do
Expand Down Expand Up @@ -467,15 +470,20 @@ byronAddressInEra :: Address ByronAddr -> AddressInEra era
byronAddressInEra = AddressInEra ByronAddressInAnyEra


shelleyAddressInEra :: IsShelleyBasedEra era
=> Address ShelleyAddr -> AddressInEra era
shelleyAddressInEra = AddressInEra (ShelleyAddressInEra shelleyBasedEra)

shelleyAddressInEra :: ()
=> ShelleyBasedEra era
-> Address ShelleyAddr
-> AddressInEra era
shelleyAddressInEra sbe =
AddressInEra (ShelleyAddressInEra sbe)

anyAddressInShelleyBasedEra :: IsShelleyBasedEra era
=> AddressAny -> AddressInEra era
anyAddressInShelleyBasedEra (AddressByron addr) = byronAddressInEra addr
anyAddressInShelleyBasedEra (AddressShelley addr) = shelleyAddressInEra addr
anyAddressInShelleyBasedEra :: ()
=> ShelleyBasedEra era
-> AddressAny
-> AddressInEra era
anyAddressInShelleyBasedEra sbe = \case
AddressByron addr -> byronAddressInEra addr
AddressShelley addr -> shelleyAddressInEra sbe addr


anyAddressInEra :: CardanoEra era
Expand All @@ -500,13 +508,14 @@ makeByronAddressInEra nw vk =
byronAddressInEra (makeByronAddress nw vk)


makeShelleyAddressInEra :: IsShelleyBasedEra era
=> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra era
makeShelleyAddressInEra nw pc scr =
shelleyAddressInEra (makeShelleyAddress nw pc scr)
makeShelleyAddressInEra :: ()
=> ShelleyBasedEra era
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra era
makeShelleyAddressInEra sbe nw pc scr =
shelleyAddressInEra sbe (makeShelleyAddress nw pc scr)


-- ----------------------------------------------------------------------------
Expand Down Expand Up @@ -659,15 +668,15 @@ toShelleyStakeReference (StakeAddressByPointer ptr) =
toShelleyStakeReference NoStakeAddress =
Shelley.StakeRefNull

fromShelleyAddrIsSbe :: IsShelleyBasedEra era
=> Shelley.Addr StandardCrypto -> AddressInEra era
fromShelleyAddrIsSbe (Shelley.AddrBootstrap (Shelley.BootstrapAddress addr)) =
AddressInEra ByronAddressInAnyEra (ByronAddress addr)

fromShelleyAddrIsSbe (Shelley.Addr nw pc scr) =
AddressInEra
(ShelleyAddressInEra shelleyBasedEra)
(ShelleyAddress nw pc scr)
fromShelleyAddrIsSbe :: ()
=> ShelleyBasedEra era
-> Shelley.Addr StandardCrypto
-> AddressInEra era
fromShelleyAddrIsSbe sbe = \case
Shelley.AddrBootstrap (Shelley.BootstrapAddress addr) ->
AddressInEra ByronAddressInAnyEra (ByronAddress addr)
Shelley.Addr nw pc scr ->
AddressInEra (ShelleyAddressInEra sbe) (ShelleyAddress nw pc scr)

fromShelleyAddr
:: ShelleyBasedEra era
Expand Down
43 changes: 23 additions & 20 deletions cardano-api/internal/Cardano/Api/Block.hs
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,6 @@ module Cardano.Api.Block (

import Cardano.Api.Eon.ShelleyBasedEra
import Cardano.Api.Eras
import Cardano.Api.Eras.Constraints
import Cardano.Api.Hash
import Cardano.Api.HasTypeProxy
import Cardano.Api.Keys.Shelley
Expand Down Expand Up @@ -200,7 +199,11 @@ getShelleyBlockTxs era (Ledger.Block _header txs) =
-- different block types for all the eras. It is used in the ChainSync protocol.
--
data BlockInMode mode where
BlockInMode :: IsCardanoEra era => Block era -> EraInMode era mode -> BlockInMode mode
BlockInMode
:: CardanoEra era
-> Block era
-> EraInMode era mode
-> BlockInMode mode

deriving instance Show (BlockInMode mode)

Expand All @@ -213,41 +216,41 @@ fromConsensusBlock :: ConsensusBlockForMode mode ~ block
fromConsensusBlock ByronMode =
\b -> case b of
Consensus.DegenBlock b' ->
BlockInMode (ByronBlock b') ByronEraInByronMode
BlockInMode cardanoEra (ByronBlock b') ByronEraInByronMode

fromConsensusBlock ShelleyMode =
\b -> case b of
Consensus.DegenBlock b' ->
BlockInMode (ShelleyBlock ShelleyBasedEraShelley b')
BlockInMode cardanoEra (ShelleyBlock ShelleyBasedEraShelley b')
ShelleyEraInShelleyMode

fromConsensusBlock CardanoMode =
\b -> case b of
Consensus.BlockByron b' ->
BlockInMode (ByronBlock b') ByronEraInCardanoMode
BlockInMode cardanoEra (ByronBlock b') ByronEraInCardanoMode

Consensus.BlockShelley b' ->
BlockInMode (ShelleyBlock ShelleyBasedEraShelley b')
BlockInMode cardanoEra (ShelleyBlock ShelleyBasedEraShelley b')
ShelleyEraInCardanoMode

Consensus.BlockAllegra b' ->
BlockInMode (ShelleyBlock ShelleyBasedEraAllegra b')
BlockInMode cardanoEra (ShelleyBlock ShelleyBasedEraAllegra b')
AllegraEraInCardanoMode

Consensus.BlockMary b' ->
BlockInMode (ShelleyBlock ShelleyBasedEraMary b')
BlockInMode cardanoEra (ShelleyBlock ShelleyBasedEraMary b')
MaryEraInCardanoMode

Consensus.BlockAlonzo b' ->
BlockInMode (ShelleyBlock ShelleyBasedEraAlonzo b')
BlockInMode cardanoEra (ShelleyBlock ShelleyBasedEraAlonzo b')
AlonzoEraInCardanoMode

Consensus.BlockBabbage b' ->
BlockInMode (ShelleyBlock ShelleyBasedEraBabbage b')
BlockInMode cardanoEra (ShelleyBlock ShelleyBasedEraBabbage b')
BabbageEraInCardanoMode

Consensus.BlockConway b' ->
BlockInMode (ShelleyBlock ShelleyBasedEraConway b')
BlockInMode cardanoEra (ShelleyBlock ShelleyBasedEraConway b')
ConwayEraInCardanoMode

toConsensusBlock
Expand All @@ -260,19 +263,19 @@ toConsensusBlock
toConsensusBlock bInMode =
case bInMode of
-- Byron mode
BlockInMode (ByronBlock b') ByronEraInByronMode -> Consensus.DegenBlock b'
BlockInMode _ (ByronBlock b') ByronEraInByronMode -> Consensus.DegenBlock b'

-- Shelley mode
BlockInMode (ShelleyBlock ShelleyBasedEraShelley b') ShelleyEraInShelleyMode -> Consensus.DegenBlock b'
BlockInMode _ (ShelleyBlock ShelleyBasedEraShelley b') ShelleyEraInShelleyMode -> Consensus.DegenBlock b'

-- Cardano mode
BlockInMode (ByronBlock b') ByronEraInCardanoMode -> Consensus.BlockByron b'
BlockInMode (ShelleyBlock ShelleyBasedEraShelley b') ShelleyEraInCardanoMode -> Consensus.BlockShelley b'
BlockInMode (ShelleyBlock ShelleyBasedEraAllegra b') AllegraEraInCardanoMode -> Consensus.BlockAllegra b'
BlockInMode (ShelleyBlock ShelleyBasedEraMary b') MaryEraInCardanoMode -> Consensus.BlockMary b'
BlockInMode (ShelleyBlock ShelleyBasedEraAlonzo b') AlonzoEraInCardanoMode -> Consensus.BlockAlonzo b'
BlockInMode (ShelleyBlock ShelleyBasedEraBabbage b') BabbageEraInCardanoMode -> Consensus.BlockBabbage b'
BlockInMode (ShelleyBlock ShelleyBasedEraConway b') ConwayEraInCardanoMode -> Consensus.BlockConway b'
BlockInMode _ (ByronBlock b') ByronEraInCardanoMode -> Consensus.BlockByron b'
BlockInMode _ (ShelleyBlock ShelleyBasedEraShelley b') ShelleyEraInCardanoMode -> Consensus.BlockShelley b'
BlockInMode _ (ShelleyBlock ShelleyBasedEraAllegra b') AllegraEraInCardanoMode -> Consensus.BlockAllegra b'
BlockInMode _ (ShelleyBlock ShelleyBasedEraMary b') MaryEraInCardanoMode -> Consensus.BlockMary b'
BlockInMode _ (ShelleyBlock ShelleyBasedEraAlonzo b') AlonzoEraInCardanoMode -> Consensus.BlockAlonzo b'
BlockInMode _ (ShelleyBlock ShelleyBasedEraBabbage b') BabbageEraInCardanoMode -> Consensus.BlockBabbage b'
BlockInMode _ (ShelleyBlock ShelleyBasedEraConway b') ConwayEraInCardanoMode -> Consensus.BlockConway b'

-- ----------------------------------------------------------------------------
-- Block headers
Expand Down
1 change: 0 additions & 1 deletion cardano-api/internal/Cardano/Api/Certificate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -78,7 +78,6 @@ import Cardano.Api.Eon.ConwayEraOnwards
import Cardano.Api.Eon.ShelleyBasedEra
import Cardano.Api.Eon.ShelleyToBabbageEra
import Cardano.Api.Eras
import Cardano.Api.Eras.Constraints
import Cardano.Api.Governance.Actions.VotingProcedure
import Cardano.Api.HasTypeProxy
import Cardano.Api.Keys.Praos
Expand Down
12 changes: 6 additions & 6 deletions cardano-api/internal/Cardano/Api/Convenience/Construction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,9 +41,9 @@ import qualified Data.Text as Text
-- See Cardano.Api.Convenience.Query.queryStateForBalancedTx for a
-- convenient way of querying the node to get the required arguements
-- for constructBalancedTx.
constructBalancedTx
:: IsShelleyBasedEra era
=> TxBodyContent BuildTx era
constructBalancedTx :: ()
=> ShelleyBasedEra era
-> TxBodyContent BuildTx era
-> AddressInEra era -- ^ Change address
-> Maybe Word -- ^ Override key witnesses
-> UTxO era -- ^ Just the transaction inputs, not the entire 'UTxO'.
Expand All @@ -55,17 +55,17 @@ constructBalancedTx
-> Map.Map (L.Credential L.DRepRole L.StandardCrypto) Lovelace
-> [ShelleyWitnessSigningKey]
-> Either TxBodyErrorAutoBalance (Tx era)
constructBalancedTx txbodcontent changeAddr mOverrideWits utxo lpp
constructBalancedTx sbe txbodcontent changeAddr mOverrideWits utxo lpp
ledgerEpochInfo systemStart stakePools
stakeDelegDeposits drepDelegDeposits shelleyWitSigningKeys = do

BalancedTxBody _ txbody _txBalanceOutput _fee
<- makeTransactionBodyAutoBalance
systemStart ledgerEpochInfo
sbe systemStart ledgerEpochInfo
lpp stakePools stakeDelegDeposits drepDelegDeposits utxo txbodcontent
changeAddr mOverrideWits

let keyWits = map (makeShelleyKeyWitness txbody) shelleyWitSigningKeys
let keyWits = map (makeShelleyKeyWitness sbe txbody) shelleyWitSigningKeys
return $ makeSignedTransaction keyWits txbody

data TxInsExistError
Expand Down
6 changes: 2 additions & 4 deletions cardano-api/internal/Cardano/Api/Convenience/Query.hs
Original file line number Diff line number Diff line change
Expand Up @@ -96,7 +96,7 @@ queryStateForBalancedTx era allTxIns certs = runExceptT $ do
& onNothing (left ByronEraNotSupported)

qeInMode <- pure (toEraInMode era CardanoMode)
& onNothing (left (EraConsensusModeMismatch (AnyConsensusMode CardanoMode) (cardanoEraConstraints era $ AnyCardanoEra era)))
& onNothing (left (EraConsensusModeMismatch (AnyConsensusMode CardanoMode) (anyCardanoEra era)))

let stakeCreds = Set.fromList $ mapMaybe filterUnRegCreds certs
drepCreds = Set.fromList $ mapMaybe filterUnRegDRepCreds certs
Expand Down Expand Up @@ -175,9 +175,7 @@ executeQueryAnyMode era localNodeConnInfo q = runExceptT $ do
let cMode = consensusModeOnly $ localConsensusModeParams localNodeConnInfo

eraInMode <- pure (toEraInMode era cMode)
& onNothing (left $ EraConsensusModeMismatch
(AnyConsensusMode CardanoMode)
(cardanoEraConstraints era $ AnyCardanoEra era))
& onNothing (left $ EraConsensusModeMismatch (AnyConsensusMode CardanoMode) (anyCardanoEra era))

case eraInMode of
ByronEraInByronMode -> left ByronEraNotSupported
Expand Down
Loading