diff --git a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs index d52085a918..1518ab6be2 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Tx.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Tx.hs @@ -158,10 +158,8 @@ txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do , txTotalCollateral = TxTotalCollateralNone , txReturnCollateral = TxReturnCollateralNone , txFee = TxFeeImplicit ByronEraOnlyByron - , txValidityRange = - ( TxValidityNoLowerBound - , defaultTxValidityUpperBound ByronEra - ) + , txValidityLowerBound = TxValidityNoLowerBound + , txValidityUpperBound = defaultTxValidityUpperBound ByronEra , txMetadata = TxMetadataNone , txAuxScripts = TxAuxScriptsNone , txExtraKeyWits = TxExtraKeyWitnessesNone @@ -207,10 +205,8 @@ txSpendUTxOByronPBFT nId sk txIns outs = do , txTotalCollateral = TxTotalCollateralNone , txReturnCollateral = TxReturnCollateralNone , txFee = TxFeeImplicit ByronEraOnlyByron - , txValidityRange = - ( TxValidityNoLowerBound - , defaultTxValidityUpperBound ByronEra - ) + , txValidityLowerBound = TxValidityNoLowerBound + , txValidityUpperBound = defaultTxValidityUpperBound ByronEra , txMetadata = TxMetadataNone , txAuxScripts = TxAuxScriptsNone , txExtraKeyWits = TxExtraKeyWitnessesNone diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 46a9042ab6..a5fcaf68df 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -418,8 +418,10 @@ runTxBuildRaw era <- first TxCmdReturnCollateralValidationError $ validateTxReturnCollateral era mReturnCollateral validatedFee <- first TxCmdTxFeeValidationError $ validateTxFee era mFee - validatedBounds <- (,) <$> first TxCmdTxValidityLowerBoundValidationError (validateTxValidityLowerBound era mLowerBound) - <*> first TxCmdTxValidityUpperBoundValidationError (validateTxValidityUpperBound era mUpperBound) + validatedLowerBound + <- first TxCmdTxValidityLowerBoundValidationError (validateTxValidityLowerBound era mLowerBound) + validatedUpperBound + <- first TxCmdTxValidityUpperBoundValidationError (validateTxValidityUpperBound era mUpperBound) validatedReqSigners <- first TxCmdRequiredSignersValidationError $ validateRequiredSigners era reqSigners validatedPParams @@ -443,7 +445,8 @@ runTxBuildRaw era , txTotalCollateral = validatedTotCollateral , txReturnCollateral = validatedRetCol , txFee = validatedFee - , txValidityRange = validatedBounds + , txValidityLowerBound = validatedLowerBound + , txValidityUpperBound = validatedUpperBound , txMetadata = txMetadata , txAuxScripts = txAuxScripts , txExtraKeyWits = validatedReqSigners @@ -528,8 +531,8 @@ runTxBuild validatedRetCol <- hoistEither $ first TxCmdReturnCollateralValidationError $ validateTxReturnCollateral era mReturnCollateral dFee <- hoistEither $ first TxCmdTxFeeValidationError $ validateTxFee era dummyFee - validatedBounds <- (,) <$> hoistEither (first TxCmdTxValidityLowerBoundValidationError $ validateTxValidityLowerBound era mLowerBound) - <*> hoistEither (first TxCmdTxValidityUpperBoundValidationError $ validateTxValidityUpperBound era mUpperBound) + validatedLowerBound <- hoistEither (first TxCmdTxValidityLowerBoundValidationError (validateTxValidityLowerBound era mLowerBound)) + validatedUpperBound <- hoistEither (first TxCmdTxValidityUpperBoundValidationError (validateTxValidityUpperBound era mUpperBound)) validatedReqSigners <- hoistEither (first TxCmdRequiredSignersValidationError $ validateRequiredSigners era reqSigners) validatedTxWtdrwls <- hoistEither (first TxCmdTxWithdrawalsValidationError $ validateTxWithdrawals era withdrawals) validatedTxCerts <- hoistEither (first TxCmdTxCertificatesValidationError $ validateTxCertificates era certsAndMaybeScriptWits) @@ -579,7 +582,8 @@ runTxBuild , txTotalCollateral = validatedTotCollateral , txReturnCollateral = validatedRetCol , txFee = dFee - , txValidityRange = validatedBounds + , txValidityLowerBound = validatedLowerBound + , txValidityUpperBound = validatedUpperBound , txMetadata = txMetadata , txAuxScripts = txAuxScripts , txExtraKeyWits = validatedReqSigners diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 44ca0a9134..2681362eba 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -10,6 +10,12 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# OPTIONS_GHC -Wno-unused-top-binds #-} +{-# OPTIONS_GHC -Wno-unused-local-binds #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} + -- | User-friendly pretty-printing for textual user interfaces (TUI) module Cardano.CLI.Json.Friendly ( friendlyTx @@ -151,7 +157,8 @@ friendlyTxBodyImpl , txReturnCollateral , txInsReference , txUpdateProposal - , txValidityRange + , txValidityLowerBound + ,txValidityUpperBound , txWithdrawals }) = [ "auxiliary scripts" .= friendlyAuxScripts txAuxScripts @@ -169,7 +176,8 @@ friendlyTxBodyImpl , "required signers (payment key hashes needed for scripts)" .= friendlyExtraKeyWits txExtraKeyWits , "update proposal" .= friendlyUpdateProposal txUpdateProposal - , "validity range" .= friendlyValidityRange era txValidityRange + , "validity lower bound" .= friendlyValidityLowerBound era txValidityLowerBound + , "validity upper bound" .= friendlyValidityUpperBound era txValidityUpperBound , "withdrawals" .= friendlyWithdrawals txWithdrawals ] @@ -187,37 +195,67 @@ friendlyExtraKeyWits = \case TxExtraKeyWitnessesNone -> Null TxExtraKeyWitnesses _supported paymentKeyHashes -> toJSON paymentKeyHashes --- | Special case of validity range: --- in Shelley, upper bound is TTL, and no lower bound -pattern ShelleyTtl - :: SlotNo -> (TxValidityLowerBound era, TxValidityUpperBound era) -pattern ShelleyTtl ttl <- - ( TxValidityNoLowerBound - , TxValidityUpperBound _ ttl - ) +-- -- | Special case of validity range: +-- -- in Shelley, upper bound is TTL, and no lower bound +-- pattern ShelleyTtl +-- :: Maybe SlotNo -> (TxValidityLowerBound era, TxValidityUpperBound era) +-- pattern ShelleyTtl ttl <- +-- ( TxValidityNoLowerBound +-- , TxValidityUpperBound _ ttl +-- ) -friendlyValidityRange +friendlyValidityLowerBound :: CardanoEra era - -> (TxValidityLowerBound era, TxValidityUpperBound era) + -> TxValidityLowerBound era -> Aeson.Value -friendlyValidityRange era = \case - ShelleyTtl ttl -> object ["time to live" .= ttl] - (lowerBound, upperBound) - | isLowerBoundSupported || isUpperBoundSupported -> - object - [ "lower bound" .= - case lowerBound of - TxValidityNoLowerBound -> Null - TxValidityLowerBound _ s -> toJSON s - , "upper bound" .= - case upperBound of - TxValidityNoUpperBound _ -> Null - TxValidityUpperBound _ s -> toJSON s - ] - | otherwise -> Null - where - isLowerBoundSupported = isJust $ inEonForEraMaybe TxValidityLowerBound era - isUpperBoundSupported = isJust $ inEonForEraMaybe TxValidityUpperBound era +friendlyValidityLowerBound era = \case + TxValidityNoLowerBound -> Null + TxValidityLowerBound _ s -> if isLowerBoundSupported then toJSON s else Null + where isLowerBoundSupported = isJust $ inEonForEraMaybe TxValidityLowerBound era +-- friendlyValidityLowerBound era = \case +-- ShelleyTtl ttl -> object ["time to live" .= ttl] +-- (TxValidityNoLowerBound, TxValidityUpperBound _ ttl) -> object ["time to live" .= ttl] +-- (lowerBound, upperBound) +-- | isLowerBoundSupported || isUpperBoundSupported -> +-- object +-- [ "lower bound" .= +-- case lowerBound of +-- TxValidityNoLowerBound -> Null +-- TxValidityLowerBound _ s -> toJSON s +-- , "upper bound" .= +-- case upperBound of +-- TxValidityNoUpperBound _ -> Null +-- TxValidityUpperBound _ s -> toJSON s +-- ] +-- | otherwise -> Null +-- where +-- isLowerBoundSupported = isJust $ inEonForEraMaybe TxValidityLowerBound era +-- isUpperBoundSupported = isJust $ inEonForEraMaybe TxValidityUpperBound era + +friendlyValidityUpperBound + :: CardanoEra era + -> TxValidityUpperBound era + -> Aeson.Value +friendlyValidityUpperBound era = undefined + -- where isLowerBoundSupported = isJust $ inEonForEraMaybe TxValidityLowerBound era +-- friendlyValidityUpperBound era = \case +-- ShelleyTtl ttl -> object ["time to live" .= ttl] +-- (lowerBound, upperBound) +-- | isLowerBoundSupported || isUpperBoundSupported -> +-- object +-- [ "lower bound" .= +-- case lowerBound of +-- TxValidityNoLowerBound -> Null +-- TxValidityLowerBound _ s -> toJSON s +-- , "upper bound" .= +-- case upperBound of +-- TxValidityNoUpperBound _ -> Null +-- TxValidityUpperBound _ s -> toJSON s +-- ] +-- | otherwise -> Null +-- where +-- isLowerBoundSupported = isJust $ inEonForEraMaybe TxValidityLowerBound era +-- isUpperBoundSupported = isJust $ inEonForEraMaybe TxValidityUpperBound era friendlyWithdrawals :: TxWithdrawals ViewTx era -> Aeson.Value friendlyWithdrawals TxWithdrawalsNone = Null diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs index 2dd5594d50..b825dda6a4 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs @@ -157,7 +157,7 @@ validateTxValidityUpperBound validateTxValidityUpperBound era = \case Just slot -> do supported <- conjureWitness era TxValidityUpperBoundNotSupported - pure $ TxValidityUpperBound supported slot + pure $ TxValidityUpperBound supported (Just slot) Nothing -> do supported <- conjureWitness era TxValidityUpperBoundNotSupported pure $ TxValidityNoUpperBound supported