Skip to content

Commit

Permalink
Delete TxScriptValiditySupportedInEra. Use AlonzoEraOnwards instead
Browse files Browse the repository at this point in the history
  • Loading branch information
newhoggy committed Sep 26, 2023
1 parent 8020734 commit 797eb37
Show file tree
Hide file tree
Showing 4 changed files with 47 additions and 89 deletions.
7 changes: 4 additions & 3 deletions cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -752,9 +752,10 @@ genMaybeFeaturedInEra f =
pure Nothing <|> fmap Just (genFeaturedInEra w (f w))

genTxScriptValidity :: CardanoEra era -> Gen (TxScriptValidity era)
genTxScriptValidity era = case txScriptValiditySupportedInCardanoEra era of
Nothing -> pure TxScriptValidityNone
Just witness -> TxScriptValidity witness <$> genScriptValidity
genTxScriptValidity =
inEonForEra
(pure TxScriptValidityNone)
(\w -> TxScriptValidity w <$> genScriptValidity)

genScriptValidity :: Gen ScriptValidity
genScriptValidity = Gen.element [ScriptInvalid, ScriptValid]
Expand Down
58 changes: 22 additions & 36 deletions cardano-api/internal/Cardano/Api/Tx.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,8 @@
-- not export any from this API. We also use them unticked as nature intended.
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

{- HLINT ignore "Avoid lambda using `infix`" -}

-- | Complete, signed transactions
--
module Cardano.Api.Tx (
Expand Down Expand Up @@ -444,49 +446,33 @@ getTxBody :: forall era. Tx era -> TxBody era
getTxBody (ByronTx Byron.ATxAux { Byron.aTaTx = txbody }) =
ByronTxBody txbody

getTxBody (ShelleyTx sbe tx') =
case sbe of
ShelleyBasedEraShelley -> getShelleyTxBody tx'
ShelleyBasedEraAllegra -> getShelleyTxBody tx'
ShelleyBasedEraMary -> getShelleyTxBody tx'
ShelleyBasedEraAlonzo -> getAlonzoTxBody AlonzoEraOnwardsAlonzo TxScriptValiditySupportedInAlonzoEra tx'
ShelleyBasedEraBabbage -> getAlonzoTxBody AlonzoEraOnwardsBabbage TxScriptValiditySupportedInBabbageEra tx'
ShelleyBasedEraConway -> getAlonzoTxBody AlonzoEraOnwardsConway TxScriptValiditySupportedInConwayEra tx'
where
getShelleyTxBody :: forall ledgerera.
ShelleyLedgerEra era ~ ledgerera
=> Ledger.EraTx ledgerera
=> L.Tx ledgerera
-> TxBody era
getShelleyTxBody tx =
let txBody = tx ^. L.bodyTxL
txAuxData = tx ^. L.auxDataTxL
scriptWits = tx ^. L.witsTxL . L.scriptTxWitsL
in ShelleyTxBody sbe txBody
(Map.elems scriptWits)
TxBodyNoScriptData
(strictMaybeToMaybe txAuxData)
TxScriptValidityNone

getAlonzoTxBody :: forall ledgerera.
ShelleyLedgerEra era ~ ledgerera
=> L.AlonzoEraTx ledgerera
=> AlonzoEraOnwards era
-> TxScriptValiditySupportedInEra era
-> L.Tx ledgerera
-> TxBody era
getAlonzoTxBody w txScriptValidityInEra tx =
getTxBody (ShelleyTx sbe tx) =
caseShelleyToMaryOrAlonzoEraOnwards
( const $
let txBody = tx ^. L.bodyTxL
txAuxData = tx ^. L.auxDataTxL
scriptWits = tx ^. L.witsTxL . L.scriptTxWitsL
in ShelleyTxBody sbe txBody
(Map.elems scriptWits)
TxBodyNoScriptData
(strictMaybeToMaybe txAuxData)
TxScriptValidityNone
)
(\w ->
let txBody = tx ^. L.bodyTxL
txAuxData = tx ^. L.auxDataTxL
scriptWits = tx ^. L.witsTxL . L.scriptTxWitsL
datsWits = tx ^. L.witsTxL . L.datsTxWitsL
redeemerWits = tx ^. L.witsTxL . L.rdmrsTxWitsL
isValid = tx ^. L.isValidTxL
in ShelleyTxBody sbe txBody
(Map.elems scriptWits)
(TxBodyScriptData w datsWits redeemerWits)
(strictMaybeToMaybe txAuxData)
(TxScriptValidity txScriptValidityInEra (isValidToScriptValidity isValid))
(Map.elems scriptWits)
(TxBodyScriptData w datsWits redeemerWits)
(strictMaybeToMaybe txAuxData)
(TxScriptValidity w (isValidToScriptValidity isValid))
)
sbe


getTxWitnesses :: forall era. Tx era -> [KeyWitness era]
getTxWitnesses (ByronTx Byron.ATxAux { Byron.aTaWitness = witnesses }) =
Expand Down
68 changes: 21 additions & 47 deletions cardano-api/internal/Cardano/Api/TxBody.hs
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,6 @@ module Cardano.Api.TxBody (
TxBodyError(..),
TxBodyScriptData(..),
TxScriptValidity(..),
TxScriptValiditySupportedInEra(..),

ScriptValidity(..),
scriptValidityToIsValid,
Expand Down Expand Up @@ -136,8 +135,6 @@ module Cardano.Api.TxBody (
extraKeyWitnessesSupportedInEra,
withdrawalsSupportedInEra,
updateProposalSupportedInEra,
txScriptValiditySupportedInShelleyBasedEra,
txScriptValiditySupportedInCardanoEra,
totalAndReturnCollateralSupportedInEra,

-- * Inspecting 'ScriptWitness'es
Expand Down Expand Up @@ -311,50 +308,25 @@ isValidToScriptValidity (L.IsValid True) = ScriptValid
-- The Alonzo and subsequent eras support script validity.
--
data TxScriptValidity era where
TxScriptValidityNone :: TxScriptValidity era
TxScriptValidityNone
:: TxScriptValidity era

-- | Tx script validity is supported in transactions in the 'Alonzo' era onwards.
TxScriptValidity
:: TxScriptValiditySupportedInEra era
:: AlonzoEraOnwards era
-> ScriptValidity
-> TxScriptValidity era

deriving instance Eq (TxScriptValiditySupportedInEra era)
deriving instance Show (TxScriptValiditySupportedInEra era)

data TxScriptValiditySupportedInEra era where
TxScriptValiditySupportedInAlonzoEra :: TxScriptValiditySupportedInEra AlonzoEra
TxScriptValiditySupportedInBabbageEra :: TxScriptValiditySupportedInEra BabbageEra
TxScriptValiditySupportedInConwayEra :: TxScriptValiditySupportedInEra ConwayEra

deriving instance Eq (TxScriptValidity era)
deriving instance Show (TxScriptValidity era)

txScriptValiditySupportedInCardanoEra :: CardanoEra era -> Maybe (TxScriptValiditySupportedInEra era)
txScriptValiditySupportedInCardanoEra ByronEra = Nothing
txScriptValiditySupportedInCardanoEra ShelleyEra = Nothing
txScriptValiditySupportedInCardanoEra AllegraEra = Nothing
txScriptValiditySupportedInCardanoEra MaryEra = Nothing
txScriptValiditySupportedInCardanoEra AlonzoEra = Just TxScriptValiditySupportedInAlonzoEra
txScriptValiditySupportedInCardanoEra BabbageEra = Just TxScriptValiditySupportedInBabbageEra
txScriptValiditySupportedInCardanoEra ConwayEra = Just TxScriptValiditySupportedInConwayEra

txScriptValiditySupportedInShelleyBasedEra :: ShelleyBasedEra era -> Maybe (TxScriptValiditySupportedInEra era)
txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraShelley = Nothing
txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraAllegra = Nothing
txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraMary = Nothing
txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraAlonzo = Just TxScriptValiditySupportedInAlonzoEra
txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraBabbage = Just TxScriptValiditySupportedInBabbageEra
txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraConway = Just TxScriptValiditySupportedInConwayEra

txScriptValidityToScriptValidity :: TxScriptValidity era -> ScriptValidity
txScriptValidityToScriptValidity TxScriptValidityNone = ScriptValid
txScriptValidityToScriptValidity (TxScriptValidity _ scriptValidity) = scriptValidity

scriptValidityToTxScriptValidity :: ShelleyBasedEra era -> ScriptValidity -> TxScriptValidity era
scriptValidityToTxScriptValidity sbe scriptValidity = case txScriptValiditySupportedInShelleyBasedEra sbe of
Nothing -> TxScriptValidityNone
Just witness -> TxScriptValidity witness scriptValidity
scriptValidityToTxScriptValidity sbe scriptValidity =
inShelleyBasedEraEon sbe TxScriptValidityNone $ \w -> TxScriptValidity w scriptValidity

txScriptValidityToIsValid :: TxScriptValidity era -> L.IsValid
txScriptValidityToIsValid = scriptValidityToIsValid . txScriptValidityToScriptValidity
Expand Down Expand Up @@ -2035,13 +2007,14 @@ deserialiseShelleyBasedTxBody sbe bs =
(flip CBOR.runAnnotator fbs (return TxScriptValidityNone))
4 -> do
sValiditySupported <-
case txScriptValiditySupportedInShelleyBasedEra sbe of
Nothing -> fail $ mconcat
[ "deserialiseShelleyBasedTxBody: Expected an era that supports the "
, "script validity flag but got: "
, show sbe
]
Just supported -> return supported
inShelleyBasedEraEon sbe
( fail $ mconcat
[ "deserialiseShelleyBasedTxBody: Expected an era that supports the "
, "script validity flag but got: "
, show sbe
]
)
pure

txbody <- CBOR.decCBOR
txscripts <- CBOR.decCBOR
Expand All @@ -2066,13 +2039,14 @@ deserialiseShelleyBasedTxBody sbe bs =
pure

sValiditySupported <-
case txScriptValiditySupportedInShelleyBasedEra sbe of
Nothing -> fail $ mconcat
[ "deserialiseShelleyBasedTxBody: Expected an era that supports the "
, "script validity flag but got: "
, show sbe
]
Just supported -> return supported
inShelleyBasedEraEon sbe
( fail $ mconcat
[ "deserialiseShelleyBasedTxBody: Expected an era that supports the "
, "script validity flag but got: "
, show sbe
]
)
pure

txbody <- CBOR.decCBOR
txscripts <- CBOR.decCBOR
Expand Down
3 changes: 0 additions & 3 deletions cardano-api/src/Cardano/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -435,10 +435,7 @@ module Cardano.Api (
TxBodyErrorAutoBalance(..),
TxScriptValidity(..),
ScriptValidity(..),
TxScriptValiditySupportedInEra(..),
scriptValidityToTxScriptValidity,
txScriptValiditySupportedInShelleyBasedEra,
txScriptValiditySupportedInCardanoEra,
txScriptValidityToScriptValidity,

-- * Signing transactions
Expand Down

0 comments on commit 797eb37

Please sign in to comment.