diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index d2a65db8745..c343990b060 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -28,7 +28,7 @@ jobs: env: # Modify this value to "invalidate" the cabal cache. - CABAL_CACHE_VERSION: "2023-02-14" + CABAL_CACHE_VERSION: "2023-07-17" # current ref from: 27.02.2022 SECP256K1_REF: ac83be33d0956faf6b7f61a60ab524ef7d6a473a @@ -42,7 +42,7 @@ jobs: strategy: fail-fast: false matrix: - ghc: ["8.10.7", "9.2.7", "9.6.1"] + ghc: ["8.10.7", "9.2.8", "9.6.2"] os: [ubuntu-latest] steps: @@ -135,7 +135,7 @@ jobs: - name: Install fourmolu run: | mkdir -p "$HOME/.local/bin" - curl -sL https://github.com/fourmolu/fourmolu/releases/download/v0.10.1.0/fourmolu-0.10.1.0-linux-x86_64 -o "$HOME/.local/bin/fourmolu" + curl -sL https://github.com/fourmolu/fourmolu/releases/download/v0.13.1.0/fourmolu-0.13.1.0-linux-x86_64 -o "$HOME/.local/bin/fourmolu" chmod a+x "$HOME/.local/bin/fourmolu" echo "$HOME/.local/bin" >> $GITHUB_PATH diff --git a/README.md b/README.md index eef042b362b..323ce0d47c5 100644 --- a/README.md +++ b/README.md @@ -7,6 +7,7 @@ GitHub Workflow Status (master) + [![docs](https://img.shields.io/badge/documentation-Haddock-yellow?style=for-the-badge)](https://input-output-hk.github.io/cardano-ledger/)

This repository contains the formal specifications, executable models, diff --git a/cabal.project b/cabal.project index fa0c5069bfa..91ce5838fa4 100644 --- a/cabal.project +++ b/cabal.project @@ -10,14 +10,11 @@ repository cardano-haskell-packages c00aae8461a256275598500ea0e187588c35a5d5d7454fb57eac18d9edb86a56 d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee --- See CONTRIBUTING for some Nix commands you will need to run if you --- update either of these. -index-state: 2023-07-14T00:00:00Z index-state: -- Bump this if you need newer packages from Hackage - , hackage.haskell.org 2023-06-01T19:11:19Z + , hackage.haskell.org 2023-07-17T00:00:00Z -- Bump this if you need newer packages from CHaP - , cardano-haskell-packages 2023-07-14T00:00:00Z + , cardano-haskell-packages 2023-07-17T09:39:52Z packages: eras/allegra/impl diff --git a/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxAuxData.hs b/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxAuxData.hs index 420664efd66..15807fc6782 100644 --- a/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxAuxData.hs +++ b/eras/allegra/impl/src/Cardano/Ledger/Allegra/TxAuxData.hs @@ -106,7 +106,7 @@ instance Memoized AllegraTxAuxData where type instance MemoHashIndex AllegraTxAuxDataRaw = EraIndependentTxAuxData -instance (c ~ EraCrypto era) => HashAnnotated (AllegraTxAuxData era) EraIndependentTxAuxData c where +instance c ~ EraCrypto era => HashAnnotated (AllegraTxAuxData era) EraIndependentTxAuxData c where hashAnnotated = getMemoSafeHash deriving newtype instance diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs index ac816ba59e7..c7f8f2404e0 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs @@ -69,10 +69,10 @@ import NoThunks.Class (NoThunks (..)) data AlonzoBbodyPredFailure era = ShelleyInAlonzoBbodyPredFailure (ShelleyBbodyPredFailure era) | TooManyExUnits + -- | Computed Sum of ExUnits for all plutus scripts !ExUnits - -- ^ Computed Sum of ExUnits for all plutus scripts + -- | Maximum allowed by protocal parameters !ExUnits - -- ^ Maximum allowed by protocal parameters deriving (Generic) newtype AlonzoBbodyEvent era @@ -147,15 +147,15 @@ bbodyTransition = actualBodySize == fromIntegral (bhviewBSize bh) - ?! ShelleyInAlonzoBbodyPredFailure - ( WrongBlockBodySizeBBODY actualBodySize (fromIntegral $ bhviewBSize bh) - ) + ?! ShelleyInAlonzoBbodyPredFailure + ( WrongBlockBodySizeBBODY actualBodySize (fromIntegral $ bhviewBSize bh) + ) actualBodyHash == bhviewBHash bh - ?! ShelleyInAlonzoBbodyPredFailure - ( InvalidBodyHashBBODY @era actualBodyHash (bhviewBHash bh) - ) + ?! ShelleyInAlonzoBbodyPredFailure + ( InvalidBodyHashBBODY @era actualBodyHash (bhviewBHash bh) + ) ls' <- trans @(EraRule "LEDGERS" era) $ diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs index 50e5c6b8627..464d58d64eb 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs @@ -121,37 +121,37 @@ data AlonzoUtxoPredFailure era BadInputsUTxO !(Set (TxIn (EraCrypto era))) | OutsideValidityIntervalUTxO + -- | transaction's validity interval !ValidityInterval - -- ^ transaction's validity interval + -- | current slot !SlotNo - -- ^ current slot | MaxTxSizeUTxO + -- | the actual transaction size !Integer - -- ^ the actual transaction size + -- | the max transaction size !Integer - -- ^ the max transaction size | InputSetEmptyUTxO | FeeTooSmallUTxO + -- | the minimum fee for this transaction !Coin - -- ^ the minimum fee for this transaction + -- | the fee supplied in this transaction !Coin - -- ^ the fee supplied in this transaction | ValueNotConservedUTxO + -- | the Coin consumed by this transaction !(Value era) - -- ^ the Coin consumed by this transaction + -- | the Coin produced by this transaction !(Value era) - -- ^ the Coin produced by this transaction | -- | the set of addresses with incorrect network IDs WrongNetwork + -- | the expected network id !Network - -- ^ the expected network id + -- | the set of addresses with incorrect network IDs !(Set (Addr (EraCrypto era))) - -- ^ the set of addresses with incorrect network IDs | WrongNetworkWithdrawal + -- | the expected network id !Network - -- ^ the expected network id + -- | the set of reward addresses with incorrect network IDs !(Set (RewardAcnt (EraCrypto era))) - -- ^ the set of reward addresses with incorrect network IDs | -- | list of supplied transaction outputs that are too small OutputTooSmallUTxO ![TxOut era] @@ -166,35 +166,35 @@ data AlonzoUtxoPredFailure era OutputTooBigUTxO ![(Integer, Integer, TxOut era)] | InsufficientCollateral + -- | balance computed !Coin - -- ^ balance computed + -- | the required collateral for the given fee !Coin - -- ^ the required collateral for the given fee | -- | The UTxO entries which have the wrong kind of script ScriptsNotPaidUTxO !(UTxO era) | ExUnitsTooBigUTxO + -- | Max EXUnits from the protocol parameters !ExUnits - -- ^ Max EXUnits from the protocol parameters + -- | EXUnits supplied !ExUnits - -- ^ EXUnits supplied | -- | The inputs marked for use as fees contain non-ADA tokens CollateralContainsNonADA !(Value era) | -- | Wrong Network ID in body WrongNetworkInTxBody + -- | Actual Network ID !Network - -- ^ Actual Network ID + -- | Network ID in transaction body !Network - -- ^ Network ID in transaction body | -- | slot number outside consensus forecast range OutsideForecast !SlotNo | -- | There are too many collateral inputs TooManyCollateralInputs + -- | Max allowed collateral inputs !Natural - -- ^ Max allowed collateral inputs + -- | Number of collateral inputs !Natural - -- ^ Number of collateral inputs | NoCollateralInputs deriving (Generic) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs index e3c51790b2f..27987c487c3 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs @@ -102,20 +102,20 @@ data AlonzoUtxowPredFailure era MissingRedeemers ![(ScriptPurpose era, ScriptHash (EraCrypto era))] | MissingRequiredDatums + -- | Set of missing data hashes !(Set (DataHash (EraCrypto era))) - -- ^ Set of missing data hashes + -- | Set of received data hashes !(Set (DataHash (EraCrypto era))) - -- ^ Set of received data hashes | NonOutputSupplimentaryDatums + -- | Set of unallowed data hashes !(Set (DataHash (EraCrypto era))) - -- ^ Set of unallowed data hashes + -- | Set of acceptable supplimental data hashes !(Set (DataHash (EraCrypto era))) - -- ^ Set of acceptable supplimental data hashes | PPViewHashesDontMatch + -- | The PPHash in the TxBody !(StrictMaybe (ScriptIntegrityHash (EraCrypto era))) - -- ^ The PPHash in the TxBody + -- | Computed from the current Protocol Parameters !(StrictMaybe (ScriptIntegrityHash (EraCrypto era))) - -- ^ Computed from the current Protocol Parameters | -- | Set of witnesses which were needed and not supplied MissingRequiredSigners (Set (KeyHash 'Witness (EraCrypto era))) @@ -401,7 +401,7 @@ alonzoStyleWitness = do -- ================================ -extSymmetricDifference :: (Ord k) => [a] -> (a -> k) -> [b] -> (b -> k) -> ([a], [b]) +extSymmetricDifference :: Ord k => [a] -> (a -> k) -> [b] -> (b -> k) -> ([a], [b]) extSymmetricDifference as fa bs fb = (extraA, extraB) where intersection = Set.fromList (map fa as) `Set.intersection` Set.fromList (map fb bs) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts/Data.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts/Data.hs index 71a0add92e6..ccff9ccaf4b 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts/Data.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts/Data.hs @@ -111,7 +111,7 @@ deriving via Mem PlutusData era instance Era era => DecCBOR (Annotator (Data era type instance MemoHashIndex PlutusData = EraIndependentData -instance (EraCrypto era ~ c) => HashAnnotated (Data era) EraIndependentData c where +instance EraCrypto era ~ c => HashAnnotated (Data era) EraIndependentData c where hashAnnotated = getMemoSafeHash instance Typeable era => NoThunks (Data era) @@ -134,7 +134,7 @@ newtype BinaryData era = BinaryData ShortByteString deriving newtype (Eq, NoThunks, Ord, Show, SafeToHash) deriving (Generic) -instance (EraCrypto era ~ c) => HashAnnotated (BinaryData era) EraIndependentData c +instance EraCrypto era ~ c => HashAnnotated (BinaryData era) EraIndependentData c instance Typeable era => EncCBOR (BinaryData era) where encCBOR (BinaryData sbs) = encodeTag 24 <> encCBOR sbs @@ -185,7 +185,7 @@ dataHashSize :: StrictMaybe (DataHash c) -> Integer dataHashSize SNothing = 0 dataHashSize (SJust _) = 10 -instance (Crypto c) => HeapWords (StrictMaybe (DataHash c)) where +instance Crypto c => HeapWords (StrictMaybe (DataHash c)) where heapWords SNothing = heapWords0 heapWords (SJust a) = heapWords1 a diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs index dc156c90a2a..14170547b78 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs @@ -342,7 +342,7 @@ alonzoMinFeeTx :: Coin alonzoMinFeeTx pp tx = (tx ^. sizeTxF <×> pp ^. ppMinFeeAL) - <+> pp ^. ppMinFeeBL + <+> (pp ^. ppMinFeeBL) <+> txscriptfee (pp ^. ppPricesL) allExunits where allExunits = totExUnits tx diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxAuxData.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxAuxData.hs index 57391ecd40d..de632743a2a 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxAuxData.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxAuxData.hs @@ -253,14 +253,14 @@ validateAlonzoTxAuxData pv auxData@AlonzoTxAuxData {atadMetadata = metadata} = all validMetadatum metadata && all (validScript pv) (getAlonzoTxAuxDataScripts auxData) -instance (EraCrypto era ~ c) => HashAnnotated (AuxiliaryData era) EraIndependentTxAuxData c where +instance EraCrypto era ~ c => HashAnnotated (AuxiliaryData era) EraIndependentTxAuxData c where hashAnnotated = getMemoSafeHash deriving newtype instance NFData (AuxiliaryData era) deriving instance Eq (AuxiliaryData era) -deriving instance (HashAlgorithm (HASH (EraCrypto era))) => Show (AuxiliaryData era) +deriving instance HashAlgorithm (HASH (EraCrypto era)) => Show (AuxiliaryData era) type instance MemoHashIndex AlonzoTxAuxDataRaw = EraIndependentTxAuxData diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs index 5294be776c8..b6d37ef4b82 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs @@ -353,7 +353,7 @@ pattern AlonzoTxBody type instance MemoHashIndex AlonzoTxBodyRaw = EraIndependentTxBody -instance (c ~ EraCrypto era) => HashAnnotated (AlonzoTxBody era) EraIndependentTxBody c where +instance c ~ EraCrypto era => HashAnnotated (AlonzoTxBody era) EraIndependentTxBody c where hashAnnotated = getMemoSafeHash -- ============================================================================== diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxOut.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxOut.hs index 4d094a5969d..bfcc99f2cde 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxOut.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxOut.hs @@ -244,7 +244,7 @@ encodeAddress28 network paymentCred = do encodeDataHash32 :: forall c. - (HashAlgorithm (HASH c)) => + HashAlgorithm (HASH c) => DataHash c -> Maybe (SizeHash (HASH c) :~: 32, DataHash32) encodeDataHash32 dataHash = do diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxSeq.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxSeq.hs index 0dac41a2994..5adb3f53409 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxSeq.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxSeq.hs @@ -150,7 +150,7 @@ deriving stock instance Eq (Tx era) => Eq (TxSeq era) instance forall era. - (Era era) => + Era era => EncCBORGroup (TxSeq era) where encCBORGroup (TxSeq' _ bodyBytes witsBytes metadataBytes invalidBytes) = @@ -167,7 +167,7 @@ instance hashTxSeq :: forall era. - (Era era) => + Era era => AlonzoTxSeq era -> Hash (EraCrypto era) EraIndependentBlockBody hashTxSeq = hashAlonzoTxSeq @@ -176,7 +176,7 @@ hashTxSeq = hashAlonzoTxSeq -- | Hash a given block body hashAlonzoTxSeq :: forall era. - (Era era) => + Era era => AlonzoTxSeq era -> Hash (EraCrypto era) EraIndependentBlockBody hashAlonzoTxSeq (TxSeq' _ bodies ws md vs) = diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs index e0d28456326..ef03609f71d 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs @@ -273,7 +273,7 @@ unTxDats (TxDats' m) = m nullDats :: TxDats era -> Bool nullDats (TxDats' d) = Map.null d -instance (Era era) => DecCBOR (Annotator (TxDatsRaw era)) where +instance Era era => DecCBOR (Annotator (TxDatsRaw era)) where decCBOR = decode $ fmap (TxDatsRaw . keyBy hashData) <$> listDecodeA From {-# INLINE decCBOR #-} @@ -301,7 +301,7 @@ instance Era era => EncCBOR (TxDats era) deriving via (Mem TxDatsRaw era) instance - (Era era) => DecCBOR (Annotator (TxDats era)) + Era era => DecCBOR (Annotator (TxDats era)) -- ===================================================== -- AlonzoTxWits instances @@ -529,7 +529,7 @@ instance Era era => EncCBOR (Redeemers era) deriving via (Mem RedeemersRaw era) instance - (Era era) => DecCBOR (Annotator (Redeemers era)) + Era era => DecCBOR (Annotator (Redeemers era)) instance ( EraScript era diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Arbitrary.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Arbitrary.hs index 86284a3240d..0b10ed0a133 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Arbitrary.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Arbitrary.hs @@ -156,7 +156,7 @@ genScripts :: Gen (Map.Map (ScriptHash (EraCrypto era)) (Script era)) genScripts = keyBy (hashScript @era) <$> (arbitrary :: Gen [Script era]) -instance (Era era) => Arbitrary (TxDats era) where +instance Era era => Arbitrary (TxDats era) where arbitrary = TxDats . keyBy hashData <$> arbitrary instance @@ -214,8 +214,7 @@ instance genAlonzoScript :: forall era. - ( Era era - ) => + Era era => [Language] -> Gen (AlonzoScript era) genAlonzoScript langs = do diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs index c07eed74025..ecae8326fdd 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs @@ -104,10 +104,10 @@ data BabbageUtxoPredFailure era = AlonzoInBabbageUtxoPredFailure !(AlonzoUtxoPredFailure era) -- Inherited from Alonzo | -- | The collateral is not equivalent to the total collateral asserted by the transaction IncorrectTotalCollateralField + -- | collateral provided !Coin - -- ^ collateral provided + -- | collateral amount declared in transaction body !Coin - -- ^ collateral amount declared in transaction body | -- | list of supplied transaction outputs that are too small, -- together with the minimum value for the given output. BabbageOutputTooSmallUTxO diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Translation.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Translation.hs index f4b1fdd03da..02a95510efc 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Translation.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Translation.hs @@ -54,7 +54,7 @@ import Lens.Micro type instance TranslationContext (BabbageEra c) = () instance - (Crypto c) => + Crypto c => TranslateEra (BabbageEra c) NewEpochState where translateEra ctxt nes = diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Tx.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Tx.hs index 2567c73f502..ddb72cf9380 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Tx.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Tx.hs @@ -148,7 +148,7 @@ babbageTxScripts utxo tx = ans -- | Collect all the reference scripts found in the TxOuts, pointed to by some input. refScripts :: forall era. - (BabbageEraTxOut era) => + BabbageEraTxOut era => Set (TxIn (EraCrypto era)) -> UTxO era -> Map.Map (ScriptHash (EraCrypto era)) (Script era) diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs index 0c3a1feee7e..eb2c2b0eae6 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs @@ -583,7 +583,7 @@ pattern BabbageTxBody mkBabbageTxBody :: BabbageEraTxBody era => BabbageTxBody era mkBabbageTxBody = mkMemoized basicBabbageTxBodyRaw -instance (c ~ EraCrypto era) => HashAnnotated (BabbageTxBody era) EraIndependentTxBody c where +instance c ~ EraCrypto era => HashAnnotated (BabbageTxBody era) EraIndependentTxBody c where hashAnnotated = getMemoSafeHash -- ============================================================================== diff --git a/eras/babbage/test-suite/src/Test/Cardano/Ledger/Babbage/TxInfo.hs b/eras/babbage/test-suite/src/Test/Cardano/Ledger/Babbage/TxInfo.hs index 720fa80bc5a..7fad6b79cc6 100644 --- a/eras/babbage/test-suite/src/Test/Cardano/Ledger/Babbage/TxInfo.hs +++ b/eras/babbage/test-suite/src/Test/Cardano/Ledger/Babbage/TxInfo.hs @@ -205,7 +205,7 @@ errorTranslate exampleName = translatedInputEx1 :: forall era. - (BabbageTxInfoTests era) => + BabbageTxInfoTests era => Proxy era -> PV2.TxInInfo translatedInputEx1 _ = @@ -213,7 +213,7 @@ translatedInputEx1 _ = translatedInputEx2 :: forall era. - (BabbageTxInfoTests era) => + BabbageTxInfoTests era => Proxy era -> PV2.TxInInfo translatedInputEx2 _ = @@ -225,7 +225,7 @@ translatedOutputEx1 _ = translatedOutputEx2 :: forall era. - (BabbageTxInfoTests era) => + BabbageTxInfoTests era => Proxy era -> PV2.TxOut translatedOutputEx2 _ = diff --git a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Chain.hs b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Chain.hs index 33689eb289f..055de3eb0c8 100644 --- a/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Chain.hs +++ b/eras/byron/chain/executable-spec/src/Byron/Spec/Chain/STS/Rule/Chain.hs @@ -189,7 +189,7 @@ headerIsValid us bh = do let sMax = snd (us ^. _1) ^. maxHdrSz bHeaderSize bh <= sMax - ?! HeaderSizeTooBig bh (bHeaderSize bh) (Threshold sMax) + ?! HeaderSizeTooBig bh (bHeaderSize bh) (Threshold sMax) -- | Lens for the delegation interface state contained in the chain state. disL :: Lens' (State CHAIN) DIState diff --git a/eras/byron/crypto/src/Cardano/Crypto/Hashing.hs b/eras/byron/crypto/src/Cardano/Crypto/Hashing.hs index d90c1bd1f04..a30ed55bd51 100644 --- a/eras/byron/crypto/src/Cardano/Crypto/Hashing.hs +++ b/eras/byron/crypto/src/Cardano/Crypto/Hashing.hs @@ -161,9 +161,9 @@ instance -- Better instance: know the hash algorithm up front, read exactly that -- many bytes, fail otherwise. Then convert to a digest. bs <- decCBOR @SBS.ShortByteString - when (SBS.length bs /= expectedSize) $ - cborError $ - DecoderErrorCustom "AbstractHash" "Bytes not expected length" + when (SBS.length bs /= expectedSize) + $ cborError + $ DecoderErrorCustom "AbstractHash" "Bytes not expected length" return (AbstractHash bs) where expectedSize = hashDigestSize (Prelude.undefined :: algo) @@ -273,7 +273,7 @@ serializeCborHash :: EncCBOR a => a -> Hash a serializeCborHash = abstractHash -- | The hash of a value's annotation -hashDecoded :: (Decoded t) => t -> Hash (BaseType t) +hashDecoded :: Decoded t => t -> Hash (BaseType t) hashDecoded = unsafeAbstractHash . LBS.fromStrict . recoverBytes -- | Hash a bytestring diff --git a/eras/byron/crypto/src/Cardano/Crypto/Orphans.hs b/eras/byron/crypto/src/Cardano/Crypto/Orphans.hs index f3eb5f91cf3..7738b611aa5 100644 --- a/eras/byron/crypto/src/Cardano/Crypto/Orphans.hs +++ b/eras/byron/crypto/src/Cardano/Crypto/Orphans.hs @@ -30,7 +30,7 @@ fromByteStringToBytes = BA.convert fromByteStringToScrubbedBytes :: ByteString -> BA.ScrubbedBytes fromByteStringToScrubbedBytes = BA.convert -toByteString :: (BA.ByteArrayAccess bin) => bin -> ByteString +toByteString :: BA.ByteArrayAccess bin => bin -> ByteString toByteString = BA.convert fromCryptoFailable :: T.Text -> CryptoFailable a -> Either T.Text a @@ -87,8 +87,8 @@ instance DecCBOR Ed25519.PublicKey where instance EncCBOR Ed25519.SecretKey where encodedSizeExpr _ _ = bsSize 64 encCBOR sk = - encodeBytes $ - BS.append (toByteString sk) (toByteString $ Ed25519.toPublic sk) + encodeBytes + $ BS.append (toByteString sk) (toByteString $ Ed25519.toPublic sk) instance DecCBOR Ed25519.SecretKey where decCBOR = do diff --git a/eras/byron/crypto/src/Cardano/Crypto/ProtocolMagic.hs b/eras/byron/crypto/src/Cardano/Crypto/ProtocolMagic.hs index b10b1be43b7..d53316e6b24 100644 --- a/eras/byron/crypto/src/Cardano/Crypto/ProtocolMagic.hs +++ b/eras/byron/crypto/src/Cardano/Crypto/ProtocolMagic.hs @@ -84,8 +84,10 @@ instance A.ToJSON ProtocolMagic where instance A.FromJSON ProtocolMagic where parseJSON = A.withObject "ProtocolMagic" $ \o -> AProtocolMagic - <$> o .: "pm" - <*> o .: "requiresNetworkMagic" + <$> o + .: "pm" + <*> o + .: "requiresNetworkMagic" -- Canonical JSON instances instance Monad m => ToJSON m ProtocolMagicId where @@ -134,8 +136,9 @@ instance A.ToJSON RequiresNetworkMagic where instance A.FromJSON RequiresNetworkMagic where parseJSON = - A.withText "requiresNetworkMagic" $ - toAesonError . \case + A.withText "requiresNetworkMagic" + $ toAesonError + . \case "RequiresNoMagic" -> Right RequiresNoMagic "RequiresMagic" -> Right RequiresMagic "NMMustBeNothing" -> Right RequiresNoMagic diff --git a/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/Compact.hs b/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/Compact.hs index cb38123dd93..d8523e4a8be 100644 --- a/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/Compact.hs +++ b/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/Compact.hs @@ -123,9 +123,9 @@ fromCompactRedeemVerificationKey compactRvk = where bs :: ByteString bs = - BSL.toStrict $ - runPut $ - putCompactRedeemVerificationKey compactRvk + BSL.toStrict + $ runPut + $ putCompactRedeemVerificationKey compactRvk instance Ord CompactRedeemVerificationKey where compare = compare `on` fromCompactRedeemVerificationKey diff --git a/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/VerificationKey.hs b/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/VerificationKey.hs index c4885a08e42..ec5ea5d20b2 100644 --- a/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/VerificationKey.hs +++ b/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/VerificationKey.hs @@ -102,16 +102,16 @@ data AvvmVKError redeemVKBuild :: ByteString -> RedeemVerificationKey redeemVKBuild bs | BS.length bs /= 32 = - panic $ - "consRedeemVK: failed to form vk, wrong bs length: " - <> show (BS.length bs) - <> ", when should be 32" + panic + $ "consRedeemVK: failed to form vk, wrong bs length: " + <> show (BS.length bs) + <> ", when should be 32" | otherwise = case Ed25519.publicKey (BA.convert bs :: BA.Bytes) of CryptoPassed r -> RedeemVerificationKey r CryptoFailed e -> - panic $ - mappend + panic + $ mappend "Cardano.Crypto.Signing.Types.Redeem.hs consRedeemVK failed because " (T.pack $ show e) @@ -153,10 +153,10 @@ instance FromJSONKey RedeemVerificationKey where fromJSONKey = FromJSONKeyTextParser $ toAesonError . first (sformat build) . fromAvvmVK fromJSONKeyList = - FromJSONKeyTextParser $ - toAesonError - . bimap (sformat build) pure - . fromAvvmVK + FromJSONKeyTextParser + $ toAesonError + . bimap (sformat build) pure + . fromAvvmVK instance B.Buildable RedeemVerificationKey where build = bprint ("redeem_vk:" . redeemVKB64F) diff --git a/eras/byron/crypto/src/Cardano/Crypto/Signing/Safe/KeyGen.hs b/eras/byron/crypto/src/Cardano/Crypto/Signing/Safe/KeyGen.hs index 98b6420c3a0..79808e34568 100644 --- a/eras/byron/crypto/src/Cardano/Crypto/Signing/Safe/KeyGen.hs +++ b/eras/byron/crypto/src/Cardano/Crypto/Signing/Safe/KeyGen.hs @@ -19,7 +19,7 @@ safeCreateKeypairFromSeed seed (PassPhrase pp) = -- NB. It's recommended to run it with 'runSecureRandom' from -- "Cardano.Crypto.Random" because the OpenSSL generator is probably safer than -- the default IO generator. -safeKeyGen :: (MonadRandom m) => PassPhrase -> m (VerificationKey, SigningKey) +safeKeyGen :: MonadRandom m => PassPhrase -> m (VerificationKey, SigningKey) safeKeyGen pp = do seed <- getRandomBytes 32 pure $ safeDeterministicKeyGen seed pp diff --git a/eras/byron/crypto/src/Cardano/Crypto/Signing/Safe/PassPhrase.hs b/eras/byron/crypto/src/Cardano/Crypto/Signing/Safe/PassPhrase.hs index 16e1403787c..61a5305f33e 100644 --- a/eras/byron/crypto/src/Cardano/Crypto/Signing/Safe/PassPhrase.hs +++ b/eras/byron/crypto/src/Cardano/Crypto/Signing/Safe/PassPhrase.hs @@ -64,12 +64,12 @@ instance DecCBOR PassPhrase where let bl = BS.length bs -- Currently passphrase may be either 32-byte long or empty (for -- unencrypted keys). - toCborError $ - if bl == 0 || bl == passphraseLength + toCborError + $ if bl == 0 || bl == passphraseLength then Right $ ByteArray.convert bs else - Left $ - sformat + Left + $ sformat ("put@PassPhrase: expected length 0 or " . int . ", not " . int) passphraseLength bl diff --git a/eras/byron/crypto/test/Test/Cardano/Crypto/CBOR.hs b/eras/byron/crypto/test/Test/Cardano/Crypto/CBOR.hs index 4d1e4810edf..d45cfa18ae3 100644 --- a/eras/byron/crypto/test/Test/Cardano/Crypto/CBOR.hs +++ b/eras/byron/crypto/test/Test/Cardano/Crypto/CBOR.hs @@ -275,28 +275,28 @@ sizeEstimates = [ ("VerificationKey", testPrecise genVerificationKey) , ( "AbstractHash Blake2b_224 VerificationKey" - , testPrecise @(AbstractHash Blake2b_224 VerificationKey) $ - genAbstractHash genVerificationKey + , testPrecise @(AbstractHash Blake2b_224 VerificationKey) + $ genAbstractHash genVerificationKey ) , ( "AbstractHash Blake2b_256 VerificationKey" - , testPrecise @(AbstractHash Blake2b_256 VerificationKey) $ - genAbstractHash genVerificationKey + , testPrecise @(AbstractHash Blake2b_256 VerificationKey) + $ genAbstractHash genVerificationKey ) , ( "AbstractHash Blake2b_384 VerificationKey" - , testPrecise @(AbstractHash Blake2b_384 VerificationKey) $ - genAbstractHash genVerificationKey + , testPrecise @(AbstractHash Blake2b_384 VerificationKey) + $ genAbstractHash genVerificationKey ) , ( "AbstractHash Blake2b_512 VerificationKey" - , testPrecise @(AbstractHash Blake2b_512 VerificationKey) $ - genAbstractHash genVerificationKey + , testPrecise @(AbstractHash Blake2b_512 VerificationKey) + $ genAbstractHash genVerificationKey ) , ( "AbstractHash SHA1 VerificationKey" - , testPrecise @(AbstractHash SHA1 VerificationKey) $ - genAbstractHash genVerificationKey + , testPrecise @(AbstractHash SHA1 VerificationKey) + $ genAbstractHash genVerificationKey ) , ("RedeemVerificationKey", testPrecise genRedeemVerificationKey) , ("RedeemSigningKey", testPrecise genRedeemSigningKey) diff --git a/eras/byron/crypto/test/Test/Cardano/Crypto/Orphans.hs b/eras/byron/crypto/test/Test/Cardano/Crypto/Orphans.hs index e7471ac7d8f..0a80b5dd4df 100644 --- a/eras/byron/crypto/test/Test/Cardano/Crypto/Orphans.hs +++ b/eras/byron/crypto/test/Test/Cardano/Crypto/Orphans.hs @@ -27,5 +27,5 @@ instance Ord Ed25519.SecretKey where instance Ord Ed25519.Signature where compare x1 x2 = compare (toByteString x1) (toByteString x2) -toByteString :: (BA.ByteArrayAccess bin) => bin -> ByteString +toByteString :: BA.ByteArrayAccess bin => bin -> ByteString toByteString = BA.convert diff --git a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Core.hs b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Core.hs index fcb435dafe7..803cb9ec176 100644 --- a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Core.hs +++ b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Core.hs @@ -303,14 +303,14 @@ class Relation m where -- | Restrict range to values less or equal than the given value -- -- Unicode: 25b7 - (▷<=) :: (Ord (Range m)) => m -> Range m -> m + (▷<=) :: Ord (Range m) => m -> Range m -> m infixl 5 ▷<= -- | Restrict range to values greater or equal than the given value -- -- Unicode: 25b7 - (▷>=) :: (Ord (Range m)) => m -> Range m -> m + (▷>=) :: Ord (Range m) => m -> Range m -> m infixl 5 ▷>= diff --git a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Delegation.hs b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Delegation.hs index 240c928af23..e1e28aead1b 100644 --- a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Delegation.hs +++ b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Delegation.hs @@ -366,22 +366,22 @@ instance STS SDELEG where env ^. epoch <= cert - ^. to depoch - ?! EpochInThePast - EpochDiff - { currentEpoch = env ^. epoch - , certEpoch = cert ^. to depoch - } + ^. to depoch + ?! EpochInThePast + EpochDiff + { currentEpoch = env ^. epoch + , certEpoch = cert ^. to depoch + } cert ^. to depoch <= env - ^. epoch - + 1 - ?! EpochPastNextEpoch - EpochDiff - { currentEpoch = env ^. epoch - , certEpoch = cert ^. to depoch - } + ^. epoch + + 1 + ?! EpochPastNextEpoch + EpochDiff + { currentEpoch = env ^. epoch + , certEpoch = cert ^. to depoch + } return $ st & scheduledDelegations diff --git a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/GlobalParams.hs b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/GlobalParams.hs index 13192fcaab6..816eccca3fe 100644 --- a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/GlobalParams.hs +++ b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/GlobalParams.hs @@ -19,7 +19,7 @@ slotsPerEpoch (BlockCount bc) = fromIntegral $ bc * 10 -- | The inverse of 'slotsPerEpoch': given a number of slots per-epoch, return -- the chain stability parameter @k@. -slotsPerEpochToK :: (Integral n) => n -> BlockCount +slotsPerEpochToK :: Integral n => n -> BlockCount slotsPerEpochToK n = BlockCount $ floor $ (fromIntegral n :: Double) / 10 -- | Given the chain stability parameter, calculate the first slot in a given diff --git a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Update.hs b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Update.hs index e6e6090cf25..f5d1e23d938 100644 --- a/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Update.hs +++ b/eras/byron/ledger/executable-spec/src/Byron/Spec/Ledger/Update.hs @@ -1319,7 +1319,7 @@ ppsUpdateFrom pps = do -- -- For now we choose an arbitrary constant. Gen.integral (Range.exponentialFrom currUpTtl minTtl (2 * currUpTtl)) - `increasingProbabilityAt` (minTtl, 2 * currUpTtl) + `increasingProbabilityAt` (minTtl, 2 * currUpTtl) where SlotCount currUpTtl = _upTtl minTtl = 2 @@ -1332,7 +1332,7 @@ ppsUpdateFrom pps = do nextUpAdptThd = UpAdptThd <$> Gen.double (Range.exponentialFloatFrom uat 0 1) - `increasingProbabilityAt` (0, 1) + `increasingProbabilityAt` (0, 1) nextFactorA :: Gen FactorA nextFactorA = @@ -1340,7 +1340,7 @@ ppsUpdateFrom pps = do <$> -- TODO: we choose arbitrary numbers here for now. Gen.integral (Range.exponentialFrom fA 0 10) - `increasingProbabilityAt` (0, 10) + `increasingProbabilityAt` (0, 10) -- The next value of the factor B shouldn't drop below 'GP.c' since when -- elaborating this factor we divide it by 'GP.c' (see 'initialPParams'). @@ -1348,7 +1348,7 @@ ppsUpdateFrom pps = do nextFactorB = FactorB <$> Gen.integral (Range.exponentialFrom fB minFactorB maxFactorB) - `increasingProbabilityAt` (minFactorB, maxFactorB) + `increasingProbabilityAt` (minFactorB, maxFactorB) where minFactorB = 5 * fromIntegral GP.c maxFactorB = 15 * fromIntegral GP.c diff --git a/eras/byron/ledger/executable-spec/src/Data/AbstractSize.hs b/eras/byron/ledger/executable-spec/src/Data/AbstractSize.hs index 76e42ffa2e1..dcf5cf715cf 100644 --- a/eras/byron/ledger/executable-spec/src/Data/AbstractSize.hs +++ b/eras/byron/ledger/executable-spec/src/Data/AbstractSize.hs @@ -143,11 +143,11 @@ instance (GHasTypeReps a, GHasTypeReps b) => GHasTypeReps (a :+: b) where gTypeReps (R1 b) = gTypeReps b -- | We do need to do anything for the metadata. -instance (GHasTypeReps a) => GHasTypeReps (M1 i c a) where +instance GHasTypeReps a => GHasTypeReps (M1 i c a) where gTypeReps (M1 x) = gTypeReps x -- | And the only interesting case, get the type of a type constructor -instance (HasTypeReps a) => GHasTypeReps (K1 i a) where +instance HasTypeReps a => GHasTypeReps (K1 i a) where gTypeReps (K1 x) = typeReps x -------------------------------------------------------------------------------- diff --git a/eras/byron/ledger/executable-spec/test/Test/Byron/Spec/Ledger/Relation/Properties.hs b/eras/byron/ledger/executable-spec/test/Test/Byron/Spec/Ledger/Relation/Properties.hs index 0cb2ac4cfb2..7b5e1af9c17 100644 --- a/eras/byron/ledger/executable-spec/test/Test/Byron/Spec/Ledger/Relation/Properties.hs +++ b/eras/byron/ledger/executable-spec/test/Test/Byron/Spec/Ledger/Relation/Properties.hs @@ -106,7 +106,7 @@ propDomainExclusionAndUnion s r1 r2 = (dom r1 `union` s) ⋪ (r1 ∪ r2) === (dom r1 `union` s) - ⋪ r2 + ⋪ r2 -------------------------------------------------------------------------------- -- Property helpers diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Block/Block.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Block/Block.hs index f1665ea32fe..7c31a985856 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Block/Block.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Block/Block.hs @@ -490,8 +490,8 @@ decCBORABoundaryBlock = do -- 2 items (body and extra body data) bod <- decCBORABoundaryBody pure (hdr, bod) - pure $ - ABoundaryBlock + pure + $ ABoundaryBlock { boundaryBlockLength = end - start , boundaryHeader = hdr , boundaryBody = bod diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Block/Header.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Block/Header.hs index 39c7e08eae1..61722ea67a9 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Block/Header.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Block/Header.hs @@ -376,8 +376,8 @@ decCBORAHeader epochSlots = do <*> decCBORAnnotated <*> decCBOR <*> annotatedDecoder decCBORBlockVersions - pure $ - AHeader + pure + $ AHeader pm prevHash slot @@ -579,14 +579,16 @@ encCBORABoundaryHeaderSize pm hdr = 1 + szGreedy pm + szCases - [ Case "GenesisHash" $ - szGreedy $ - pFromLeft $ - boundaryPrevHash <$> hdr - , Case "HeaderHash" $ - szGreedy $ - pFromRight $ - boundaryPrevHash <$> hdr + [ Case "GenesisHash" + $ szGreedy + $ pFromLeft + $ boundaryPrevHash + <$> hdr + , Case "HeaderHash" + $ szGreedy + $ pFromRight + $ boundaryPrevHash + <$> hdr ] -- Body proof + szGreedy (Proxy :: Proxy (Hash LByteString)) diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Block/Validation.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Block/Validation.hs index 7646625c182..f70166124b3 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Block/Validation.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Block/Validation.hs @@ -181,8 +181,8 @@ initialChainValidationState :: m ChainValidationState initialChainValidationState config = do delegationState <- DI.initialState delegationEnv genesisDelegation - pure $ - ChainValidationState + pure + $ ChainValidationState { cvsLastSlot = 0 , -- Ensure that we don't allow the internal value of this 'Left' to be -- lazy as we want to ensure that the 'ChainValidationState' is always @@ -292,8 +292,8 @@ updateChainBoundary cvs bvd = do `orThrowError` ChainValidationBoundaryTooLarge -- Update the previous hash - pure $ - cvs + pure + $ cvs { cvsPreviousHash = Right $! previousHash } where @@ -391,8 +391,8 @@ updateBody env bs b = do UPI.registerUpdate updateEnv updateState updateSignal `wrapError` ChainValidationUpdateError currentSlot - pure $ - BodyState + pure + $ BodyState { utxo = utxo' , updateState = updateState' , delegationState = delegationState' @@ -553,8 +553,8 @@ updateBlock config cvs b = do BodyState {utxo, updateState, delegationState} <- updateBody bodyEnv bs b - pure $ - cvs + pure + $ cvs { cvsLastSlot = blockSlot b , cvsPreviousHash = Right $! blockHashAnnotated b , cvsUtxo = utxo @@ -606,8 +606,9 @@ foldUTxOBlock :: ExceptT Error (ReaderT ValidationMode ResIO) UTxO foldUTxOBlock env utxo block = withExceptT - ( ErrorUTxOValidationError . fromSlotNumber mainnetEpochSlots $ - blockSlot + ( ErrorUTxOValidationError + . fromSlotNumber mainnetEpochSlots + $ blockSlot block ) $ UTxO.updateUTxO env utxo (aUnTxPayload $ blockTxPayload block) diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Byron/API/Common.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Byron/API/Common.hs index 480c0b6d1f7..34c9f484ffc 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Byron/API/Common.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Byron/API/Common.hs @@ -123,8 +123,8 @@ reAnnotateUsing encoder decoder = roundtripFailure :: forall x. T.Text -> x roundtripFailure err = - panic $ - T.intercalate + panic + $ T.intercalate ": " [ "annotateBoundary" , "serialization roundtrip failure" @@ -156,5 +156,5 @@ abobMatchesBody hdr blk = where matchesBody :: CC.AHeader ByteString -> CC.ABlock ByteString -> Bool matchesBody hdr' blk' = - isRight $ - CC.validateHeaderMatchesBody hdr' (CC.blockBody blk') + isRight + $ CC.validateHeaderMatchesBody hdr' (CC.blockBody blk') diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Byron/API/Mempool.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Byron/API/Mempool.hs index b336488d372..86acb699f1d 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Byron/API/Mempool.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Byron/API/Mempool.hs @@ -189,9 +189,9 @@ applyTxAux :: CC.ChainValidationState -> m CC.ChainValidationState applyTxAux validationMode cfg txs cvs = - flip runReaderT validationMode $ - (`setUTxO` cvs) - <$> Utxo.updateUTxO utxoEnv utxo txs + flip runReaderT validationMode + $ (`setUTxO` cvs) + <$> Utxo.updateUTxO utxoEnv utxo txs where utxoEnv = mkUtxoEnvironment cfg cvs utxo = CC.cvsUtxo cvs diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Byron/API/Validation.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Byron/API/Validation.hs index 100601f634f..4a26fb3f26c 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Byron/API/Validation.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Byron/API/Validation.hs @@ -42,8 +42,8 @@ mkEpochEnvironment :: mkEpochEnvironment cfg cvs = CC.EpochEnvironment { CC.protocolMagic = - reAnnotateMagicId $ - Gen.configProtocolMagicId cfg + reAnnotateMagicId + $ Gen.configProtocolMagicId cfg , CC.k = Gen.configK cfg , CC.allowedDelegators = allowedDelegators cfg , CC.delegationMap = delegationMap @@ -137,8 +137,8 @@ validateHeader :: CC.AHeader ByteString -> m () validateHeader validationMode updState hdr = - flip runReaderT validationMode $ - CC.headerIsValid updState hdr + flip runReaderT validationMode + $ CC.headerIsValid updState hdr validateBody :: MonadError CC.ChainValidationError m => @@ -148,8 +148,8 @@ validateBody :: CC.BodyState -> m CC.BodyState validateBody validationMode block bodyEnv bodyState = - flip runReaderT validationMode $ - CC.updateBody bodyEnv bodyState block + flip runReaderT validationMode + $ CC.updateBody bodyEnv bodyState block validateBlock :: MonadError CC.ChainValidationError m => diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/Address.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/Address.hs index 92863361b5c..6273739b72c 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/Address.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/Address.hs @@ -164,17 +164,17 @@ instance EncCBOR Address where encodeCrcProtected (addrRoot addr, addrAttributes addr, addrType addr) encodedSizeExpr size pxy = - encodedCrcProtectedSizeExpr size $ - (,,) - <$> (addrRoot <$> pxy) - <*> (addrAttributes <$> pxy) - <*> (addrType <$> pxy) + encodedCrcProtectedSizeExpr size + $ (,,) + <$> (addrRoot <$> pxy) + <*> (addrAttributes <$> pxy) + <*> (addrType <$> pxy) instance DecCBOR Address where decCBOR = do (root, attributes, addrType') <- decodeCrcProtected - pure $ - Address + pure + $ Address { addrRoot = root , addrAttributes = attributes , addrType = addrType' @@ -314,7 +314,7 @@ checkAddrSpendingData asd addr = addrRoot addr == addressHash address' && addrType addr - == addrSpendingDataToType asd + == addrSpendingDataToType asd where address' = Address' (addrType addr, asd, addrAttributes addr) diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/Attributes.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/Attributes.hs index 0951cd573e6..7aed2be2695 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/Attributes.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/Attributes.hs @@ -193,8 +193,8 @@ version would be able to parse it). encCBORAttributes :: forall t. [(Word8, t -> LBS.ByteString)] -> Attributes t -> Encoding encCBORAttributes encs attr = - encCBOR $ - foldr go (fromUnparsedFields $ attrRemain attr) encs + encCBOR + $ foldr go (fromUnparsedFields $ attrRemain attr) encs where go :: (Word8, t -> LBS.ByteString) -> @@ -205,11 +205,11 @@ encCBORAttributes encs attr = insertCheck :: a -> Maybe LByteString -> Maybe a insertCheck v Nothing = Just v insertCheck _ (Just v') = - panic $ - "encCBORAttributes: impossible: field no. " - <> show k - <> " is already encoded as unparsed field: " - <> show v' + panic + $ "encCBORAttributes: impossible: field no. " + <> show k + <> " is already encoded as unparsed field: " + <> show v' decCBORAttributes :: forall t s. diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/CBOR.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/CBOR.hs index d56597202cd..7d109287ba5 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/CBOR.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/CBOR.hs @@ -132,6 +132,6 @@ decodeCrcProtected = do . shown . " was not the computed one, which was " . shown - when (actualCrc /= expectedCrc) $ - cborError (sformat crcErrorFmt expectedCrc actualCrc) + when (actualCrc /= expectedCrc) + $ cborError (sformat crcErrorFmt expectedCrc actualCrc) toCborError $ decodeFull' byronProtVer body diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/Lovelace.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/Lovelace.hs index c8dd460954b..26b7b32e532 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/Lovelace.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/Lovelace.hs @@ -262,6 +262,6 @@ integerToLovelace :: Integer -> Either LovelaceError Lovelace integerToLovelace n | n < 0 = Left (LovelaceTooSmall n) | n <= lovelaceToInteger (maxBound :: Lovelace) = - Right $ - Lovelace (fromInteger n) + Right + $ Lovelace (fromInteger n) | otherwise = Left (LovelaceTooLarge n) diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/LovelacePortion.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/LovelacePortion.hs index 8085dcc6fb3..ad88ae70d47 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/LovelacePortion.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/LovelacePortion.hs @@ -79,8 +79,8 @@ instance EncCBOR LovelacePortion where instance DecCBOR LovelacePortion where decCBOR = do nominator <- decCBOR - when (nominator > lovelacePortionDenominator) $ - fail "LovelacePortion: value out of bounds [0..1e15]" + when (nominator > lovelacePortionDenominator) + $ fail "LovelacePortion: value out of bounds [0..1e15]" return (LovelacePortion nominator) -- The canonical JSON instance for LovelacePortion uses only the nominator in @@ -92,8 +92,8 @@ instance Monad m => ToJSON m LovelacePortion where instance MonadError SchemaError m => FromJSON m LovelacePortion where fromJSON val = do nominator <- fromJSON val - when (nominator > lovelacePortionDenominator) $ - throwError + when (nominator > lovelacePortionDenominator) + $ throwError SchemaError { seExpected = "LovelacePortion integer in bounds [0..1e15]" , seActual = Just (sformat build nominator) diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/Merkle.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/Merkle.hs index 81d1b631840..2090b011492 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/Merkle.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/Merkle.hs @@ -94,8 +94,10 @@ merkleRootToBuilder (MerkleRoot h) = byteString (hashToBytes h) mkRoot :: MerkleRoot a -> MerkleRoot a -> MerkleRoot a mkRoot a b = - MerkleRoot . hashRaw . toLazyByteString $ - mconcat + MerkleRoot + . hashRaw + . toLazyByteString + $ mconcat [word8 1, merkleRootToBuilder a, merkleRootToBuilder b] emptyHash :: MerkleRoot a @@ -219,8 +221,8 @@ mkLeaf a = MerkleLeaf mRoot a where mRoot :: MerkleRoot a mRoot = - MerkleRoot $ - hashRaw + MerkleRoot + $ hashRaw (toLazyByteString (word8 0 <> serializeBuilder byronProtVer a)) mkLeafDecoded :: Annotated a ByteString -> MerkleNode a diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/TxFeePolicy.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/TxFeePolicy.hs index f64924557df..c9d861bde8d 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/TxFeePolicy.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/TxFeePolicy.hs @@ -111,7 +111,9 @@ instance MonadError SchemaError m => FromJSON m TxFeePolicy where -- We div by 1e9 to keep compatibility with 'Nano' coefficients fromJSON obj = do summand <- - wrapLovelaceError . mkLovelace . (`div` 1e9) + wrapLovelaceError + . mkLovelace + . (`div` 1e9) =<< fromJSField obj "summand" diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/TxSizeLinear.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/TxSizeLinear.hs index 4c7a86cd710..7346084de68 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/TxSizeLinear.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/TxSizeLinear.hs @@ -84,7 +84,7 @@ calculateTxSizeLinear :: calculateTxSizeLinear (TxSizeLinear a b) sz = addLovelace a =<< flip scaleLovelaceRationalUp b - <$> integerToLovelace (fromIntegral sz) + <$> integerToLovelace (fromIntegral sz) txSizeLinearMinValue :: TxSizeLinear -> Lovelace txSizeLinearMinValue (TxSizeLinear a _) = a diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Certificate.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Certificate.hs index c005875baf8..f0ef1d5196d 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Certificate.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Certificate.hs @@ -129,8 +129,8 @@ signCertificate protocolMagicId delegateVK epochNumber safeSigner = } where sig = - safeSign protocolMagicId SignCertificate safeSigner $ - mconcat + safeSign protocolMagicId SignCertificate safeSigner + $ mconcat [ "00" , CC.unXPub (unVerificationKey delegateVK) , serialize' byronProtVer epochNumber diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Validation/Interface.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Validation/Interface.hs index 1c2193ae843..8b4220f8525 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Validation/Interface.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Validation/Interface.hs @@ -115,12 +115,12 @@ initialState env genesisDelegation = updateDelegation env' is certificates , activationState = Activation.State { Activation.delegationMap = - Delegation.fromList $ - zip (toList allowedDelegators) (toList allowedDelegators) + Delegation.fromList + $ zip (toList allowedDelegators) (toList allowedDelegators) , Activation.delegationSlots = - M.fromList $ - (,SlotNumber 0) - <$> toList allowedDelegators + M.fromList + $ (,SlotNumber 0) + <$> toList allowedDelegators } } @@ -160,8 +160,8 @@ updateDelegation env is certificates = do (schedulingState is) certificates - pure $ - tickDelegation + pure + $ tickDelegation currentEpoch currentSlot is {schedulingState = ss'} diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Validation/Scheduling.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Validation/Scheduling.hs index b6d51671648..41ea08ccd1d 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Validation/Scheduling.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Validation/Scheduling.hs @@ -207,8 +207,8 @@ scheduleCertificate env st cert = do Certificate.isValid protocolMagic cert `orThrowError` InvalidCertificate -- Schedule the new delegation and register the epoch/delegator pair - pure $ - State + pure + $ State { scheduledDelegations = scheduledDelegations |> delegation , keyEpochDelegations = Set.insert diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Epoch/File.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Epoch/File.hs index 240ad57ed7e..b599c2a0301 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Epoch/File.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Epoch/File.hs @@ -78,8 +78,8 @@ parseEpochFileWithBoundary :: () parseEpochFileWithBoundary epochSlots file = do s <- - S.mapM liftDecoderError $ - decodedWith (getSlotData epochSlots) (boundaryBytes <> bytes) + S.mapM liftDecoderError + $ decodedWith (getSlotData epochSlots) (boundaryBytes <> bytes) liftBinaryError s where boundaryBytes :: SBS.ByteStream (ExceptT ParseError ResIO) () @@ -128,8 +128,9 @@ getSlotData epochSlots = runExceptT $ do block <- do blockBytes <- lift $ B.getLazyByteString (fromIntegral blockSize) bb <- - ExceptT . pure $ - decodeFullDecoder + ExceptT + . pure + $ decodeFullDecoder byronProtVer "ABlockOrBoundary" (decCBORABlockOrBoundary epochSlots) diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Epoch/Validation.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Epoch/Validation.hs index 9d2f17e2da2..2abb8326a7d 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Epoch/Validation.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Epoch/Validation.hs @@ -46,7 +46,7 @@ data EpochError -- tracing is orthogonal to throwing errors; it does not change the program flow. validateEpochFile :: forall m. - (MonadIO m) => + MonadIO m => Tracer m EpochError -> ValidationMode -> Genesis.Config -> @@ -55,11 +55,11 @@ validateEpochFile :: m ChainValidationState validateEpochFile tr vMode config cvs fp = do res <- - liftIO $ - runResourceT $ - (`runReaderT` vMode) $ - runExceptT $ - foldChainValidationState config cvs stream + liftIO + $ runResourceT + $ (`runReaderT` vMode) + $ runExceptT + $ foldChainValidationState config cvs stream case res of Left e -> traceWith tr e >> pure cvs @@ -75,10 +75,10 @@ validateEpochFiles :: [FilePath] -> IO (Either EpochError ChainValidationState) validateEpochFiles vMode config cvs fps = - runResourceT $ - (`runReaderT` vMode) $ - runExceptT - (foldChainValidationState config cvs stream) + runResourceT + $ (`runReaderT` vMode) + $ runExceptT + (foldChainValidationState config cvs stream) where stream = parseEpochFilesWithBoundary mainnetEpochSlots fps @@ -91,8 +91,8 @@ foldChainValidationState :: foldChainValidationState config chainValState blocks = S.foldM_ ( \cvs block -> - withExceptT (EpochChainValidationError (blockOrBoundarySlot block)) $ - updateChainBlockOrBoundary config cvs block + withExceptT (EpochChainValidationError (blockOrBoundarySlot block)) + $ updateChainBlockOrBoundary config cvs block ) (pure chainValState) pure diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Genesis/Config.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Genesis/Config.hs index b3d1454c2b5..b196afa3a07 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Genesis/Config.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Genesis/Config.hs @@ -151,8 +151,8 @@ mkConfigFromFile rnm fp expectedHash = do (unGenesisHash genesisHash == expectedHash) `orThrowError` GenesisHashMismatch genesisHash expectedHash - pure $ - Config + pure + $ Config { configGenesisData = genesisData , configGenesisHash = genesisHash , configReqNetMagic = rnm diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Genesis/Generate.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Genesis/Generate.hs index b595467e9de..14142b26b64 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Genesis/Generate.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Genesis/Generate.hs @@ -173,8 +173,8 @@ generateGenesisData :: generateGenesisData startTime genesisSpec = -- Use a sensible choice of random entropy for key generation, which then -- requires that the whole thing is actually in IO. - mapExceptT Crypto.runSecureRandom $ - generateGenesisDataWithEntropy startTime genesisSpec + mapExceptT Crypto.runSecureRandom + $ generateGenesisDataWithEntropy startTime genesisSpec -- | A version of 'generateGenesisData' parametrised over 'Crypto.MonadRandom'. -- For testing purposes this allows using a completely pure deterministic @@ -206,8 +206,8 @@ generateGenesisDataWithEntropy startTime genesisSpec = do GenesisKeyHashes . Set.fromList $ hashKey - . toVerification - <$> genesisSecrets + . toVerification + <$> genesisSecrets -- Heavyweight delegation. -- genesisDlgList is empty if giUseHeavyDlg = False @@ -248,8 +248,9 @@ generateGenesisDataWithEntropy startTime genesisSpec = do (toCompactRedeemVerificationKey . redeemToVerification) (gsFakeAvvmSecrets generatedSecrets) fakeAvvmDistr = - GenesisAvvmBalances . M.fromList $ - map + GenesisAvvmBalances + . M.fromList + $ map (,faoOneBalance fao) fakeAvvmVerificationKeys @@ -285,8 +286,8 @@ generateGenesisDataWithEntropy startTime genesisSpec = do safeZip s a b = if length a /= length b then - throwError $ - GenesisDataAddressBalanceMismatch s (length a) (length b) + throwError + $ GenesisDataAddressBalanceMismatch s (length a) (length b) else pure $ zip a b nonAvvmBalance <- @@ -335,8 +336,8 @@ generateSecrets gi = do poorSecrets <- replicateM (fromIntegral $ tboPoors tbo) genPoorSecret - pure $ - GeneratedSecrets + pure + $ GeneratedSecrets { gsDlgIssuersSecrets = dlgIssuersSecrets , gsRichSecrets = richSecrets , gsPoorSecrets = poorSecrets @@ -365,8 +366,8 @@ generateGenesisConfig :: generateGenesisConfig startTime genesisSpec = -- Use a sensible choice of random entropy for key generation, which then -- requires that the whole thing is actually in IO. - mapExceptT Crypto.runSecureRandom $ - generateGenesisConfigWithEntropy startTime genesisSpec + mapExceptT Crypto.runSecureRandom + $ generateGenesisConfigWithEntropy startTime genesisSpec -- | A version of 'generateGenesisConfig' parametrised over 'Crypto.MonadRandom'. -- For testing purposes this allows using a completely pure deterministic @@ -445,8 +446,8 @@ genTestnetDistribution tbo testBalance = do if totalBalance <= testBalance then pure (richBalances, poorBalances) else - throwError $ - GenesisDataGenerationDistributionMismatch testBalance totalBalance + throwError + $ GenesisDataGenerationDistributionMismatch testBalance totalBalance where TestnetBalanceOptions {tboPoors, tboRichmen} = tbo diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/EpochAndSlotCount.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/EpochAndSlotCount.hs index 65a654d26b0..cc1a2c18a3b 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/EpochAndSlotCount.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/EpochAndSlotCount.hs @@ -85,9 +85,9 @@ flattenEpochNumber es (EpochNumber i) = SlotNumber $ i * unEpochSlots es fromSlotNumber :: EpochSlots -> SlotNumber -> EpochAndSlotCount fromSlotNumber (EpochSlots n) (SlotNumber fsId) | n == 0 = - panic $ - "'unflattenEpochAndSlotCount': The number of slots-per-epoch " - <> "passed to this function must be positive" + panic + $ "'unflattenEpochAndSlotCount': The number of slots-per-epoch " + <> "passed to this function must be positive" | otherwise = EpochAndSlotCount { epochNo = EpochNumber epoch diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxWitness.hs b/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxWitness.hs index 59099e57dca..d03c4345c5a 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxWitness.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxWitness.hs @@ -111,9 +111,9 @@ instance EncCBOR TxInWitness where ( map (fmap knownCborDataItemSizeExpr) [ Case "VKWitness" $ size $ Proxy @(VerificationKey, TxSig) - , Case "RedeemWitness" $ - size $ - Proxy @(RedeemVerificationKey, RedeemSignature TxSigData) + , Case "RedeemWitness" + $ size + $ Proxy @(RedeemVerificationKey, RedeemSignature TxSigData) ] ) diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/UTxO.hs b/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/UTxO.hs index 96f0ca3aba7..7fa219c1d43 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/UTxO.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/UTxO.hs @@ -176,8 +176,8 @@ balance = sumLovelace . fmap compactTxOutValue . M.elems . unUTxO txOutputUTxO :: Tx -> UTxO txOutputUTxO tx = - UTxO $ - M.fromList + UTxO + $ M.fromList [ (toCompactTxIn (TxInUtxo (txId tx) ix), (toCompactTxOut txOut)) | (ix, txOut) <- indexedOutputs ] diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Update/ApplicationName.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Update/ApplicationName.hs index 2d3799de922..7547ad921e5 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Update/ApplicationName.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Update/ApplicationName.hs @@ -114,8 +114,8 @@ checkApplicationName :: MonadError ApplicationNameError m => ApplicationName -> m () checkApplicationName (ApplicationName appName) | T.length appName > applicationNameMaxLength = - throwError $ - ApplicationNameTooLong appName + throwError + $ ApplicationNameTooLong appName | T.any (not . isAscii) appName = throwError $ ApplicationNameNotAscii appName | otherwise = pure () diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Endorsement.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Endorsement.hs index d144151f921..bb633ec83cc 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Endorsement.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Endorsement.hs @@ -171,8 +171,8 @@ register env st endorsement = } cpus' = updateCandidateProtocolUpdates candidateProtocolVersions cpu - pure $ - State + pure + $ State { candidateProtocolVersions = cpus' , registeredEndorsements = registeredEndorsements' } @@ -199,8 +199,8 @@ register env st endorsement = numberOfEndorsements :: Int numberOfEndorsements = - length $ - Set.filter + length + $ Set.filter ((== pv) . endorsementProtocolVersion) registeredEndorsements' diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Interface.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Interface.hs index 1c5b9435bd2..80091b23883 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Interface.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Interface.hs @@ -268,8 +268,8 @@ registerProposal env st proposal = do Registration.State registeredProtocolUpdateProposals' registeredSoftwareUpdateProposals' <- Registration.registerProposal subEnv subSt proposal `wrapError` Registration - pure $! - st + pure + $! st { registeredProtocolUpdateProposals = registeredProtocolUpdateProposals' , registeredSoftwareUpdateProposals = registeredSoftwareUpdateProposals' , proposalRegistrationSlot = @@ -336,15 +336,15 @@ registerVotes env st votes = do registeredSoftwareUpdateProposals (M.keysSet confirmedProposals) appVersions' = - M.fromList $ - [ (svAppName sv, av) - | (pid, sup) <- M.toList registeredSoftwareUpdateProposals - , pid `elem` M.keys confirmedApplicationUpdates - , let Registration.SoftwareUpdateProposal sv metadata = sup - av = Registration.ApplicationVersion (svNumber sv) currentSlot metadata - ] - pure $ - st' -- Note that it's important that the new application versions are passed + M.fromList + $ [ (svAppName sv, av) + | (pid, sup) <- M.toList registeredSoftwareUpdateProposals + , pid `elem` M.keys confirmedApplicationUpdates + , let Registration.SoftwareUpdateProposal sv metadata = sup + av = Registration.ApplicationVersion (svNumber sv) currentSlot metadata + ] + pure + $ st' -- Note that it's important that the new application versions are passed -- as the first argument of @M.union@, since the values in this first -- argument overwrite the values in the second. { appVersions = M.union appVersions' appVersions @@ -368,8 +368,8 @@ registerVote env st vote = do Voting.State proposalVotes' confirmedProposals' <- Voting.registerVoteWithConfirmation protocolMagic subEnv subSt vote `wrapError` Voting - pure $! - st + pure + $! st { confirmedProposals = confirmedProposals' , proposalVotes = proposalVotes' } @@ -427,12 +427,12 @@ registerEndorsement env st endorsement = do M.restrictKeys registeredProtocolUpdateProposals pidsKeep vsKeep = - S.fromList $ - Registration.pupProtocolVersion - <$> M.elems registeredProtocolUpdateProposals' + S.fromList + $ Registration.pupProtocolVersion + <$> M.elems registeredProtocolUpdateProposals' - pure $! - st + pure + $! st { candidateProtocolUpdates = forceElemsToWHNF candidateProtocolUpdates' , registeredProtocolUpdateProposals = registeredProtocolUpdateProposals' , registeredSoftwareUpdateProposals = diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Registration.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Registration.hs index b88e031e2d1..792f29bb787 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Registration.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Registration.hs @@ -400,8 +400,8 @@ registerProposalComponents env rs proposal = do SoftwareVersion appName appVersion = softwareVersion softwareVersionChanged = - maybe True ((/= appVersion) . avNumSoftwareVersion) $ - M.lookup appName appVersions + maybe True ((/= appVersion) . avNumSoftwareVersion) + $ M.lookup appName appVersions protocolVersionChanged = not $ protocolVersion == adoptedPV && PPU.apply ppu adoptedPP == adoptedPP @@ -440,9 +440,12 @@ registerProposalComponents env rs proposal = do -- this non-public testing network. -- nullUpdateExemptions = - unAnnotated protocolMagic == ProtocolMagicId 633343913 -- staging - && ( currentSlot == SlotNumber 969188 -- in epoch 44 - || currentSlot == SlotNumber 1915231 -- in epoch 88 + unAnnotated protocolMagic + == ProtocolMagicId 633343913 -- staging + && ( currentSlot + == SlotNumber 969188 -- in epoch 44 + || currentSlot + == SlotNumber 1915231 -- in epoch 88 ) -- | Validate a protocol update @@ -472,8 +475,8 @@ registerProtocolUpdate adoptedPV adoptedPP registeredPUPs proposal = do canUpdate adoptedPP newPP proposal - pure $ - M.insert + pure + $ M.insert (recoverUpId proposal) (ProtocolUpdateProposal newPV newPP) registeredPUPs @@ -573,8 +576,8 @@ registerSoftwareUpdate appVersions registeredSUPs proposal = do `orThrowError` InvalidSoftwareVersion appVersions softwareVersion -- Add to the list of registered software update proposals - pure $ - M.insert + pure + $ M.insert (recoverUpId proposal) (SoftwareUpdateProposal softwareVersion metadata) registeredSUPs diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Voting.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Voting.hs index 2d93cf52d55..f4a85107cd5 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Voting.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Voting.hs @@ -142,8 +142,8 @@ registerVoteWithConfirmation pm votingEnv vs vote = do else confirmedProposals -- Return the new state with additional vote and maybe confirmation - pure $ - State + pure + $ State { vsVotes = votes' , vsConfirmedProposals = confirmedProposals' } diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/Model.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/Model.hs index 7bd4023bc56..c97f6078783 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/Model.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/Model.hs @@ -141,14 +141,15 @@ tests = $$discoverPropArg -- after being elaborated must be validated by the concrete block validator. ts_prop_generatedChainsAreValidated :: TSProperty ts_prop_generatedChainsAreValidated = - withTestsTS 300 $ - property $ do + withTestsTS 300 + $ property + $ do let (traceLength, step) = (200 :: Word64, 10 :: Word64) tr <- forAll $ trace @CHAIN () traceLength classifyTraceLength tr traceLength step - classifyBlockStats $ - Abstract.chainBlockStats $ - map Abstract.blockStats (traceSignals OldestFirst tr) + classifyBlockStats + $ Abstract.chainBlockStats + $ map Abstract.blockStats (traceSignals OldestFirst tr) printAdditionalInfoOnFailure tr passConcreteValidation tr where @@ -242,9 +243,9 @@ elaborateBlock abstractState where stableAfter = - AbstractCore.BlockCount $ - unBlockCount $ - Genesis.configK config + AbstractCore.BlockCount + $ unBlockCount + $ Genesis.configK config classifyTransactions :: Trace CHAIN -> PropertyT IO () classifyTransactions = @@ -275,8 +276,9 @@ invalidChainTracesAreRejected :: ([PredicateFailure CHAIN] -> ChainValidationError -> PropertyT IO ()) -> TSProperty invalidChainTracesAreRejected numberOfTests failureProfile onFailureAgreement = - withTestsTS numberOfTests $ - property $ do + withTestsTS numberOfTests + $ property + $ do let traceLength = 100 :: Word64 tr <- forAll $ invalidTrace @CHAIN () traceLength failureProfile let ValidationOutput {elaboratedConfig, result} = @@ -327,10 +329,10 @@ mkUpiEnv block env st = (blockSlot, _dIStateDelegationMap delegSt, k, ngk) numberOfDelegators = Set.size allowedDelegators ngk | fromIntegral (maxBound :: Word8) < numberOfDelegators = - panic $ - "ts_prop_invalidDelegationSignalsAreRejected: " - <> "too many genesis keys: " - <> show numberOfDelegators + panic + $ "ts_prop_invalidDelegationSignalsAreRejected: " + <> "too many genesis keys: " + <> show numberOfDelegators | otherwise = fromIntegral numberOfDelegators -- | Extract the update state from the given chain state. @@ -362,8 +364,8 @@ applyTrace tr = ValidationOutput { elaboratedConfig = config , result = - foldM (elaborateAndUpdate config) (initialState, initialAbstractToConcreteIdMaps) $ - preStatesAndSignals OldestFirst tr + foldM (elaborateAndUpdate config) (initialState, initialAbstractToConcreteIdMaps) + $ preStatesAndSignals OldestFirst tr } where initialState = initialStateNoUTxO {cvsUtxo = initialUTxO} @@ -398,11 +400,11 @@ ts_prop_invalidHeaderSizesAreRejected = ChainValidationError -> PropertyT IO () checkMaxSizeFailure abstractPfs ChainValidationHeaderTooLarge {} = do - assert $ - any isHeaderSizeTooBigFailure abstractPfs - footnote $ - "HeaderSizeTooBig not found in the abstract predicate failures: " - ++ show abstractPfs + assert + $ any isHeaderSizeTooBigFailure abstractPfs + footnote + $ "HeaderSizeTooBig not found in the abstract predicate failures: " + ++ show abstractPfs checkMaxSizeFailure _ concretePF = do footnote $ "Expected 'ChainValidationHeaderTooLarge' error, got " ++ show concretePF failure @@ -428,8 +430,9 @@ invalidSizesAreRejected setConcreteParamTo concreteBlockComponentSize checkFailures = - withTestsTS 300 $ - property $ do + withTestsTS 300 + $ property + $ do tr <- forAll $ trace @CHAIN () 100 `ofLengthAtLeast` 1 let ValidationOutput {elaboratedConfig, result} = applyTrace initTr @@ -509,17 +512,17 @@ invalidSizesAreRejected where genAlteredUpdateState ((pv, pps), fads, avs, rpus, raus, cps, vts, bvs, pws) = do newMaxSize <- Gen.integral (Range.constant 0 maxSize) - pure $! - ( (pv, pps `setAbstractParamTo` newMaxSize) - , fads - , avs - , rpus - , raus - , cps - , vts - , bvs - , pws - ) + pure + $! ( (pv, pps `setAbstractParamTo` newMaxSize) + , fads + , avs + , rpus + , raus + , cps + , vts + , bvs + , pws + ) genConcreteAlteredState :: ChainValidationState -> Natural -> Gen ChainValidationState @@ -549,12 +552,12 @@ ts_prop_invalidBlockSizesAreRejected = ChainValidationError -> PropertyT IO () checkMaxSizeFailure abstractPfs ChainValidationBlockTooLarge {} = do - assert $ - any (== InvalidBlockSize) $ - extractValues abstractPfs - footnote $ - "InvalidBlockSize not found in the abstract predicate failures: " - ++ show abstractPfs + assert + $ any (== InvalidBlockSize) + $ extractValues abstractPfs + footnote + $ "InvalidBlockSize not found in the abstract predicate failures: " + ++ show abstractPfs checkMaxSizeFailure _ concretePF = do footnote $ "Expected 'ChainValidationBlockTooLarge' error, got " ++ show concretePF failure diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/Size.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/Size.hs index 2cda2dcf62b..873224275a2 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/Size.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/Size.hs @@ -39,15 +39,15 @@ encodedSizeTest encode encodedSize gen = eachOfTS let size :: Natural size = fromIntegral $ BS.length (serialize' byronProtVer (encode a)) in if - | size < lo -> do - footnote $ "actual size not greater or equal the minimal size: " ++ show size ++ " ≱ " ++ show lo - failure - | size > hi -> do - footnote $ "actual size not smaller or equal the maximal size: " ++ show size ++ " ≰ " ++ show hi - failure - | otherwise -> do - label (classifySize rng size) - success + | size < lo -> do + footnote $ "actual size not greater or equal the minimal size: " ++ show size ++ " ≱ " ++ show lo + failure + | size > hi -> do + footnote $ "actual size not smaller or equal the maximal size: " ++ show size ++ " ≰ " ++ show hi + failure + | otherwise -> do + label (classifySize rng size) + success Left _ -> do footnote "a thunk in size expression" failure diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/Validation.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/Validation.hs index fab9de89e90..fd96138a5c4 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/Validation.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/Validation.hs @@ -129,9 +129,9 @@ foldChainValidationState shouldAssertNF config cvs blocks = isNF <- liftIO $ isNormalForm $! c unless isNF - ( panic $ - "ChainValidationState not in normal form at slot: " - <> show (cvsLastSlot c) + ( panic + $ "ChainValidationState not in normal form at slot: " + <> show (cvsLastSlot c) ) NoAssertNF -> pure () updateChainBoundary c bvd diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/ValidationMode.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/ValidationMode.hs index f975d59571f..5f7e7ed1c44 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/ValidationMode.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Block/ValidationMode.hs @@ -87,8 +87,8 @@ ts_prop_updateBlock_Valid = , stableAfter ) = Trace._traceEnv sampleTrace abstractBlock <- - forAll $ - Abstract.sigGenChain + forAll + $ Abstract.sigGenChain Abstract.NoGenDelegation Abstract.NoGenUTxO Abstract.NoGenUpdate @@ -112,8 +112,9 @@ ts_prop_updateBlock_Valid = abstractBlock annotateShow concreteBlock updateRes <- - (`runReaderT` vMode) . runExceptT $ - updateBlock config cvs concreteBlock + (`runReaderT` vMode) + . runExceptT + $ updateBlock config cvs concreteBlock case updateRes of Left _ -> failure Right _ -> success @@ -131,8 +132,8 @@ ts_prop_updateBlock_InvalidProof = let chainEnv@(_, abstractInitialUTxO, _, _, stableAfter) = Trace._traceEnv sampleTrace lastState = Trace.lastState sampleTrace abstractBlock <- - forAll $ - Abstract.sigGenChain + forAll + $ Abstract.sigGenChain Abstract.NoGenDelegation Abstract.NoGenUTxO Abstract.NoGenUpdate @@ -154,8 +155,9 @@ ts_prop_updateBlock_InvalidProof = annotateShow concreteBlock invalidBlock <- forAll $ invalidateABlockProof concreteBlock updateRes <- - (`runReaderT` vMode) . runExceptT $ - updateBlock config cvs invalidBlock + (`runReaderT` vMode) + . runExceptT + $ updateBlock config cvs invalidBlock case updateRes of Left _ -> if (blockValidationMode vMode) == BlockValidation @@ -196,8 +198,8 @@ createInitialDState :: createInitialDState env = DState { _dStateDelegationMap = - BM.fromList $ - map + BM.fromList + $ map (\vkg@(Abstract.VKeyGenesis key) -> (vkg, key)) (S.toList env) , _dStateLastDelegation = M.fromSet (const (Abstract.Slot 0)) env @@ -278,8 +280,8 @@ invalidateABlockProof ab = [ pure $ proofUpdate (blockProof ab) , feedPM Update.genProof ] - pure $ - modifyAProof + pure + $ modifyAProof ( \(Annotated p bs) -> Annotated ( p diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Byron/API.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Byron/API.hs index 17f263cfdab..a1431b4b5ba 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Byron/API.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Byron/API.hs @@ -110,8 +110,8 @@ setupChainValidationState sampleTrace = initialStateNoUTxO = either (panic . show) identity $ initialChainValidationState config initialState = initialStateNoUTxO {cvsUtxo = initialUTxO} (cvs, abstractToConcreteIdMaps) = - either (panic . show) identity $ - foldM + either (panic . show) identity + $ foldM (elaborateAndUpdate config) (initialState, initialAbstractToConcreteIdMaps) (STS.preStatesAndSignals STS.OldestFirst sampleTrace) @@ -192,7 +192,7 @@ ts_mempoolValidation = withTestsTS 100 . property $ do vote' = elaborateVote pm upIdMap' <$> vote in addAnnotation <$> [MempoolUpdateProposal up'] - <> (MempoolUpdateVote <$> vote') + <> (MempoolUpdateVote <$> vote') let mempoolPayloads = [mempoolTx] diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/CBOR.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/CBOR.hs index b3e291cf9c6..2a9f0c7f6ba 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/CBOR.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/CBOR.hs @@ -325,32 +325,32 @@ sizeEstimates = , ("BlockCount", check genBlockCount) , ( "Attributes ()" - , sizeTest $ - scfg + , sizeTest + $ scfg { gen = genAttributes (pure ()) , addlCtx = M.fromList [attrUnitSize] } ) , ( "Attributes AddrAttributes" - , sizeTest $ - scfg + , sizeTest + $ scfg { gen = genAttributes genAddrAttributes , addlCtx = M.fromList [attrAddrSize] } ) , ( "Address" - , sizeTest $ - scfg + , sizeTest + $ scfg { gen = genAddress , addlCtx = M.fromList [attrAddrSize] } ) , ( "AddrSpendingData" - , sizeTest $ - scfg + , sizeTest + $ scfg { gen = genAddrSpendingData , addlCtx = M.fromList diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/Compact.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/Compact.hs index d15bcc50ed8..6168c1f0b78 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/Compact.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/Compact.hs @@ -24,8 +24,9 @@ ts_roundTripCompactAddress = eachOfTS 1000 genAddress (trippingCompact toCompactAddress fromCompactAddress) ts_prop_heapWordsSavingsCompactAddress :: TSProperty -ts_prop_heapWordsSavingsCompactAddress = withTestsTS 1000 $ - property $ do +ts_prop_heapWordsSavingsCompactAddress = withTestsTS 1000 + $ property + $ do addr <- forAll genAddress let compactAddr = toCompactAddress addr assert $ heapWords compactAddr < heapWords addr diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/Gen.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/Gen.hs index 8a66367cae9..1a1c4476dc3 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/Gen.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/Gen.hs @@ -113,8 +113,8 @@ genCanonicalTxSizeLinear = TxSizeLinear <$> genLovelace' <*> genMultiplier >>= \case Right lovelace -> pure lovelace Left err -> - panic $ - sformat + panic + $ sformat ("The impossible happened in genLovelace: " . build) err diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/Lovelace.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/Lovelace.hs index 3e00bb57ca8..ae0a7a4c25d 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/Lovelace.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Common/Lovelace.hs @@ -39,8 +39,8 @@ ts_prop_addLovelace = withTestsTS 1000 . property $ do prop_addLovelaceOverflow :: Property prop_addLovelaceOverflow = - property $ - assertIsLeftConstr + property + $ assertIsLeftConstr dummyLovelaceOverflow (addLovelace (mkKnownLovelace @1) maxBound) @@ -53,15 +53,15 @@ ts_prop_integerToLovelace = withTestsTS 1000 . property $ do prop_integerToLovelaceTooLarge :: Property prop_integerToLovelaceTooLarge = - property $ - assertIsLeftConstr + property + $ assertIsLeftConstr dummyLovelaceTooLarge (integerToLovelace (fromIntegral (maxLovelaceVal + 1) :: Integer)) prop_integerToLovelaceTooSmall :: Property prop_integerToLovelaceTooSmall = - property $ - assertIsLeftConstr dummyLovelaceTooSmall (integerToLovelace (negate 1)) + property + $ assertIsLeftConstr dummyLovelaceTooSmall (integerToLovelace (negate 1)) prop_maxLovelaceUnchanged :: Property prop_maxLovelaceUnchanged = @@ -74,13 +74,13 @@ ts_prop_mkLovelace = withTestsTS 1000 . property $ do prop_mkLovelaceTooLarge :: Property prop_mkLovelaceTooLarge = - property $ - assertIsLeftConstr dummyLovelaceTooLarge (mkLovelace (maxLovelaceVal + 1)) + property + $ assertIsLeftConstr dummyLovelaceTooLarge (mkLovelace (maxLovelaceVal + 1)) prop_scaleLovelaceTooLarge :: Property prop_scaleLovelaceTooLarge = - property $ - assertIsLeftConstr + property + $ assertIsLeftConstr dummyLovelaceTooLarge (scaleLovelace maxBound (2 :: Integer)) @@ -102,8 +102,8 @@ ts_prop_subLovelaceUnderflow = Right added -> assertIsLeftConstr dummyLovelaceUnderflow (subLovelace a added) Left err -> - panic $ - sformat + panic + $ sformat ("The impossible happened in subLovelaceUnderflow: " . build) err diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Delegation/Certificate.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Delegation/Certificate.hs index 2b0fc53a90d..d616d5fec68 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Delegation/Certificate.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Delegation/Certificate.hs @@ -36,11 +36,11 @@ tests = $$discover prop_certificateCorrect :: Property prop_certificateCorrect = property $ do cert <- - forAll $ - signCertificate Dummy.protocolMagicId - <$> genVerificationKey - <*> genEpochNumber - <*> genSafeSigner + forAll + $ signCertificate Dummy.protocolMagicId + <$> genVerificationKey + <*> genEpochNumber + <*> genSafeSigner let aCert = annotateCert cert @@ -50,11 +50,11 @@ prop_certificateCorrect = property $ do prop_certificateIncorrect :: Property prop_certificateIncorrect = property $ do cert <- - forAll $ - signCertificate Dummy.protocolMagicId - <$> genVerificationKey - <*> genEpochNumber - <*> genSafeSigner + forAll + $ signCertificate Dummy.protocolMagicId + <$> genVerificationKey + <*> genEpochNumber + <*> genSafeSigner badDelegateVK <- forAll $ Gen.filter (/= delegateVK cert) genVerificationKey let badCert = cert {delegateVK = badDelegateVK} diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Delegation/Model.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Delegation/Model.hs index fb23d2e2839..912ad9d8828 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Delegation/Model.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Delegation/Model.hs @@ -39,8 +39,8 @@ prop_commandSDELEG = withTests 25 . property $ do abstractEnv <- forAll $ STS.envGen @DELEG traceLength actions <- - forAll $ - Gen.sequential + forAll + $ Gen.sequential (Range.linear 1 (fromIntegral traceLength)) initialState [commandSDELEG concreteRef abstractEnv] @@ -95,8 +95,9 @@ commandSDELEG concreteRef abstractEnv = Command gen execute callbacks where gen :: StateSDELEG v -> Maybe (Gen (SignalSDELEG v)) gen st = - Just $ - SignalSDELEG <$> do + Just + $ SignalSDELEG + <$> do mDCert <- Abstract.dcertGen abstractEnv keyEpochDelegations case mDCert of Nothing -> mzero diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/Block.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/Block.hs index 58eade51b2b..bb3f096460e 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/Block.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/Block.hs @@ -155,8 +155,8 @@ elaborate abstractToConcreteIdMaps config dCert st abstractBlock = ) (txPayload, txIdMap') = - first (fmap void) $ - elaborateTxWitnesses + first (fmap void) + $ elaborateTxWitnesses txIdMap (abstractBlock ^. Abstract.bBody . Abstract.bUtxo) @@ -164,16 +164,16 @@ elaborate abstractToConcreteIdMaps config dCert st abstractBlock = updatePayload = Update.APayload (fmap snd maybeProposals) - ( fmap (elaborateVote pm proposalsIdMap') $ - Abstract._bUpdVotes $ - Abstract._bBody abstractBlock + ( fmap (elaborateVote pm proposalsIdMap') + $ Abstract._bUpdVotes + $ Abstract._bBody abstractBlock ) () -- Update payload annotation maybeProposals :: Maybe (Abstract.Update.UProp, Update.Proposal) maybeProposals = - fmap (identity &&& elaborateUpdateProposal pm) $ - Abstract._bUpdProp $ - Abstract._bBody abstractBlock + fmap (identity &&& elaborateUpdateProposal pm) + $ Abstract._bUpdProp + $ Abstract._bBody abstractBlock proposalsIdMap' :: Map Abstract.Update.UpId Update.UpId proposalsIdMap' = maybe proposalsIdMap addUpdateProposalId maybeProposals @@ -234,8 +234,8 @@ elaborateBS :: Abstract.Block -> (Concrete.ABlock ByteString, AbstractToConcreteIdMaps) elaborateBS txIdMap config dCert st ab = - first (annotateBlock (Genesis.configEpochSlots config)) $ - elaborate txIdMap config dCert st ab + first (annotateBlock (Genesis.configEpochSlots config)) + $ elaborate txIdMap config dCert st ab annotateBlock :: Slotting.EpochSlots -> Concrete.Block -> Concrete.ABlock ByteString annotateBlock epochSlots block = @@ -246,10 +246,10 @@ annotateBlock epochSlots block = (Concrete.decCBORABlockOrBoundary epochSlots) bytes of Left err -> - panic $ - "This function should be able to decode the block it encoded" - <> ". Instead I got: " - <> show err + panic + $ "This function should be able to decode the block it encoded" + <> ". Instead I got: " + <> show err Right abobb -> map (LBS.toStrict . Binary.slice bytes) abobb in case decodedABlockOrBoundary of Concrete.ABOBBlock bk -> bk diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/Delegation.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/Delegation.hs index 775c92807c2..9cb2e26eb25 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/Delegation.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/Delegation.hs @@ -69,8 +69,8 @@ ts_prop_elaboratedCertsValid = -- large portion of 'Nothing'. Just cert -> let concreteCert = elaborateDCertAnnotated pm cert - in assert $ - Concrete.Certificate.isValid (Annotated pm (serialize' byronProtVer pm)) concreteCert + in assert + $ Concrete.Certificate.isValid (Annotated pm (serialize' byronProtVer pm)) concreteCert where env = DSEnv @@ -118,10 +118,10 @@ elaborateDSEnv abstractEnv = Scheduling.Environment { Scheduling.protocolMagic = Dummy.annotatedProtocolMagicId , Scheduling.allowedDelegators = - Set.fromList $ - hashKey - . elaborateVKeyGenesis - <$> Set.toList genesisKeys + Set.fromList + $ hashKey + . elaborateVKeyGenesis + <$> Set.toList genesisKeys , Scheduling.currentEpoch = fromIntegral e , Scheduling.currentSlot = Concrete.SlotNumber s , Scheduling.k = Concrete.BlockCount k diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/UTxO.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/UTxO.hs index af30d5f8e98..c83d031b684 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/UTxO.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/UTxO.hs @@ -40,8 +40,8 @@ elaborateUTxOEnv _abstractEnv = , Concrete.UTxO.protocolParameters = dummyProtocolParameters { Concrete.ppTxFeePolicy = - Concrete.TxFeePolicyTxSizeLinear $ - Concrete.TxSizeLinear + Concrete.TxFeePolicyTxSizeLinear + $ Concrete.TxSizeLinear (Concrete.mkKnownLovelace @0) 0 } diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/Update.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/Update.hs index e282595f5fa..7de0c54e1bc 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/Update.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Elaboration/Update.hs @@ -43,17 +43,17 @@ elaboratePParams pps = , Concrete.ppUpdateVoteThd = Concrete.rationalToLovelacePortion 0 , Concrete.ppUpdateProposalThd = Concrete.rationalToLovelacePortion 0 , Concrete.ppUpdateProposalTTL = - Concrete.SlotNumber $ - unSlotCount $ - Abstract._upTtl pps + Concrete.SlotNumber + $ unSlotCount + $ Abstract._upTtl pps , Concrete.ppSoftforkRule = Concrete.SoftforkRule { Concrete.srInitThd = Concrete.rationalToLovelacePortion 0 , -- See 'upAdptThd' in 'module Cardano.Chain.Update.ProtocolParameters' Concrete.srMinThd = - Concrete.rationalToLovelacePortion $ - realToFrac $ - Abstract._upAdptThd pps + Concrete.rationalToLovelacePortion + $ realToFrac + $ Abstract._upAdptThd pps , Concrete.srThdDecrement = Concrete.rationalToLovelacePortion 0 } , Concrete.ppTxFeePolicy = @@ -116,9 +116,9 @@ elaborateUpdateProposal protocolMagicId abstractProposal = issuer = elaborateVKey $ Abstract._upIssuer abstractProposal signer = signatureVKey $ Abstract._upSig abstractProposal signedProposalBody = - elaborateUpSD $ - signatureData $ - Abstract._upSig abstractProposal + elaborateUpSD + $ signatureData + $ Abstract._upSig abstractProposal -- To elaborate the signature, we extract the signer and the (abstract) -- data that was signed from the signature of the abstract proposal. We -- cannot simply sign the concrete proposal data, since the abstract signed @@ -209,9 +209,9 @@ elaborateVote protocolMagicId proposalsIdMap abstractVote = True -- We assume the decision to be always constant safeSigner signedUpId = - elaborateProposalId proposalsIdMap $ - signatureData $ - Abstract._vSig abstractVote + elaborateProposalId proposalsIdMap + $ signatureData + $ Abstract._vSig abstractVote safeSigner = vKeyToSafeSigner $ signatureVKey $ Abstract._vSig abstractVote diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Epoch/File.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Epoch/File.hs index e268773b439..4c90204cba1 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Epoch/File.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Epoch/File.hs @@ -19,8 +19,9 @@ tests :: Group tests = $$discover prop_deserializeEpochs :: Property -prop_deserializeEpochs = H.withTests 1 $ - H.property $ do +prop_deserializeEpochs = H.withTests 1 + $ H.property + $ do menv <- liftIO $ lookupEnv "CARDANO_MAINNET_MIRROR" H.assert $ isJust menv diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Genesis/Dummy.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Genesis/Dummy.hs index 6f90306b504..1f39638a517 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Genesis/Dummy.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Genesis/Dummy.hs @@ -56,10 +56,10 @@ import qualified Test.Cardano.Crypto.Dummy as Dummy dummyConfig :: Config dummyGeneratedSecrets :: GeneratedSecrets (dummyConfig, dummyGeneratedSecrets) = - either (panic . show) identity $ - Crypto.deterministic seed $ -- supply fake entropy to make this pure - runExceptT $ - generateGenesisConfigWithEntropy startTime dummyGenesisSpec + either (panic . show) identity + $ Crypto.deterministic seed + $ runExceptT -- supply fake entropy to make this pure + $ generateGenesisConfigWithEntropy startTime dummyGenesisSpec where seed :: ByteString seed = "\0" diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Genesis/Example.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Genesis/Example.hs index 2c16937aebd..1771a29de1d 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Genesis/Example.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Genesis/Example.hs @@ -72,16 +72,16 @@ exampleGenesisSpec = exampleGenesisAvvmBalances :: GenesisAvvmBalances exampleGenesisAvvmBalances = - GenesisAvvmBalances $ - M.fromList + GenesisAvvmBalances + $ M.fromList [ (exampleCompactRVK' (0, 32), mkKnownLovelace @36524597913081152) , (exampleCompactRVK' (32, 32), mkKnownLovelace @37343863242999412) ] where exampleCompactRVK' :: (Int, Int) -> CompactRedeemVerificationKey exampleCompactRVK' (m, n) = - toCompactRedeemVerificationKey $ - fromJust (fst <$> redeemDeterministicKeyGen (getBytes m n)) + toCompactRedeemVerificationKey + $ fromJust (fst <$> redeemDeterministicKeyGen (getBytes m n)) exampleGenesisData0 :: GenesisData exampleGenesisData0 = @@ -122,14 +122,14 @@ exampleGenesisDelegation = (CC.XPub {CC.xpubPublicKey = pskVerKey, CC.xpubChaincode = pskChainCode}) sig :: Signature EpochNumber sig = - Signature $ - fromRight (panic "Something went wrong") $ - CC.xsignature - ( hexToBS - "bae5422af5405e3803154a4ad986da5d14cf624d670\ - \1c5c78a79ec73777f74e13973af83752114d9f18166\ - \085997fc81e432cab7fee99a275d8bf138ad04e103" - ) + Signature + $ fromRight (panic "Something went wrong") + $ CC.xsignature + ( hexToBS + "bae5422af5405e3803154a4ad986da5d14cf624d670\ + \1c5c78a79ec73777f74e13973af83752114d9f18166\ + \085997fc81e432cab7fee99a275d8bf138ad04e103" + ) pskVerKey = hexToBS "e2a1773a2a82d10c30890cbf84eccbdc1aaaee920496424d36e8\ @@ -172,8 +172,8 @@ exampleGenesisInitializer = exampleGenesisNonAvvmBalances0 :: GenesisNonAvvmBalances exampleGenesisNonAvvmBalances0 = - GenesisNonAvvmBalances $ - M.fromList [(exampleAddress, coin), (exampleAddress1, coin1)] + GenesisNonAvvmBalances + $ M.fromList [(exampleAddress, coin), (exampleAddress1, coin1)] where coin = mkKnownLovelace @36524597913081152 coin1 = mkKnownLovelace @37343863242999412 @@ -188,8 +188,8 @@ hexToBS :: ByteString -> ByteString hexToBS ts = case B16.decode ts of Right fullyDecoded -> fullyDecoded Left msg -> - panic $ - "fail to decode: " - <> show ts - <> " with error: " - <> show msg + panic + $ "fail to decode: " + <> show ts + <> " with error: " + <> show msg diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Genesis/Gen.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Genesis/Gen.hs index c9c0fb79bd0..1b0b2b6880a 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Genesis/Gen.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Genesis/Gen.hs @@ -132,7 +132,8 @@ genGenesisInitializer = genGenesisNonAvvmBalances :: Gen GenesisNonAvvmBalances genGenesisNonAvvmBalances = - GenesisNonAvvmBalances . M.fromList + GenesisNonAvvmBalances + . M.fromList <$> Gen.list (Range.linear 1 10) ((,) <$> genAddress <*> genLovelace) diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Slotting/Gen.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Slotting/Gen.hs index 79fc0801d12..71821285c6a 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Slotting/Gen.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Slotting/Gen.hs @@ -72,10 +72,10 @@ genEpochSlotCount epochSlots = genConsistentEpochAndSlotCountEpochSlots :: Gen (EpochAndSlotCount, EpochSlots) genConsistentEpochAndSlotCountEpochSlots = do epochSlots <- genEpochSlots - fmap (,epochSlots) $ - EpochAndSlotCount - <$> genRestrictedEpochNumber (maxBound `div` unEpochSlots epochSlots) - <*> genEpochSlotCount epochSlots + fmap (,epochSlots) + $ EpochAndSlotCount + <$> genRestrictedEpochNumber (maxBound `div` unEpochSlots epochSlots) + <*> genEpochSlotCount epochSlots where genRestrictedEpochNumber :: Word64 -> Gen EpochNumber genRestrictedEpochNumber bound = diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/CBOR.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/CBOR.hs index 296004df0e9..607f6f8dcc5 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/CBOR.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/CBOR.hs @@ -310,8 +310,8 @@ sizeEstimates = [ ("TxId", sizeTestGen genTxId) , ( "Tx" - , sizeTest $ - scfg + , sizeTest + $ scfg { gen = genTx , addlCtx = M.fromList [attrUnitSize, attrAddrSize] , computedCtx = \tx -> @@ -330,13 +330,13 @@ sizeEstimates = , ("TxIn", sizeTestGen genTxIn) , ( "TxOut" - , sizeTest $ - scfg {gen = genTxOut, addlCtx = M.fromList [attrAddrSize]} + , sizeTest + $ scfg {gen = genTxOut, addlCtx = M.fromList [attrAddrSize]} ) , ( "TxAux" - , sizeTest $ - scfg + , sizeTest + $ scfg { gen = genTxAux pm , addlCtx = M.fromList [attrUnitSize, attrAddrSize, txSigSize] , computedCtx = \ta -> @@ -358,14 +358,14 @@ sizeEstimates = ) , ( "TxInWitness" - , sizeTest $ - scfg {gen = genTxInWitness pm, addlCtx = M.fromList [txSigSize]} + , sizeTest + $ scfg {gen = genTxInWitness pm, addlCtx = M.fromList [txSigSize]} ) , ("TxSigData", sizeTestGen genTxSigData) , ( "Signature TxSigData" - , sizeTest $ - scfg {gen = genTxSig pm, addlCtx = M.fromList [txSigSize]} + , sizeTest + $ scfg {gen = genTxSig pm, addlCtx = M.fromList [txSigSize]} ) ] diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/Compact.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/Compact.hs index 5a14a8abcd5..b123dc1dedf 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/Compact.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/Compact.hs @@ -30,8 +30,9 @@ ts_roundTripCompactTxIn = eachOfTS 1000 genTxIn (trippingCompact toCompactTxIn fromCompactTxIn) ts_prop_heapWordsSavingsCompactTxIn :: TSProperty -ts_prop_heapWordsSavingsCompactTxIn = withTestsTS 1000 $ - property $ do +ts_prop_heapWordsSavingsCompactTxIn = withTestsTS 1000 + $ property + $ do txIn <- forAll genTxIn let compactTxIn = toCompactTxIn txIn assert $ heapWords compactTxIn < heapWords txIn @@ -45,8 +46,9 @@ ts_roundTripCompactTxId = eachOfTS 1000 genTxId (trippingCompact toCompactTxId fromCompactTxId) ts_prop_heapWordsSavingsCompactTxId :: TSProperty -ts_prop_heapWordsSavingsCompactTxId = withTestsTS 1000 $ - property $ do +ts_prop_heapWordsSavingsCompactTxId = withTestsTS 1000 + $ property + $ do txId <- forAll genTxId let compactTxId = toCompactTxId txId assert $ heapWords compactTxId < heapWords txId @@ -60,8 +62,9 @@ ts_roundTripCompactTxOut = eachOfTS 1000 genTxOut (trippingCompact toCompactTxOut fromCompactTxOut) ts_prop_heapWordsSavingsCompactTxOut :: TSProperty -ts_prop_heapWordsSavingsCompactTxOut = withTestsTS 1000 $ - property $ do +ts_prop_heapWordsSavingsCompactTxOut = withTestsTS 1000 + $ property + $ do txOut <- forAll genTxOut let compactTxOut = toCompactTxOut txOut assert $ heapWords compactTxOut < heapWords txOut diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/Example.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/Example.hs index 2dd48d87fd9..1da7f8cab14 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/Example.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/Example.hs @@ -120,8 +120,8 @@ exampleTxProof :: TxProof exampleTxProof = TxProof 32 mroot hashWit where mroot = - mtRoot $ - mkMerkleTree + mtRoot + $ mkMerkleTree [(UnsafeTx exampleTxInList exampleTxOutList (mkAttributes ()))] hashWit = serializeCborHash $ [(V.fromList [(VKWitness exampleVerificationKey exampleTxSig)])] diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/Model.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/Model.hs index eb0619209d5..858020228fa 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/Model.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/Model.hs @@ -50,8 +50,9 @@ tests = $$discoverPropArg -- UTxO validator. ts_prop_generatedUTxOChainsAreValidated :: TSProperty ts_prop_generatedUTxOChainsAreValidated = - withTestsTS 300 $ - property $ do + withTestsTS 300 + $ property + $ do tr <- forAll $ trace @UTXOW () 500 classifyTraceLength tr 200 50 passConcreteValidation tr @@ -60,8 +61,8 @@ passConcreteValidation :: MonadTest m => Trace UTXOW -> m () passConcreteValidation !tr = void $ evalEither res where res = - foldM (elaborateAndUpdate abstractEnv) initSt $ - traceSignals OldestFirst tr + foldM (elaborateAndUpdate abstractEnv) initSt + $ traceSignals OldestFirst tr abstractEnv = tr ^. traceEnv diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/ValidationMode.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/ValidationMode.hs index d0e48621077..72d587bd2b8 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/ValidationMode.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/UTxO/ValidationMode.hs @@ -78,8 +78,9 @@ ts_prop_updateUTxO_Valid = env = Environment pm pparams UTxO.defaultUTxOConfiguration vMode <- forAll $ ValidationMode BlockValidation <$> genValidationMode updateRes <- - (`runReaderT` vMode) . runExceptT $ - UTxO.updateUTxO env utxo [tx] + (`runReaderT` vMode) + . runExceptT + $ UTxO.updateUTxO env utxo [tx] void $ evalEither updateRes -- | Property: When calling 'updateUTxO' given a valid transaction with an @@ -110,26 +111,28 @@ ts_prop_updateUTxO_InvalidWit = -- transaction generated above. let pm = Dummy.aProtocolMagic invalidWitness <- - forAll $ - Annotated - <$> ( V.fromList - <$> Gen.list - (Range.linear 1 10) - (genVKWitness (getProtocolMagicId pm)) - ) - <*> genBytes 32 + forAll + $ Annotated + <$> ( V.fromList + <$> Gen.list + (Range.linear 1 10) + (genVKWitness (getProtocolMagicId pm)) + ) + <*> genBytes 32 let txInvalidWit = tx {aTaWitness = invalidWitness} -- Validate the generated concrete transaction let env = Environment pm pparams UTxO.defaultUTxOConfiguration vMode <- forAll $ ValidationMode BlockValidation <$> genValidationMode updateRes <- - (`runReaderT` vMode) . runExceptT $ - UTxO.updateUTxO env utxo [txInvalidWit] + (`runReaderT` vMode) + . runExceptT + $ UTxO.updateUTxO env utxo [txInvalidWit] case updateRes of Left err -> if isInvalidWitnessError err - && (txValidationMode vMode) == TxValidation + && (txValidationMode vMode) + == TxValidation then success else failure Right _ -> diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Update/Gen.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Update/Gen.hs index 7aba0f8c479..5409bd87c3f 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Update/Gen.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Update/Gen.hs @@ -219,8 +219,10 @@ genRegistrationError = version <- genWord32 slotNo <- SlotNumber <$> Gen.word64 Range.constantBounded meta <- - Gen.map (Range.linear 1 10) $ - (,) <$> genSystemTag <*> genInstallerHash + Gen.map (Range.linear 1 10) + $ (,) + <$> genSystemTag + <*> genInstallerHash pure (name, (Registration.ApplicationVersion version slotNo meta)) ) <*> genSoftwareVersion diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Update/Properties.hs b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Update/Properties.hs index 65a36c4c5fb..8e3494fe45b 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Chain/Update/Properties.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Chain/Update/Properties.hs @@ -43,8 +43,8 @@ ts_prop_checkApplicationName = withTestsTS 100 . property $ do ts_prop_checkApplicationNameTooLong :: TSProperty ts_prop_checkApplicationNameTooLong = withTestsTS 100 . property $ do (ApplicationName aName) <- - forAll $ - Gen.filter + forAll + $ Gen.filter (\name -> T.length (unApplicationName name) >= applicationNameMaxLength) genApplicationName moreText <- forAll $ Gen.text (Range.linear 1 20) Gen.ascii @@ -56,8 +56,8 @@ ts_prop_checkApplicationNameTooLong = withTestsTS 100 . property $ do ts_prop_checkApplicationNameNotAscii :: TSProperty ts_prop_checkApplicationNameNotAscii = withTestsTS 100 . property $ do nonAscii <- - forAll $ - Gen.filter + forAll + $ Gen.filter (all (== True) . map (not . isAscii)) (Gen.string (Range.linear 1 applicationNameMaxLength) Gen.unicodeAll) assertIsLeftConstr @@ -74,8 +74,8 @@ ts_prop_checkSoftwareVersion = withTestsTS 100 . property $ do ts_prop_checkSoftwareVersionTooLong :: TSProperty ts_prop_checkSoftwareVersionTooLong = withTestsTS 100 . property $ do (ApplicationName aName) <- - forAll $ - Gen.filter + forAll + $ Gen.filter (\name -> T.length (unApplicationName name) >= applicationNameMaxLength) genApplicationName moreText <- forAll $ Gen.text (Range.linear 1 20) Gen.ascii @@ -88,8 +88,8 @@ ts_prop_checkSoftwareVersionTooLong = withTestsTS 100 . property $ do ts_prop_checkSoftwareVersionNotAscii :: TSProperty ts_prop_checkSoftwareVersionNotAscii = withTestsTS 100 . property $ do nonAscii <- - forAll $ - Gen.filter + forAll + $ Gen.filter (all (== True) . map (not . isAscii)) (Gen.string (Range.linear 1 applicationNameMaxLength) Gen.unicodeAll) let appNameNonascii = ApplicationName $ T.pack nonAscii @@ -107,8 +107,8 @@ ts_prop_checkSystemTag = withTestsTS 100 . property $ do ts_prop_checkSystemTagTooLong :: TSProperty ts_prop_checkSystemTagTooLong = withTestsTS 100 . property $ do (SystemTag tag) <- - forAll $ - Gen.filter + forAll + $ Gen.filter (\sysTag -> T.length (getSystemTag sysTag) >= systemTagMaxLength) genSystemTag moreText <- forAll $ Gen.text (Range.linear 1 20) Gen.ascii @@ -119,8 +119,8 @@ ts_prop_checkSystemTagTooLong = withTestsTS 100 . property $ do ts_prop_checkSystemTagNotAscii :: TSProperty ts_prop_checkSystemTagNotAscii = withTestsTS 100 . property $ do nonAscii <- - forAll $ - Gen.filter + forAll + $ Gen.filter (all (== True) . map (not . isAscii)) (Gen.string (Range.linear 1 systemTagMaxLength) Gen.unicodeAll) let sysTagNonascii = SystemTag $ T.pack nonAscii @@ -141,14 +141,16 @@ dummyAppNameTooLong = toConstr $ ApplicationNameTooLong "dummyValue" dummySoftVerNotAscii :: Constr dummySoftVerNotAscii = - toConstr . SoftwareVersionApplicationNameError $ - ApplicationNameNotAscii + toConstr + . SoftwareVersionApplicationNameError + $ ApplicationNameNotAscii "dummyValue" dummySoftVerTooLong :: Constr dummySoftVerTooLong = - toConstr . SoftwareVersionApplicationNameError $ - ApplicationNameTooLong + toConstr + . SoftwareVersionApplicationNameError + $ ApplicationNameTooLong "dummyValue" dummySysTagNotAscii :: Constr diff --git a/eras/byron/ledger/impl/test/Test/Cardano/Mirror.hs b/eras/byron/ledger/impl/test/Test/Cardano/Mirror.hs index 9bb58859286..bff140be0d2 100644 --- a/eras/byron/ledger/impl/test/Test/Cardano/Mirror.hs +++ b/eras/byron/ledger/impl/test/Test/Cardano/Mirror.hs @@ -27,8 +27,8 @@ mainnetEpochFiles = . filter ("epoch" `isExtensionOf`) <$> getDirectoryContents fpath else do - putStrLn $ - "mainnetEpochFiles: directory '" - ++ fpath - ++ "' does not exist." + putStrLn + $ "mainnetEpochFiles: directory '" + ++ fpath + ++ "' does not exist." exitFailure diff --git a/eras/byron/ledger/impl/test/Test/Options.hs b/eras/byron/ledger/impl/test/Test/Options.hs index 4a296d8e947..2a767369d36 100644 --- a/eras/byron/ledger/impl/test/Test/Options.hs +++ b/eras/byron/ledger/impl/test/Test/Options.hs @@ -133,9 +133,9 @@ scenarioScaled count ts = if scaledCount > 0 then scaledCount else - panic $ - "scenarioScaled: produced a non-positive TestLimit: " - <> show scaledCount + panic + $ "scenarioScaled: produced a non-positive TestLimit: " + <> show scaledCount where scaledCount :: TestLimit scaledCount = round . ((count % 1) *) $ scenarioScaleDefault ts diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index 670056f2ea2..61dc83b57ce 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -1,8 +1,20 @@ # Version history for `cardano-ledger-conway` -## 1.6.1.0 +## 1.7.0.0 * Removal of TxOuts with zero `Coin` from UTxO on translation +* Rename: + `cgTally` -> `cgGov` + `cgTallyL` -> `cgGovL` + `VDelFailure` -> `GovCertFailure` + `VDelEvent` -> `GovCertEvent` + `certVState` -> `certGState` + `ConwayVDelPredFailure` -> `ConwayGovCertPredFailure` + `ConwayTallyPredFailure` -> `ConwayGovPredFailure` + `TallyEnv` -> `GovEnv` + `ConwayTallyState` -> `ConwayGovState` + `TALLY` -> `GOV` + `VDEL` -> `GOVCERT` ## 1.6.0.0 @@ -25,8 +37,8 @@ * Removal of `gasVotes` in favor of `gasCommitteeVotes`, `gasDRepVotes` and `gasStakePoolVotes` in `GovernanceActionState` * Removal of `reRoles` from `RatifyEnv` as no longer needed -* Addtion of `reStakePoolDistr` to `RatifyEnv` -* Remove `VoterDoesNotHaveRole` as no longer needed from `ConwayTallyPredFailure` +* Addition of `reStakePoolDistr` to `RatifyEnv` +* Remove `VoterDoesNotHaveRole` as no longer needed from `ConwayGovPredFailure` * Added `ConwayEpochPredFailure` * Added instance for `Embed (ConwayRATIFY era) (ConwayEPOCH era)` * Removed instance for `Embed (ConwayRATIFY era) (ConwayNEWEPOCH era)` diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal index fb28074f1bc..282939fd6e9 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/eras/conway/impl/cardano-ledger-conway.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-conway -version: 1.6.1.1 +version: 1.7.0.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK @@ -43,14 +43,14 @@ library Cardano.Ledger.Conway.Rules.Cert Cardano.Ledger.Conway.Rules.Deleg Cardano.Ledger.Conway.Rules.Pool - Cardano.Ledger.Conway.Rules.VDel + Cardano.Ledger.Conway.Rules.GovCert Cardano.Ledger.Conway.Rules.Certs Cardano.Ledger.Conway.Rules.Enact Cardano.Ledger.Conway.Rules.Epoch Cardano.Ledger.Conway.Rules.Ledger Cardano.Ledger.Conway.Rules.NewEpoch Cardano.Ledger.Conway.Rules.Ratify - Cardano.Ledger.Conway.Rules.Tally + Cardano.Ledger.Conway.Rules.Gov Cardano.Ledger.Conway.Rules.Tickf Cardano.Ledger.Conway.Rules.Utxos Cardano.Ledger.Conway.Rules.Utxow diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Era.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Era.hs index ba86ee54682..a4fb7bc9f17 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Era.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Era.hs @@ -6,9 +6,9 @@ module Cardano.Ledger.Conway.Era ( ConwayCERT, ConwayDELEG, ConwayPOOL, - ConwayVDEL, + ConwayGOVCERT, ConwayCERTS, - ConwayTALLY, + ConwayGOV, ConwayNEWEPOCH, ConwayEPOCH, ConwayENACT, @@ -48,9 +48,9 @@ type instance Value (ConwayEra c) = MaryValue c -- Era Mapping ------------------------------------------------------------------------------- -data ConwayTALLY era +data ConwayGOV era -type instance EraRule "TALLY" (ConwayEra c) = ConwayTALLY (ConwayEra c) +type instance EraRule "GOV" (ConwayEra c) = ConwayGOV (ConwayEra c) data ConwayNEWEPOCH era @@ -96,9 +96,9 @@ data ConwayPOOL era type instance EraRule "POOL" (ConwayEra c) = ConwayPOOL (ConwayEra c) -data ConwayVDEL era +data ConwayGOVCERT era -type instance EraRule "VDEL" (ConwayEra c) = ConwayVDEL (ConwayEra c) +type instance EraRule "GOVCERT" (ConwayEra c) = ConwayGOVCERT (ConwayEra c) data ConwayUTXOW era diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs index 8b4e1b487d1..678744474a6 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs @@ -17,12 +17,12 @@ module Cardano.Ledger.Conway.Governance ( EraGovernance (..), - ConwayTallyState (..), + ConwayGovState (..), EnactState (..), RatifyState (..), ConwayGovernance (..), -- Lenses - cgTallyL, + cgGovL, cgRatifyL, GovernanceAction (..), GovernanceActionState (..), @@ -145,30 +145,30 @@ instance EraPParams era => EncCBOR (GovernanceActionState era) where !> To gasAction !> To gasProposedIn -newtype ConwayTallyState era = ConwayTallyState - { unConwayTallyState :: Map (GovernanceActionId (EraCrypto era)) (GovernanceActionState era) +newtype ConwayGovState era = ConwayGovState + { unConwayGovState :: Map (GovernanceActionId (EraCrypto era)) (GovernanceActionState era) } deriving (Generic, NFData) -deriving instance EraPParams era => Eq (ConwayTallyState era) +deriving instance EraPParams era => Eq (ConwayGovState era) -deriving instance EraPParams era => Show (ConwayTallyState era) +deriving instance EraPParams era => Show (ConwayGovState era) -deriving instance EraPParams era => ToJSON (ConwayTallyState era) +deriving instance EraPParams era => ToJSON (ConwayGovState era) -instance EraPParams era => NoThunks (ConwayTallyState era) +instance EraPParams era => NoThunks (ConwayGovState era) -instance Default (ConwayTallyState era) where - def = ConwayTallyState mempty +instance Default (ConwayGovState era) where + def = ConwayGovState mempty -deriving instance EraPParams era => EncCBOR (ConwayTallyState era) +deriving instance EraPParams era => EncCBOR (ConwayGovState era) -deriving instance EraPParams era => DecCBOR (ConwayTallyState era) +deriving instance EraPParams era => DecCBOR (ConwayGovState era) -instance EraPParams era => ToCBOR (ConwayTallyState era) where +instance EraPParams era => ToCBOR (ConwayGovState era) where toCBOR = toEraCBOR @era -instance EraPParams era => FromCBOR (ConwayTallyState era) where +instance EraPParams era => FromCBOR (ConwayGovState era) where fromCBOR = fromEraCBOR @era data EnactState era = EnactState @@ -294,13 +294,13 @@ toRatifyStatePairs cg@(RatifyState _ _) = ] data ConwayGovernance era = ConwayGovernance - { cgTally :: !(ConwayTallyState era) + { cgGov :: !(ConwayGovState era) , cgRatify :: !(RatifyState era) } deriving (Generic, Eq, Show) -cgTallyL :: Lens' (ConwayGovernance era) (ConwayTallyState era) -cgTallyL = lens cgTally (\x y -> x {cgTally = y}) +cgGovL :: Lens' (ConwayGovernance era) (ConwayGovState era) +cgGovL = lens cgGov (\x y -> x {cgGov = y}) cgRatifyL :: Lens' (ConwayGovernance era) (RatifyState era) cgRatifyL = lens cgRatify (\x y -> x {cgRatify = y}) @@ -316,7 +316,7 @@ instance EraPParams era => EncCBOR (ConwayGovernance era) where encCBOR ConwayGovernance {..} = encode $ Rec ConwayGovernance - !> To cgTally + !> To cgGov !> To cgRatify instance EraPParams era => ToCBOR (ConwayGovernance era) where @@ -338,7 +338,7 @@ instance EraPParams era => ToJSON (ConwayGovernance era) where toConwayGovernancePairs :: (KeyValue a, EraPParams era) => ConwayGovernance era -> [a] toConwayGovernancePairs cg@(ConwayGovernance _ _) = let ConwayGovernance {..} = cg - in [ "tally" .= cgTally + in [ "gov" .= cgGov , "ratify" .= cgRatify ] diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules.hs index 1e8ed0d1704..2053a649104 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules.hs @@ -2,7 +2,7 @@ module Cardano.Ledger.Conway.Rules ( module Cardano.Ledger.Conway.Rules.Cert, module Cardano.Ledger.Conway.Rules.Deleg, module Cardano.Ledger.Conway.Rules.Pool, - module Cardano.Ledger.Conway.Rules.VDel, + module Cardano.Ledger.Conway.Rules.GovCert, module Cardano.Ledger.Conway.Rules.Certs, module Cardano.Ledger.Conway.Rules.Enact, module Cardano.Ledger.Conway.Rules.Epoch, @@ -10,7 +10,7 @@ module Cardano.Ledger.Conway.Rules ( module Cardano.Ledger.Conway.Rules.NewEpoch, module Cardano.Ledger.Conway.Rules.Tickf, module Cardano.Ledger.Conway.Rules.Ratify, - module Cardano.Ledger.Conway.Rules.Tally, + module Cardano.Ledger.Conway.Rules.Gov, module Cardano.Ledger.Conway.Rules.Utxos, module Cardano.Ledger.Conway.Rules.Utxow, ) @@ -21,12 +21,12 @@ import Cardano.Ledger.Conway.Rules.Certs import Cardano.Ledger.Conway.Rules.Deleg import Cardano.Ledger.Conway.Rules.Enact import Cardano.Ledger.Conway.Rules.Epoch +import Cardano.Ledger.Conway.Rules.Gov +import Cardano.Ledger.Conway.Rules.GovCert import Cardano.Ledger.Conway.Rules.Ledger import Cardano.Ledger.Conway.Rules.NewEpoch import Cardano.Ledger.Conway.Rules.Pool import Cardano.Ledger.Conway.Rules.Ratify -import Cardano.Ledger.Conway.Rules.Tally import Cardano.Ledger.Conway.Rules.Tickf import Cardano.Ledger.Conway.Rules.Utxos import Cardano.Ledger.Conway.Rules.Utxow -import Cardano.Ledger.Conway.Rules.VDel diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs index d9ddf7cb568..abe5f0be90d 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs @@ -24,9 +24,9 @@ import Cardano.Ledger.BaseTypes (ShelleyBase) import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..)) import Cardano.Ledger.Binary.Coders import Cardano.Ledger.Conway.Core -import Cardano.Ledger.Conway.Era (ConwayCERT, ConwayDELEG, ConwayPOOL, ConwayVDEL) +import Cardano.Ledger.Conway.Era (ConwayCERT, ConwayDELEG, ConwayGOVCERT, ConwayPOOL) import Cardano.Ledger.Conway.Rules.Deleg (ConwayDelegPredFailure (..)) -import Cardano.Ledger.Conway.Rules.VDel (ConwayVDelPredFailure) +import Cardano.Ledger.Conway.Rules.GovCert (ConwayGovCertPredFailure) import Cardano.Ledger.Conway.TxCert (ConwayCommitteeCert, ConwayDelegCert, ConwayTxCert (..)) import Cardano.Ledger.Shelley.API ( CertState (..), @@ -56,57 +56,57 @@ import NoThunks.Class (NoThunks) data ConwayCertPredFailure era = DelegFailure (PredicateFailure (EraRule "DELEG" era)) | PoolFailure (PredicateFailure (EraRule "POOL" era)) - | VDelFailure (PredicateFailure (EraRule "VDEL" era)) + | GovCertFailure (PredicateFailure (EraRule "GOVCERT" era)) deriving (Generic) deriving stock instance ( Show (PredicateFailure (EraRule "DELEG" era)) , Show (PredicateFailure (EraRule "POOL" era)) - , Show (PredicateFailure (EraRule "VDEL" era)) + , Show (PredicateFailure (EraRule "GOVCERT" era)) ) => Show (ConwayCertPredFailure era) deriving stock instance ( Eq (PredicateFailure (EraRule "DELEG" era)) , Eq (PredicateFailure (EraRule "POOL" era)) - , Eq (PredicateFailure (EraRule "VDEL" era)) + , Eq (PredicateFailure (EraRule "GOVCERT" era)) ) => Eq (ConwayCertPredFailure era) instance ( NoThunks (PredicateFailure (EraRule "DELEG" era)) , NoThunks (PredicateFailure (EraRule "POOL" era)) - , NoThunks (PredicateFailure (EraRule "VDEL" era)) + , NoThunks (PredicateFailure (EraRule "GOVCERT" era)) ) => NoThunks (ConwayCertPredFailure era) instance ( NFData (PredicateFailure (EraRule "DELEG" era)) , NFData (PredicateFailure (EraRule "POOL" era)) - , NFData (PredicateFailure (EraRule "VDEL" era)) + , NFData (PredicateFailure (EraRule "GOVCERT" era)) ) => NFData (ConwayCertPredFailure era) data ConwayCertEvent era = DelegEvent (Event (ConwayDELEG era)) | PoolEvent (Event (ConwayPOOL era)) - | VDelEvent (Event (ConwayVDEL era)) + | GovCertEvent (Event (ConwayGOVCERT era)) instance forall era. ( Era era , State (EraRule "DELEG" era) ~ DState era , State (EraRule "POOL" era) ~ PState era - , State (EraRule "VDEL" era) ~ VState era + , State (EraRule "GOVCERT" era) ~ VState era , Environment (EraRule "DELEG" era) ~ DelegEnv era , Environment (EraRule "POOL" era) ~ PoolEnv era - , Environment (EraRule "VDEL" era) ~ PParams era + , Environment (EraRule "GOVCERT" era) ~ PParams era , Signal (EraRule "DELEG" era) ~ ConwayDelegCert (EraCrypto era) , Signal (EraRule "POOL" era) ~ PoolCert (EraCrypto era) - , Signal (EraRule "VDEL" era) ~ ConwayCommitteeCert (EraCrypto era) + , Signal (EraRule "GOVCERT" era) ~ ConwayCommitteeCert (EraCrypto era) , Embed (EraRule "DELEG" era) (ConwayCERT era) , Embed (EraRule "POOL" era) (ConwayCERT era) - , Embed (EraRule "VDEL" era) (ConwayCERT era) + , Embed (EraRule "GOVCERT" era) (ConwayCERT era) , TxCert era ~ ConwayTxCert era ) => STS (ConwayCERT era) @@ -124,16 +124,16 @@ certTransition :: forall era. ( State (EraRule "DELEG" era) ~ DState era , State (EraRule "POOL" era) ~ PState era - , State (EraRule "VDEL" era) ~ VState era + , State (EraRule "GOVCERT" era) ~ VState era , Environment (EraRule "DELEG" era) ~ DelegEnv era , Environment (EraRule "POOL" era) ~ PoolEnv era - , Environment (EraRule "VDEL" era) ~ PParams era + , Environment (EraRule "GOVCERT" era) ~ PParams era , Signal (EraRule "DELEG" era) ~ ConwayDelegCert (EraCrypto era) , Signal (EraRule "POOL" era) ~ PoolCert (EraCrypto era) - , Signal (EraRule "VDEL" era) ~ ConwayCommitteeCert (EraCrypto era) + , Signal (EraRule "GOVCERT" era) ~ ConwayCommitteeCert (EraCrypto era) , Embed (EraRule "DELEG" era) (ConwayCERT era) , Embed (EraRule "POOL" era) (ConwayCERT era) - , Embed (EraRule "VDEL" era) (ConwayCERT era) + , Embed (EraRule "GOVCERT" era) (ConwayCERT era) , TxCert era ~ ConwayTxCert era ) => TransitionRule (ConwayCERT era) @@ -147,8 +147,8 @@ certTransition = do ConwayTxCertPool poolCert -> do newPState <- trans @(EraRule "POOL" era) $ TRC (PoolEnv slot pp, certPState, poolCert) pure $ cState {certPState = newPState} - ConwayTxCertCommittee vDelCert -> do - newVState <- trans @(EraRule "VDEL" era) $ TRC (pp, certVState, vDelCert) + ConwayTxCertCommittee govCert -> do + newVState <- trans @(EraRule "GOVCERT" era) $ TRC (pp, certVState, govCert) pure $ cState {certVState = newVState} instance @@ -175,19 +175,19 @@ instance instance ( Era era - , STS (ConwayVDEL era) - , PredicateFailure (EraRule "VDEL" era) ~ ConwayVDelPredFailure era + , STS (ConwayGOVCERT era) + , PredicateFailure (EraRule "GOVCERT" era) ~ ConwayGovCertPredFailure era ) => - Embed (ConwayVDEL era) (ConwayCERT era) + Embed (ConwayGOVCERT era) (ConwayCERT era) where - wrapFailed = VDelFailure - wrapEvent = VDelEvent + wrapFailed = GovCertFailure + wrapEvent = GovCertEvent instance ( Typeable era , EncCBOR (PredicateFailure (EraRule "DELEG" era)) , EncCBOR (PredicateFailure (EraRule "POOL" era)) - , EncCBOR (PredicateFailure (EraRule "VDEL" era)) + , EncCBOR (PredicateFailure (EraRule "GOVCERT" era)) ) => EncCBOR (ConwayCertPredFailure era) where @@ -195,13 +195,13 @@ instance encode . \case DelegFailure x -> Sum (DelegFailure @era) 1 !> To x PoolFailure x -> Sum (PoolFailure @era) 2 !> To x - VDelFailure x -> Sum (VDelFailure @era) 3 !> To x + GovCertFailure x -> Sum (GovCertFailure @era) 3 !> To x instance ( Typeable era , DecCBOR (PredicateFailure (EraRule "DELEG" era)) , DecCBOR (PredicateFailure (EraRule "POOL" era)) - , DecCBOR (PredicateFailure (EraRule "VDEL" era)) + , DecCBOR (PredicateFailure (EraRule "GOVCERT" era)) ) => DecCBOR (ConwayCertPredFailure era) where @@ -209,5 +209,5 @@ instance decode $ Summands "ConwayCertPredFailure" $ \case 1 -> SumD DelegFailure SumD PoolFailure SumD VDelFailure SumD GovCertFailure Invalid n diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs index 539b0fe3fe4..29a85afab98 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs @@ -110,7 +110,7 @@ instance ) => DecCBOR (ConwayCertsPredFailure era) where - decCBOR = decode $ Summands "ConwayTallyPredFailure" $ \case + decCBOR = decode $ Summands "ConwayGovPredFailure" $ \case 0 -> SumD DelegateeNotRegisteredDELEG SumD WithdrawalsNotInRewardsCERTS SumD CertFailure ), ( NFData (ConwayTallyPredFailure era) +instance Era era => NFData (ConwayGovPredFailure era) -instance Era era => NoThunks (ConwayTallyPredFailure era) +instance Era era => NoThunks (ConwayGovPredFailure era) -instance EraPParams era => DecCBOR (ConwayTallyPredFailure era) where - decCBOR = decode $ Summands "ConwayTallyPredFailure" $ \case +instance EraPParams era => DecCBOR (ConwayGovPredFailure era) where + decCBOR = decode $ Summands "ConwayGovPredFailure" $ \case 0 -> SumD GovernanceActionDoesNotExist Invalid k -instance EraPParams era => EncCBOR (ConwayTallyPredFailure era) where +instance EraPParams era => EncCBOR (ConwayGovPredFailure era) where encCBOR = encode . \case GovernanceActionDoesNotExist gid -> Sum (GovernanceActionDoesNotExist @era) 0 !> To gid -instance EraPParams era => ToCBOR (ConwayTallyPredFailure era) where +instance EraPParams era => ToCBOR (ConwayGovPredFailure era) where toCBOR = toEraCBOR @era -instance EraPParams era => FromCBOR (ConwayTallyPredFailure era) where +instance EraPParams era => FromCBOR (ConwayGovPredFailure era) where fromCBOR = fromEraCBOR @era -instance Era era => STS (ConwayTALLY era) where - type State (ConwayTALLY era) = ConwayTallyState era - type Signal (ConwayTALLY era) = GovernanceProcedures era - type Environment (ConwayTALLY era) = TallyEnv era - type BaseM (ConwayTALLY era) = ShelleyBase - type PredicateFailure (ConwayTALLY era) = ConwayTallyPredFailure era - type Event (ConwayTALLY era) = () +instance Era era => STS (ConwayGOV era) where + type State (ConwayGOV era) = ConwayGovState era + type Signal (ConwayGOV era) = GovernanceProcedures era + type Environment (ConwayGOV era) = GovEnv era + type BaseM (ConwayGOV era) = ShelleyBase + type PredicateFailure (ConwayGOV era) = ConwayGovPredFailure era + type Event (ConwayGOV era) = () initialRules = [] - transitionRules = [tallyTransition] + transitionRules = [govTransition] addVote :: VotingProcedure era -> - ConwayTallyState era -> - ConwayTallyState era -addVote VotingProcedure {vProcGovActionId, vProcVoter, vProcVote} (ConwayTallyState st) = - ConwayTallyState $ + ConwayGovState era -> + ConwayGovState era +addVote VotingProcedure {vProcGovActionId, vProcVoter, vProcVote} (ConwayGovState st) = + ConwayGovState $ Map.update (Just . updateVote) vProcGovActionId st where updateVote GovernanceActionState {..} = @@ -126,10 +126,10 @@ addAction :: Coin -> KeyHash 'Staking (EraCrypto era) -> GovernanceAction era -> - ConwayTallyState era -> - ConwayTallyState era -addAction epoch gaid c addr act (ConwayTallyState st) = - ConwayTallyState $ + ConwayGovState era -> + ConwayGovState era +addAction epoch gaid c addr act (ConwayGovState st) = + ConwayGovState $ Map.insert gaid gai' st where gai' = @@ -144,17 +144,17 @@ addAction epoch gaid c addr act (ConwayTallyState st) = } noSuchGovernanceAction :: - ConwayTallyState era -> + ConwayGovState era -> GovernanceActionId (EraCrypto era) -> - Test (ConwayTallyPredFailure era) -noSuchGovernanceAction (ConwayTallyState st) gaid = + Test (ConwayGovPredFailure era) +noSuchGovernanceAction (ConwayGovState st) gaid = failureUnless (Map.member gaid st) $ GovernanceActionDoesNotExist gaid -tallyTransition :: forall era. TransitionRule (ConwayTALLY era) -tallyTransition = do +govTransition :: forall era. TransitionRule (ConwayGOV era) +govTransition = do -- TODO Check the signatures - TRC (TallyEnv txid epoch, st, GovernanceProcedures {..}) <- judgmentContext + TRC (GovEnv txid epoch, st, GovernanceProcedures {..}) <- judgmentContext let applyProps _ st' Empty = pure st' applyProps idx st' (ProposalProcedure {..} :<| ps) = do @@ -176,5 +176,5 @@ tallyTransition = do applyVotes st'' vs applyVotes stProps gpVotingProcedures -instance Inject (ConwayTallyPredFailure era) (ConwayTallyPredFailure era) where +instance Inject (ConwayGovPredFailure era) (ConwayGovPredFailure era) where inject = id diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/VDel.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs similarity index 58% rename from eras/conway/impl/src/Cardano/Ledger/Conway/Rules/VDel.hs rename to eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs index a3ff19e7eb1..9f1b2fcd0e7 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/VDel.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs @@ -11,10 +11,10 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} -module Cardano.Ledger.Conway.Rules.VDel ( - ConwayVDEL, - ConwayVDelEvent (..), - ConwayVDelPredFailure (..), +module Cardano.Ledger.Conway.Rules.GovCert ( + ConwayGOVCERT, + ConwayGovCertEvent (..), + ConwayGovCertPredFailure (..), ) where @@ -25,7 +25,7 @@ import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), encodeListLen) import Cardano.Ledger.Binary.Coders import Cardano.Ledger.CertState (VState (..)) import Cardano.Ledger.Coin (Coin) -import Cardano.Ledger.Conway.Era (ConwayVDEL) +import Cardano.Ledger.Conway.Era (ConwayGOVCERT) import Cardano.Ledger.Conway.TxCert (ConwayCommitteeCert (..)) import Cardano.Ledger.Core (Era (EraCrypto), EraPParams, EraRule, PParams) import Cardano.Ledger.Credential (Credential) @@ -54,83 +54,83 @@ import Data.Word (Word8) import GHC.Generics (Generic) import NoThunks.Class (NoThunks (..)) -data ConwayVDelPredFailure era - = ConwayDRepAlreadyRegisteredVDEL !(Credential 'Voting (EraCrypto era)) - | ConwayDRepNotRegisteredVDEL !(Credential 'Voting (EraCrypto era)) - | ConwayDRepIncorrectDepositVDEL !Coin - | ConwayCommitteeHasResignedVDEL !(KeyHash 'CommitteeColdKey (EraCrypto era)) +data ConwayGovCertPredFailure era + = ConwayDRepAlreadyRegistered !(Credential 'Voting (EraCrypto era)) + | ConwayDRepNotRegistered !(Credential 'Voting (EraCrypto era)) + | ConwayDRepIncorrectDeposit !Coin + | ConwayCommitteeHasResigned !(KeyHash 'CommitteeColdKey (EraCrypto era)) deriving (Show, Eq, Generic) -instance NoThunks (ConwayVDelPredFailure era) +instance NoThunks (ConwayGovCertPredFailure era) -instance NFData (ConwayVDelPredFailure era) +instance NFData (ConwayGovCertPredFailure era) instance (Typeable era, Crypto (EraCrypto era)) => - EncCBOR (ConwayVDelPredFailure era) + EncCBOR (ConwayGovCertPredFailure era) where encCBOR = \case - ConwayDRepAlreadyRegisteredVDEL cred -> + ConwayDRepAlreadyRegistered cred -> encodeListLen 2 <> encCBOR (0 :: Word8) <> encCBOR cred - ConwayDRepNotRegisteredVDEL cred -> + ConwayDRepNotRegistered cred -> encodeListLen 2 <> encCBOR (1 :: Word8) <> encCBOR cred - ConwayDRepIncorrectDepositVDEL deposit -> + ConwayDRepIncorrectDeposit deposit -> encodeListLen 2 <> encCBOR (2 :: Word8) <> encCBOR deposit - ConwayCommitteeHasResignedVDEL keyH -> + ConwayCommitteeHasResigned keyH -> encodeListLen 2 <> encCBOR (3 :: Word8) <> encCBOR keyH instance (Typeable era, Crypto (EraCrypto era)) => - DecCBOR (ConwayVDelPredFailure era) + DecCBOR (ConwayGovCertPredFailure era) where - decCBOR = decodeRecordSum "ConwayVDelPredFailure" $ + decCBOR = decodeRecordSum "ConwayGovCertPredFailure" $ \case 0 -> do cred <- decCBOR - pure (2, ConwayDRepAlreadyRegisteredVDEL cred) + pure (2, ConwayDRepAlreadyRegistered cred) 1 -> do cred <- decCBOR - pure (2, ConwayDRepNotRegisteredVDEL cred) + pure (2, ConwayDRepNotRegistered cred) 2 -> do deposit <- decCBOR - pure (2, ConwayDRepIncorrectDepositVDEL deposit) + pure (2, ConwayDRepIncorrectDeposit deposit) 3 -> do keyH <- decCBOR - pure (2, ConwayCommitteeHasResignedVDEL keyH) + pure (2, ConwayCommitteeHasResigned keyH) k -> invalidKey k -newtype ConwayVDelEvent era = VDelEvent (Event (EraRule "VDEL" era)) +newtype ConwayGovCertEvent era = GovCertEvent (Event (EraRule "GOVCERT" era)) instance ( EraPParams era - , State (EraRule "VDEL" era) ~ VState era - , Signal (EraRule "VDEL" era) ~ ConwayCommitteeCert (EraCrypto era) - , Environment (EraRule "VDEL" era) ~ PParams era - , EraRule "VDEL" era ~ ConwayVDEL era - , Eq (PredicateFailure (EraRule "VDEL" era)) - , Show (PredicateFailure (EraRule "VDEL" era)) + , State (EraRule "GOVCERT" era) ~ VState era + , Signal (EraRule "GOVCERT" era) ~ ConwayCommitteeCert (EraCrypto era) + , Environment (EraRule "GOVCERT" era) ~ PParams era + , EraRule "GOVCERT" era ~ ConwayGOVCERT era + , Eq (PredicateFailure (EraRule "GOVCERT" era)) + , Show (PredicateFailure (EraRule "GOVCERT" era)) ) => - STS (ConwayVDEL era) + STS (ConwayGOVCERT era) where - type State (ConwayVDEL era) = VState era - type Signal (ConwayVDEL era) = ConwayCommitteeCert (EraCrypto era) - type Environment (ConwayVDEL era) = PParams era - type BaseM (ConwayVDEL era) = ShelleyBase - type PredicateFailure (ConwayVDEL era) = ConwayVDelPredFailure era - type Event (ConwayVDEL era) = ConwayVDelEvent era + type State (ConwayGOVCERT era) = VState era + type Signal (ConwayGOVCERT era) = ConwayCommitteeCert (EraCrypto era) + type Environment (ConwayGOVCERT era) = PParams era + type BaseM (ConwayGOVCERT era) = ShelleyBase + type PredicateFailure (ConwayGOVCERT era) = ConwayGovCertPredFailure era + type Event (ConwayGOVCERT era) = ConwayGovCertEvent era - transitionRules = [conwayVDelTransition @era] + transitionRules = [conwayGovCertTransition @era] -conwayVDelTransition :: TransitionRule (ConwayVDEL era) -conwayVDelTransition = do +conwayGovCertTransition :: TransitionRule (ConwayGOVCERT era) +conwayGovCertTransition = do TRC ( _pp , vState@VState {vsDReps, vsCommitteeHotKeys} @@ -139,12 +139,12 @@ conwayVDelTransition = do judgmentContext case c of ConwayRegDRep cred _deposit -> do - Set.notMember cred vsDReps ?! ConwayDRepAlreadyRegisteredVDEL cred + Set.notMember cred vsDReps ?! ConwayDRepAlreadyRegistered cred -- TODO: check against a new PParam `drepDeposit`, once PParams are updated. -- someCheck ?! ConwayDRepIncorrectDeposit deposit pure $ vState {vsDReps = Set.insert cred vsDReps} ConwayUnRegDRep cred _deposit -> do -- TODO: check against a new PParam `drepDeposit`, once PParams are updated. -- someCheck ?! ConwayDRepIncorrectDeposit deposit - Set.member cred vsDReps ?! ConwayDRepNotRegisteredVDEL cred + Set.member cred vsDReps ?! ConwayDRepNotRegistered cred pure $ vState {vsDReps = Set.delete cred vsDReps} ConwayAuthCommitteeHotKey coldK hotK -> do checkColdKeyHasNotResigned coldK vsCommitteeHotKeys @@ -154,6 +154,5 @@ conwayVDelTransition = do pure $ vState {vsCommitteeHotKeys = Map.insert coldK Nothing vsCommitteeHotKeys} where checkColdKeyHasNotResigned coldK vsCommitteeHotKeys = - (isNothing <$> Map.lookup coldK vsCommitteeHotKeys) - /= Just True - ?! ConwayCommitteeHasResignedVDEL coldK + ((isNothing <$> Map.lookup coldK vsCommitteeHotKeys) /= Just True) + ?! ConwayCommitteeHasResigned coldK diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs index 86ba92569fd..b24550de1d8 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs @@ -34,14 +34,14 @@ import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..)) import Cardano.Ledger.Binary.Coders import Cardano.Ledger.Block (txid) import Cardano.Ledger.Conway.Core -import Cardano.Ledger.Conway.Era (ConwayCERTS, ConwayLEDGER, ConwayTALLY, ConwayUTXOW) +import Cardano.Ledger.Conway.Era (ConwayCERTS, ConwayGOV, ConwayLEDGER, ConwayUTXOW) import Cardano.Ledger.Conway.Governance ( + ConwayGovState, ConwayGovernance (..), - ConwayTallyState, GovernanceProcedures (..), ) import Cardano.Ledger.Conway.Rules.Certs (ConwayCertsEvent, ConwayCertsPredFailure) -import Cardano.Ledger.Conway.Rules.Tally (ConwayTallyPredFailure, TallyEnv (..)) +import Cardano.Ledger.Conway.Rules.Gov (ConwayGovPredFailure, GovEnv (..)) import Cardano.Ledger.Conway.Tx (AlonzoEraTx (..)) import Cardano.Ledger.Credential (Credential) import Cardano.Ledger.Crypto (Crypto (..)) @@ -95,7 +95,7 @@ import NoThunks.Class (NoThunks (..)) data ConwayLedgerPredFailure era = ConwayUtxowFailure (PredicateFailure (EraRule "UTXOW" era)) | ConwayCertsFailure (PredicateFailure (EraRule "CERTS" era)) - | ConwayTallyFailure (PredicateFailure (EraRule "TALLY" era)) -- Subtransition Failures + | ConwayGovFailure (PredicateFailure (EraRule "GOV" era)) -- Subtransition Failures | ConwayWdrlNotDelegatedToDRep (Set (Credential 'Staking (EraCrypto era))) deriving (Generic) @@ -103,7 +103,7 @@ deriving instance ( Era era , Eq (PredicateFailure (EraRule "UTXOW" era)) , Eq (PredicateFailure (EraRule "CERTS" era)) - , Eq (PredicateFailure (EraRule "TALLY" era)) + , Eq (PredicateFailure (EraRule "GOV" era)) ) => Eq (ConwayLedgerPredFailure era) @@ -111,7 +111,7 @@ deriving instance ( Era era , Show (PredicateFailure (EraRule "UTXOW" era)) , Show (PredicateFailure (EraRule "CERTS" era)) - , Show (PredicateFailure (EraRule "TALLY" era)) + , Show (PredicateFailure (EraRule "GOV" era)) ) => Show (ConwayLedgerPredFailure era) @@ -119,7 +119,7 @@ instance ( Era era , NoThunks (PredicateFailure (EraRule "UTXOW" era)) , NoThunks (PredicateFailure (EraRule "CERTS" era)) - , NoThunks (PredicateFailure (EraRule "TALLY" era)) + , NoThunks (PredicateFailure (EraRule "GOV" era)) ) => NoThunks (ConwayLedgerPredFailure era) @@ -127,7 +127,7 @@ instance ( Era era , NFData (PredicateFailure (EraRule "UTXOW" era)) , NFData (PredicateFailure (EraRule "CERTS" era)) - , NFData (PredicateFailure (EraRule "TALLY" era)) + , NFData (PredicateFailure (EraRule "GOV" era)) ) => NFData (ConwayLedgerPredFailure era) @@ -135,7 +135,7 @@ instance ( Era era , EncCBOR (PredicateFailure (EraRule "UTXOW" era)) , EncCBOR (PredicateFailure (EraRule "CERTS" era)) - , EncCBOR (PredicateFailure (EraRule "TALLY" era)) + , EncCBOR (PredicateFailure (EraRule "GOV" era)) ) => EncCBOR (ConwayLedgerPredFailure era) where @@ -143,7 +143,7 @@ instance encode . \case ConwayUtxowFailure x -> Sum (ConwayUtxowFailure @era) 1 !> To x ConwayCertsFailure x -> Sum (ConwayCertsFailure @era) 2 !> To x - ConwayTallyFailure x -> Sum (ConwayTallyFailure @era) 3 !> To x + ConwayGovFailure x -> Sum (ConwayGovFailure @era) 3 !> To x ConwayWdrlNotDelegatedToDRep x -> Sum (ConwayWdrlNotDelegatedToDRep @era) 4 !> To x @@ -151,7 +151,7 @@ instance ( Era era , DecCBOR (PredicateFailure (EraRule "UTXOW" era)) , DecCBOR (PredicateFailure (EraRule "CERTS" era)) - , DecCBOR (PredicateFailure (EraRule "TALLY" era)) + , DecCBOR (PredicateFailure (EraRule "GOV" era)) ) => DecCBOR (ConwayLedgerPredFailure era) where @@ -159,30 +159,30 @@ instance decode $ Summands "ConwayLedgerPredFailure" $ \case 1 -> SumD ConwayUtxowFailure SumD ConwayCertsFailure SumD ConwayTallyFailure SumD ConwayGovFailure Invalid n data ConwayLedgerEvent era = UtxowEvent (Event (EraRule "UTXOW" era)) | CertsEvent (Event (EraRule "CERTS" era)) - | TallyEvent (Event (EraRule "TALLY" era)) + | GovEvent (Event (EraRule "GOV" era)) instance ( AlonzoEraTx era , ConwayEraTxBody era , GovernanceState era ~ ConwayGovernance era , Embed (EraRule "UTXOW" era) (ConwayLEDGER era) - , Embed (EraRule "TALLY" era) (ConwayLEDGER era) + , Embed (EraRule "GOV" era) (ConwayLEDGER era) , Embed (EraRule "CERTS" era) (ConwayLEDGER era) , State (EraRule "UTXOW" era) ~ UTxOState era , State (EraRule "CERTS" era) ~ CertState era - , State (EraRule "TALLY" era) ~ ConwayTallyState era + , State (EraRule "GOV" era) ~ ConwayGovState era , Environment (EraRule "UTXOW" era) ~ UtxoEnv era , Environment (EraRule "CERTS" era) ~ DelegsEnv era - , Environment (EraRule "TALLY" era) ~ TallyEnv era + , Environment (EraRule "GOV" era) ~ GovEnv era , Signal (EraRule "UTXOW" era) ~ Tx era , Signal (EraRule "CERTS" era) ~ Seq (TxCert era) - , Signal (EraRule "TALLY" era) ~ GovernanceProcedures era + , Signal (EraRule "GOV" era) ~ GovernanceProcedures era ) => STS (ConwayLEDGER era) where @@ -228,17 +228,17 @@ ledgerTransition :: , Environment (someLEDGER era) ~ LedgerEnv era , PredicateFailure (someLEDGER era) ~ ConwayLedgerPredFailure era , Embed (EraRule "UTXOW" era) (someLEDGER era) - , Embed (EraRule "TALLY" era) (someLEDGER era) + , Embed (EraRule "GOV" era) (someLEDGER era) , Embed (EraRule "CERTS" era) (someLEDGER era) , State (EraRule "UTXOW" era) ~ UTxOState era , State (EraRule "CERTS" era) ~ CertState era - , State (EraRule "TALLY" era) ~ ConwayTallyState era + , State (EraRule "GOV" era) ~ ConwayGovState era , Environment (EraRule "UTXOW" era) ~ UtxoEnv era - , Environment (EraRule "TALLY" era) ~ TallyEnv era + , Environment (EraRule "GOV" era) ~ GovEnv era , Environment (EraRule "CERTS" era) ~ DelegsEnv era , Signal (EraRule "UTXOW" era) ~ Tx era , Signal (EraRule "CERTS" era) ~ Seq (TxCert era) - , Signal (EraRule "TALLY" era) ~ GovernanceProcedures era + , Signal (EraRule "GOV" era) ~ GovernanceProcedures era , BaseM (someLEDGER era) ~ ShelleyBase , STS (someLEDGER era) ) => @@ -280,11 +280,11 @@ ledgerTransition = do epoch <- liftSTS $ do ei <- asks epochInfoPure epochInfoEpoch ei slot - tallySt' <- - trans @(EraRule "TALLY" era) $ + govSt' <- + trans @(EraRule "GOV" era) $ TRC - ( TallyEnv (txid txBody) epoch - , cgTally govSt + ( GovEnv (txid txBody) epoch + , cgGov govSt , govProcedures ) @@ -292,7 +292,7 @@ ledgerTransition = do trans @(EraRule "UTXOW" era) $ TRC ( UtxoEnv @era slot pp certState genCerts - , utxoSt {utxosGovernance = govSt {cgTally = tallySt'}} + , utxoSt {utxosGovernance = govSt {cgGov = govSt'}} , tx ) pure $ LedgerState utxoSt' certState' @@ -340,19 +340,19 @@ instance instance ( Embed (EraRule "UTXOW" era) (ConwayLEDGER era) , Embed (EraRule "CERTS" era) (ConwayLEDGER era) - , Embed (EraRule "TALLY" era) (ConwayLEDGER era) + , Embed (EraRule "GOV" era) (ConwayLEDGER era) , AlonzoEraTx era , ConwayEraTxBody era , GovernanceState era ~ ConwayGovernance era , Environment (EraRule "UTXOW" era) ~ UtxoEnv era , Environment (EraRule "CERTS" era) ~ DelegsEnv era - , Environment (EraRule "TALLY" era) ~ TallyEnv era + , Environment (EraRule "GOV" era) ~ GovEnv era , Signal (EraRule "UTXOW" era) ~ Tx era , Signal (EraRule "CERTS" era) ~ Seq (TxCert era) - , Signal (EraRule "TALLY" era) ~ GovernanceProcedures era + , Signal (EraRule "GOV" era) ~ GovernanceProcedures era , State (EraRule "UTXOW" era) ~ UTxOState era , State (EraRule "CERTS" era) ~ CertState era - , State (EraRule "TALLY" era) ~ ConwayTallyState era + , State (EraRule "GOV" era) ~ ConwayGovState era , PredicateFailure (EraRule "LEDGER" era) ~ ConwayLedgerPredFailure era , Event (EraRule "LEDGER" era) ~ ConwayLedgerEvent era ) => @@ -364,10 +364,10 @@ instance instance ( Era era , BaseM (ConwayLEDGER era) ~ ShelleyBase - , PredicateFailure (EraRule "TALLY" era) ~ ConwayTallyPredFailure era - , Event (EraRule "TALLY" era) ~ () + , PredicateFailure (EraRule "GOV" era) ~ ConwayGovPredFailure era + , Event (EraRule "GOV" era) ~ () ) => - Embed (ConwayTALLY era) (ConwayLEDGER era) + Embed (ConwayGOV era) (ConwayLEDGER era) where - wrapFailed = ConwayTallyFailure - wrapEvent = TallyEvent + wrapFailed = ConwayGovFailure + wrapEvent = GovEvent diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/NewEpoch.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/NewEpoch.hs index 86054d4434d..4c6620edef5 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/NewEpoch.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/NewEpoch.hs @@ -172,7 +172,7 @@ newEpochTransition = do -- | tell a RupdEvent as a DeltaRewardEvent only if the map is non-empty tellReward :: - (Event (EraRule "RUPD" era) ~ RupdEvent (EraCrypto era)) => + Event (EraRule "RUPD" era) ~ RupdEvent (EraCrypto era) => ConwayNewEpochEvent era -> Rule (ConwayNEWEPOCH era) rtype () tellReward (DeltaRewardEvent (RupdEvent _ m)) | Map.null m = pure () diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Tickf.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Tickf.hs index 71b60bfedbe..c141fc55941 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Tickf.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Tickf.hs @@ -32,13 +32,11 @@ data ConwayTickfPredFailure era deriving (Generic) deriving instance - ( Era era - ) => + Era era => Show (ConwayTickfPredFailure era) deriving instance - ( Era era - ) => + Era era => Eq (ConwayTickfPredFailure era) instance NoThunks (ConwayTickfPredFailure era) @@ -46,8 +44,7 @@ instance NoThunks (ConwayTickfPredFailure era) data ConwayTickfEvent era instance - ( Era era - ) => + Era era => STS (ConwayTICKF era) where type State (ConwayTICKF era) = NewEpochState era diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/TxBody.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/TxBody.hs index 27bc74c0664..297cb60853e 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/TxBody.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/TxBody.hs @@ -212,7 +212,7 @@ deriving instance type instance MemoHashIndex ConwayTxBodyRaw = EraIndependentTxBody -instance (c ~ EraCrypto era) => HashAnnotated (ConwayTxBody era) EraIndependentTxBody c where +instance c ~ EraCrypto era => HashAnnotated (ConwayTxBody era) EraIndependentTxBody c where hashAnnotated = getMemoSafeHash instance diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Arbitrary.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Arbitrary.hs index 932669d2ca1..99e2a42284b 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Arbitrary.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Arbitrary.hs @@ -103,7 +103,7 @@ instance <*> arbitrary <*> arbitrary -deriving instance (Era era, Arbitrary (PParamsUpdate era)) => Arbitrary (ConwayTallyState era) +deriving instance (Era era, Arbitrary (PParamsUpdate era)) => Arbitrary (ConwayGovState era) instance (Era era, Arbitrary (PParamsUpdate era)) => Arbitrary (GovernanceActionState era) where arbitrary = @@ -178,11 +178,11 @@ instance -- Cardano.Ledger.Conway.Rules ----------------------------------------------------------- ------------------------------------------------------------------------------------------ --- TALLY +-- GOV -instance Era era => Arbitrary (TallyEnv era) where +instance Era era => Arbitrary (GovEnv era) where arbitrary = - TallyEnv + GovEnv <$> arbitrary <*> arbitrary @@ -202,13 +202,13 @@ instance (Era era, Arbitrary (PParamsUpdate era)) => Arbitrary (GovernanceProced arbitrary = GovernanceProcedures <$> arbitrary <*> arbitrary -instance Era era => Arbitrary (ConwayTallyPredFailure era) where +instance Era era => Arbitrary (ConwayGovPredFailure era) where arbitrary = GovernanceActionDoesNotExist <$> arbitrary instance ( Arbitrary (PredicateFailure (EraRule "UTXOW" era)) , Arbitrary (PredicateFailure (EraRule "CERTS" era)) - , Arbitrary (PredicateFailure (EraRule "TALLY" era)) + , Arbitrary (PredicateFailure (EraRule "GOV" era)) ) => Arbitrary (ConwayLedgerPredFailure era) where @@ -216,7 +216,7 @@ instance oneof [ ConwayUtxowFailure <$> arbitrary , ConwayCertsFailure <$> arbitrary - , ConwayTallyFailure <$> arbitrary + , ConwayGovFailure <$> arbitrary ] -- EPOCH @@ -251,15 +251,13 @@ instance -- TICKF instance - ( Era era - ) => + Era era => Arbitrary (ConwayTickfPredFailure era) where arbitrary = undefined instance - ( Era era - ) => + Era era => Arbitrary (ConwayTickfEvent era) where arbitrary = undefined @@ -285,7 +283,7 @@ instance ( Era era , Arbitrary (PredicateFailure (EraRule "DELEG" era)) , Arbitrary (PredicateFailure (EraRule "POOL" era)) - , Arbitrary (PredicateFailure (EraRule "VDEL" era)) + , Arbitrary (PredicateFailure (EraRule "GOVCERT" era)) ) => Arbitrary (ConwayCertPredFailure era) where @@ -293,14 +291,13 @@ instance oneof [ DelegFailure <$> arbitrary , PoolFailure <$> arbitrary - , VDelFailure <$> arbitrary + , GovCertFailure <$> arbitrary ] -- DELEG instance - ( Era era - ) => + Era era => Arbitrary (ConwayDelegPredFailure era) where arbitrary = @@ -313,15 +310,15 @@ instance , pure WrongCertificateTypeDELEG ] --- VDEL +-- GOVCERT -instance Era era => Arbitrary (ConwayVDelPredFailure era) where +instance Era era => Arbitrary (ConwayGovCertPredFailure era) where arbitrary = oneof - [ ConwayDRepAlreadyRegisteredVDEL <$> arbitrary - , ConwayDRepNotRegisteredVDEL <$> arbitrary - , ConwayDRepIncorrectDepositVDEL <$> arbitrary - , ConwayCommitteeHasResignedVDEL <$> arbitrary + [ ConwayDRepAlreadyRegistered <$> arbitrary + , ConwayDRepNotRegistered <$> arbitrary + , ConwayDRepIncorrectDeposit <$> arbitrary + , ConwayCommitteeHasResigned <$> arbitrary ] instance Era era => Arbitrary (ConwayPParams Identity era) where diff --git a/eras/conway/test-suite/cardano-ledger-conway-test.cabal b/eras/conway/test-suite/cardano-ledger-conway-test.cabal index a5b4cf5d405..97067bf703f 100644 --- a/eras/conway/test-suite/cardano-ledger-conway-test.cabal +++ b/eras/conway/test-suite/cardano-ledger-conway-test.cabal @@ -42,7 +42,7 @@ library cardano-ledger-babbage-test, cardano-ledger-binary:{cardano-ledger-binary, testlib} >=1.0, cardano-strict-containers, - cardano-ledger-conway:{cardano-ledger-conway, testlib} ^>=1.6, + cardano-ledger-conway:{cardano-ledger-conway, testlib} ^>=1.7, cardano-ledger-core:{cardano-ledger-core, testlib} >=1.3 && <1.6, cardano-ledger-allegra ^>=1.2, cardano-ledger-mary ^>=1.3, diff --git a/eras/conway/test-suite/cddl-files/conway.cddl b/eras/conway/test-suite/cddl-files/conway.cddl index ecd4638622f..8232275cc41 100644 --- a/eras/conway/test-suite/cddl-files/conway.cddl +++ b/eras/conway/test-suite/cddl-files/conway.cddl @@ -296,7 +296,7 @@ stake_reg_deleg_cert = (11, stake_credential, pool_keyhash, coin) vote_reg_deleg_cert = (12, stake_credential, drep, coin) stake_vote_reg_deleg_cert = (13, stake_credential, pool_keyhash, drep, coin) -; VDEL +; GOVCERT reg_committee_hot_key_cert = (14, committee_cold_keyhash, committee_hot_keyhash) unreg_committee_hot_key_cert = (15, committee_cold_keyhash) reg_drep_cert = (16, voting_credential, coin) diff --git a/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs b/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs index 545975386e9..cd3df4e07a3 100644 --- a/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs +++ b/eras/mary/impl/src/Cardano/Ledger/Mary/Value.hs @@ -559,7 +559,7 @@ The decoding strategy is to :: forall c. - (Crypto c) => + Crypto c => MaryValue c -> -- The Nothing case of the return value corresponds to a quantity that is outside -- the bounds of a Word64. x < 0 or x > (2^64 - 1) @@ -712,7 +712,7 @@ representationSize xs = abcRegionSize + pidBlockSize + anameBlockSize anameBlockSize = Semigroup.getSum $ foldMap' (Semigroup.Sum . SBS.length . assetName) assetNames -from :: forall c. (Crypto c) => CompactValue c -> MaryValue c +from :: forall c. Crypto c => CompactValue c -> MaryValue c from (CompactValueAdaOnly (CompactCoin c)) = MaryValue (fromIntegral c) (MultiAsset Map.empty) from (CompactValueMultiAsset (CompactCoin c) numAssets rep) = let mv@(MaryValue _ ma) = valueFromList (fromIntegral c) triples diff --git a/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/AllegraEraGen.hs b/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/AllegraEraGen.hs index e71f23c3580..6cac6dc1df6 100644 --- a/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/AllegraEraGen.hs +++ b/eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/AllegraEraGen.hs @@ -71,7 +71,7 @@ import Test.QuickCheck (Arbitrary, Gen, arbitrary, frequency) `instance ValidateScript (ShelleyMAEra ma c) where ...` ------------------------------------------------------------------------------} -instance (CryptoClass.Crypto c) => ScriptClass (AllegraEra c) where +instance CryptoClass.Crypto c => ScriptClass (AllegraEra c) where isKey _ (RequireSignature hk) = Just hk isKey _ _ = Nothing basescript _proxy = someLeaf @(AllegraEra c) diff --git a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/ShelleyMA/Serialisation/Golden/Encoding.hs b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/ShelleyMA/Serialisation/Golden/Encoding.hs index 64962c6bb2d..fc447866621 100644 --- a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/ShelleyMA/Serialisation/Golden/Encoding.hs +++ b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/ShelleyMA/Serialisation/Golden/Encoding.hs @@ -122,7 +122,7 @@ testUpdate = -- == Golden Tests Common to Allegra and Mary == -- ============================================= -scriptGoldenTest :: forall era. (Era era) => TestTree +scriptGoldenTest :: forall era. Era era => TestTree scriptGoldenTest = let kh0 = hashKey . snd . mkGenKey $ RawSeed 0 0 0 0 0 :: KeyHash 'Witness (EraCrypto era) kh1 = hashKey . snd . mkGenKey $ RawSeed 1 1 1 1 1 :: KeyHash 'Witness (EraCrypto era) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Genesis.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Genesis.hs index 6878c921c80..d3ad323b967 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Genesis.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Genesis.hs @@ -67,8 +67,7 @@ class initialState = initialStateFromGenesis instance - ( Crypto c - ) => + Crypto c => CanStartFromGenesis (ShelleyEra c) where fromShelleyPParams _ = id diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Mempool.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Mempool.hs index 360cce7da57..79cf9d5893b 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Mempool.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Mempool.hs @@ -98,7 +98,7 @@ unsafeMakeValidated = Validated -- era-parametrised. translateValidated :: forall era f. - (TranslateEra era f) => + TranslateEra era f => TranslationContext era -> Validated (f (PreviousEra era)) -> Except (TranslationError era f) (Validated (f era)) @@ -217,11 +217,11 @@ mkMempoolState LedgerState.NewEpochState {LedgerState.nesEs} = LedgerState.esLSt newtype ApplyTxError era = ApplyTxError [PredicateFailure (EraRule "LEDGER" era)] deriving stock instance - (Eq (PredicateFailure (EraRule "LEDGER" era))) => + Eq (PredicateFailure (EraRule "LEDGER" era)) => Eq (ApplyTxError era) deriving stock instance - (Show (PredicateFailure (EraRule "LEDGER" era))) => + Show (PredicateFailure (EraRule "LEDGER" era)) => Show (ApplyTxError era) -- TODO: This instance can be switched back to a derived version, once we are officially diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Validation.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Validation.hs index 40f2bbc0661..45292be053b 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Validation.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Validation.hs @@ -220,15 +220,15 @@ newtype TickTransitionError era deriving (Generic) instance - (NoThunks (STS.PredicateFailure (EraRule "TICK" era))) => + NoThunks (STS.PredicateFailure (EraRule "TICK" era)) => NoThunks (TickTransitionError era) deriving stock instance - (Eq (STS.PredicateFailure (EraRule "TICK" era))) => + Eq (STS.PredicateFailure (EraRule "TICK" era)) => Eq (TickTransitionError era) deriving stock instance - (Show (STS.PredicateFailure (EraRule "TICK" era))) => + Show (STS.PredicateFailure (EraRule "TICK" era)) => Show (TickTransitionError era) newtype BlockTransitionError era @@ -236,13 +236,13 @@ newtype BlockTransitionError era deriving (Generic) deriving stock instance - (Eq (STS.PredicateFailure (EraRule "BBODY" era))) => + Eq (STS.PredicateFailure (EraRule "BBODY" era)) => Eq (BlockTransitionError era) deriving stock instance - (Show (STS.PredicateFailure (EraRule "BBODY" era))) => + Show (STS.PredicateFailure (EraRule "BBODY" era)) => Show (BlockTransitionError era) instance - (NoThunks (STS.PredicateFailure (EraRule "BBODY" era))) => + NoThunks (STS.PredicateFailure (EraRule "BBODY" era)) => NoThunks (BlockTransitionError era) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockChain.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockChain.hs index 2a3b6f3c218..ce1c35c4b43 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockChain.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockChain.hs @@ -162,7 +162,7 @@ txSeqTxns (TxSeq' ts _ _ _) = ts instance forall era. - (Era era) => + Era era => EncCBORGroup (ShelleyTxSeq era) where encCBORGroup (TxSeq' _ bodyBytes witsBytes metadataBytes) = @@ -179,7 +179,7 @@ instance -- | Hash a given block body bbHash :: forall era. - (Era era) => + Era era => ShelleyTxSeq era -> Hash (EraCrypto era) EraIndependentBlockBody bbHash (TxSeq' _ bodies wits md) = diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/RefundsAndDeposits.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/RefundsAndDeposits.hs index d9a5e625457..741c762d5a9 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/RefundsAndDeposits.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/RefundsAndDeposits.hs @@ -55,8 +55,10 @@ totalCertsDeposits :: f (TxCert era) -> Coin totalCertsDeposits pp isRegPool certs = - numKeys <×> pp ^. ppKeyDepositL - <+> numNewRegPoolCerts <×> pp ^. ppPoolDepositL + numKeys + <×> (pp ^. ppKeyDepositL) + <+> numNewRegPoolCerts + <×> (pp ^. ppPoolDepositL) where numKeys = getSum @Int $ foldMap' (\x -> if isRegKey x then 1 else 0) certs numNewRegPoolCerts = Set.size (foldl' addNewPoolIds Set.empty certs) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rewards.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rewards.hs index f0235fac164..87173b24d63 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rewards.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rewards.hs @@ -304,8 +304,7 @@ rewardOnePoolMember -- the ranking information out of the ledger code and into a separate service, -- and at that point we can simplify this function to not care about ranking. mkPoolRewardInfo :: - ( EraPParams era - ) => + EraPParams era => PParams era -> Coin -> BlocksMade (EraCrypto era) -> diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs index b0db3477f0d..211b7638a05 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs @@ -146,11 +146,11 @@ bbodyTransition = actualBodySize == fromIntegral (bhviewBSize bhview) - ?! WrongBlockBodySizeBBODY actualBodySize (fromIntegral $ bhviewBSize bhview) + ?! WrongBlockBodySizeBBODY actualBodySize (fromIntegral $ bhviewBSize bhview) actualBodyHash == bhviewBHash bhview - ?! InvalidBodyHashBBODY actualBodyHash (bhviewBHash bhview) + ?! InvalidBodyHashBBODY actualBodyHash (bhviewBHash bhview) ls' <- trans @(EraRule "LEDGERS" era) $ diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs index 02475fc46d2..0f465a4d43d 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs @@ -95,9 +95,9 @@ data DelegEnv era = DelegEnv , ppDE :: PParams era -- The protocol parameters are only used for the HardFork mechanism } -deriving instance (Show (PParams era)) => Show (DelegEnv era) +deriving instance Show (PParams era) => Show (DelegEnv era) -deriving instance (Eq (PParams era)) => Eq (DelegEnv era) +deriving instance Eq (PParams era) => Eq (DelegEnv era) data ShelleyDelegPredFailure era = StakeKeyAlreadyRegisteredDELEG @@ -409,7 +409,7 @@ updateReservesAndTreasury targetPot combinedMap available ds = do let requiredForRewards = fold combinedMap requiredForRewards <= available - ?! InsufficientForInstantaneousRewardsDELEG targetPot requiredForRewards available + ?! InsufficientForInstantaneousRewardsDELEG targetPot requiredForRewards available pure $ case targetPot of ReservesMIR -> ds {dsIRewards = (dsIRewards ds) {iRReserves = combinedMap}} diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs index cd3c617a9f8..ad115285379 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs @@ -159,8 +159,7 @@ instance transitionRules = [delegsTransition] instance - ( NoThunks (PredicateFailure (EraRule "DELPL" era)) - ) => + NoThunks (PredicateFailure (EraRule "DELPL" era)) => NoThunks (ShelleyDelegsPredFailure era) instance diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs index 093f9a2b7c9..5107066d848 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs @@ -199,7 +199,7 @@ newEpochTransition = do -- | tell a RupdEvent as a DeltaRewardEvent only if the map is non-empty tellReward :: - (Event (EraRule "RUPD" era) ~ RupdEvent (EraCrypto era)) => + Event (EraRule "RUPD" era) ~ RupdEvent (EraCrypto era) => ShelleyNewEpochEvent era -> Rule (ShelleyNEWEPOCH era) rtype () tellReward (DeltaRewardEvent (RupdEvent _ m)) | Map.null m = pure () diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Newpp.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Newpp.hs index 768154f1b32..903a124478a 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Newpp.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Newpp.hs @@ -97,7 +97,7 @@ newPpTransition = do let Coin oblgCurr = obligationCertState (CertState def pstate dstate) Coin oblgCurr == utxosDeposited utxoSt - ?! UnexpectedDepositPot (Coin oblgCurr) (utxosDeposited utxoSt) + ?! UnexpectedDepositPot (Coin oblgCurr) (utxosDeposited utxoSt) if (ppNew' ^. ppMaxTxSizeL + ppNew' ^. ppMaxBHSizeL) < (ppNew' ^. ppMaxBBSizeL) then pure $ NewppState ppNew' (updatePpup ppupSt ppNew') diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Rupd.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Rupd.hs index 7ef3922453e..2b677ebb0ba 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Rupd.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Rupd.hs @@ -111,9 +111,9 @@ tellRupd _message x = tellEvent x data RewardTiming = RewardsTooEarly | RewardsJustRight | RewardsTooLate determineRewardTiming :: SlotNo -> SlotNo -> SlotNo -> RewardTiming -determineRewardTiming currentSlot startAftterSlot endSlot +determineRewardTiming currentSlot startAfterSlot endSlot | currentSlot > endSlot = RewardsTooLate - | currentSlot <= startAftterSlot = RewardsTooEarly + | currentSlot <= startAfterSlot = RewardsTooEarly | otherwise = RewardsJustRight rupdTransition :: EraPParams era => TransitionRule (ShelleyRUPD era) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs index eb2fa4fd61b..2af7bb95e16 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs @@ -314,8 +314,7 @@ deriving stock instance Eq (ShelleyTickfPredFailure era) instance - ( NoThunks (PredicateFailure (EraRule "UPEC" era)) - ) => + NoThunks (PredicateFailure (EraRule "UPEC" era)) => NoThunks (ShelleyTickfPredFailure era) newtype ShelleyTickfEvent era diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Upec.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Upec.hs index 1cb2414bbc8..4636d6982a2 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Upec.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Upec.hs @@ -124,10 +124,10 @@ votedValue :: Int -> Maybe (PParams era) votedValue (ProposedPPUpdates pup) pps quorumN = - let incrTally vote tally = 1 + Map.findWithDefault 0 vote tally + let incrGov vote gov = 1 + Map.findWithDefault 0 vote gov votes = Map.foldr - (\vote tally -> Map.insert vote (incrTally vote tally) tally) + (\vote gov -> Map.insert vote (incrGov vote gov) gov) (Map.empty :: Map (PParamsUpdate era) Int) pup consensus = Map.filter (>= quorumN) votes diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs index 08c84ea6f08..36aa41cc0e9 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxCert.hs @@ -447,17 +447,17 @@ delegCWitness (ShelleyDelegCert cred _) = cred {-# DEPRECATED delegCWitness "This was a partial function, logic rewritten in a safer way" #-} -- | Check for 'ShelleyRegCert' constructor -isRegKey :: (ShelleyEraTxCert era) => TxCert era -> Bool +isRegKey :: ShelleyEraTxCert era => TxCert era -> Bool isRegKey (RegTxCert _) = True isRegKey _ = False -- | Check for 'ShelleyUnRegCert' constructor -isDeRegKey :: (ShelleyEraTxCert era) => TxCert era -> Bool +isDeRegKey :: ShelleyEraTxCert era => TxCert era -> Bool isDeRegKey (UnRegTxCert _) = True isDeRegKey _ = False -- | Check for 'ShelleyDelegCert' constructor -isDelegation :: (ShelleyEraTxCert era) => TxCert era -> Bool +isDelegation :: ShelleyEraTxCert era => TxCert era -> Bool isDelegation (DelegStakeTxCert _ _) = True isDelegation _ = False diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxOut.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxOut.hs index 87efbc5bfd8..0f9c4151ca1 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxOut.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxOut.hs @@ -173,7 +173,7 @@ toTxOutPair (ShelleyTxOut !addr !amount) = -- a ShortByteString of the same length as the ADDRHASH -- used to calculate heapWords -packedADDRHASH :: forall proxy era. (Crypto (EraCrypto era)) => proxy era -> ShortByteString +packedADDRHASH :: forall proxy era. Crypto (EraCrypto era) => proxy era -> ShortByteString packedADDRHASH _ = pack $ replicate diff --git a/eras/shelley/test-suite/bench/BenchValidation.hs b/eras/shelley/test-suite/bench/BenchValidation.hs index a5fc7c752dc..1e69eee4553 100644 --- a/eras/shelley/test-suite/bench/BenchValidation.hs +++ b/eras/shelley/test-suite/bench/BenchValidation.hs @@ -204,13 +204,13 @@ genUpdateInputs utxoSize = do ) updateChain :: - (Mock c) => + Mock c => UpdateInputs c -> Either (ChainTransitionError c) (ChainDepState c) updateChain (UpdateInputs gl lv bh st) = updateChainDepState gl lv bh st updateAndTickChain :: - (Mock c) => + Mock c => UpdateInputs c -> Either (ChainTransitionError c) (ChainDepState c) updateAndTickChain (UpdateInputs gl lv bh st) = diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Core.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Core.hs index f49d396c2d5..336bdddb3b5 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Core.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Core.hs @@ -320,7 +320,7 @@ mkGenesisDelegatesHashMap coreNodes genesisDelegates = -- | Generate a mapping from stake key hash to stake key pair, from a list of -- (payment, staking) key pairs. -mkStakeKeyHashMap :: (Crypto c) => KeyPairs c -> Map (KeyHash 'Staking c) (KeyPair 'Staking c) +mkStakeKeyHashMap :: Crypto c => KeyPairs c -> Map (KeyHash 'Staking c) (KeyPair 'Staking c) mkStakeKeyHashMap keyPairs = Map.fromList (f <$> keyPairs) where diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Presets.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Presets.hs index 658f2fd511c..7de2f078048 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Presets.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Presets.hs @@ -54,7 +54,7 @@ import Test.Cardano.Ledger.Shelley.Utils ( -- corresponding keyspace. genEnv :: forall era. - (EraGen era) => + EraGen era => Proxy era -> Constants -> GenEnv era @@ -125,7 +125,7 @@ stakePoolKeys c = -- | Generate all keys for any entity which will be issuing blocks. issuerKeys :: - (Crypto c) => + Crypto c => Constants -> -- | Namespace parameter. Can be used to differentiate between different -- "types" of issuer. diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/ScriptClass.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/ScriptClass.hs index ae50b86fe7f..27579d33b74 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/ScriptClass.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/ScriptClass.hs @@ -133,12 +133,12 @@ scriptKeyCombinations prox script = case quantify prox script of -- | Make a simple (non-combined, ie NO quantifer like All, Any, MofN, etc.) script. -- 'basescript' is a method of ScriptClass, and is different for every Era. -mkScriptFromKey :: forall era. (ScriptClass era) => KeyPair 'Witness (EraCrypto era) -> Core.Script era +mkScriptFromKey :: forall era. ScriptClass era => KeyPair 'Witness (EraCrypto era) -> Core.Script era mkScriptFromKey = (basescript (Proxy :: Proxy era) . hashKey . vKey) mkScriptsFromKeyPair :: forall era. - (ScriptClass era) => + ScriptClass era => (KeyPair 'Payment (EraCrypto era), KeyPair 'Staking (EraCrypto era)) -> (Core.Script era, Core.Script era) mkScriptsFromKeyPair (k0, k1) = @@ -147,14 +147,14 @@ mkScriptsFromKeyPair (k0, k1) = -- | make Scripts based on the given key pairs mkScripts :: forall era. - (ScriptClass era) => + ScriptClass era => KeyPairs (EraCrypto era) -> [(Core.Script era, Core.Script era)] mkScripts = map (mkScriptsFromKeyPair @era) mkPayScriptHashMap :: forall era. - (ScriptClass era) => + ScriptClass era => [(Core.Script era, Core.Script era)] -> Map.Map (ScriptHash (EraCrypto era)) (Core.Script era, Core.Script era) mkPayScriptHashMap scripts = @@ -165,7 +165,7 @@ mkPayScriptHashMap scripts = -- | Generate a mapping from stake script hash to script pair. mkStakeScriptHashMap :: forall era. - (ScriptClass era) => + ScriptClass era => [(Core.Script era, Core.Script era)] -> Map.Map (ScriptHash (EraCrypto era)) (Core.Script era, Core.Script era) mkStakeScriptHashMap scripts = @@ -178,7 +178,7 @@ mkStakeScriptHashMap scripts = -- many pairs in order not to create too many of the possible combinations. mkScriptCombinations :: forall era. - (ScriptClass era) => + ScriptClass era => [(Core.Script era, Core.Script era)] -> [(Core.Script era, Core.Script era)] mkScriptCombinations msigs = @@ -237,7 +237,7 @@ keyPairs :: CC.Crypto c => Constants -> KeyPairs c keyPairs Constants {maxNumKeyPairs} = mkKeyPairs <$> [1 .. maxNumKeyPairs] mkKeyPairs :: - (DSIGNAlgorithm (DSIGN c)) => + DSIGNAlgorithm (DSIGN c) => Word64 -> (KeyPair kr c, KeyPair kr' c) mkKeyPairs n = diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/ShelleyEraGen.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/ShelleyEraGen.hs index 8c047b5f453..62c1834b4d6 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/ShelleyEraGen.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/ShelleyEraGen.hs @@ -139,7 +139,7 @@ genTimeToLive currentSlot = do ttl <- genNatural 50 100 pure $ currentSlot + SlotNo (fromIntegral ttl) -instance (Mock c) => MinGenTxout (ShelleyEra c) where +instance Mock c => MinGenTxout (ShelleyEra c) where calcEraMinUTxO _txout = view ppMinUTxOValueL addValToTxOut v (ShelleyTxOut a u) = ShelleyTxOut a (v <+> u) genEraTxOut _genenv genVal addrs = do diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/TxCert.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/TxCert.hs index 0b4705f6254..9ef015a614c 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/TxCert.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/TxCert.hs @@ -88,13 +88,11 @@ newtype CertsEvent era = CertsEvent (Event (Core.EraRule "DELPL" era)) deriving stock instance - ( Eq (PredicateFailure (Core.EraRule "DELPL" era)) - ) => + Eq (PredicateFailure (Core.EraRule "DELPL" era)) => Eq (CertsPredicateFailure era) deriving stock instance - ( Show (PredicateFailure (Core.EraRule "DELPL" era)) - ) => + Show (PredicateFailure (Core.EraRule "DELPL" era)) => Show (CertsPredicateFailure era) instance diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rewards.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rewards.hs index a502fd172df..66388d87e27 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rewards.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rewards.hs @@ -615,8 +615,7 @@ overrideProtocolVersionUsedInRewardCalc pv es = oldEqualsNew :: forall era. - ( era ~ C - ) => + era ~ C => ProtVer -> NewEpochState era -> Property @@ -644,8 +643,7 @@ oldEqualsNew pv newepochstate = oldEqualsNewOn :: forall era. - ( era ~ C - ) => + era ~ C => ProtVer -> NewEpochState era -> Property diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/AdaPreservation.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/AdaPreservation.hs index a3c72fefc44..f9903effc03 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/AdaPreservation.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/AdaPreservation.hs @@ -325,7 +325,7 @@ utxoDepositsIncreaseByFeesWithdrawals SourceSignalTarget {source, signal, target circulation target <-> circulation source === withdrawals signal - <-> txFees ledgerTr + <-> txFees ledgerTr where us = lsUTxOState . esLState . nesEs . chainNes circulation chainSt = @@ -407,8 +407,8 @@ potsSumIncreaseByRewardsPerTx SourceSignalTarget {source = chainSt, signal = blo } = (coinBalance u' <+> d' <+> f') <-> (coinBalance u <+> d <+> f) - === (UM.fromCompact (sumRewardsUView (UM.RewDepUView umap1))) - <-> (UM.fromCompact (sumRewardsUView (UM.RewDepUView umap2))) + === UM.fromCompact (sumRewardsUView (UM.RewDepUView umap1)) + <-> UM.fromCompact (sumRewardsUView (UM.RewDepUView umap2)) -- | The Rewards pot decreases by the sum of withdrawals in a transaction potsRewardsDecreaseByWithdrawalsPerTx :: @@ -478,8 +478,7 @@ preserveBalance SourceSignalTarget {source = chainSt, signal = block} = txb = tx ^. bodyTxL created = coinBalance u' - <+> txb - ^. feeTxBodyL + <+> (txb ^. feeTxBodyL) <+> totalTxDeposits pp_ dpstate txb consumed_ = coinBalance u diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/ClassifyTraces.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/ClassifyTraces.hs index 85f6faa4209..f40978a9063 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/ClassifyTraces.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/ClassifyTraces.hs @@ -224,7 +224,7 @@ relevantCasesAreCoveredForTrace tr = do -- | Ratio of certificates with script credentials to the number of certificates -- that could have script credentials. -scriptCredentialCertsRatio :: (ShelleyEraTxCert c) => [TxCert c] -> Double +scriptCredentialCertsRatio :: ShelleyEraTxCert c => [TxCert c] -> Double scriptCredentialCertsRatio certs = ratioInt haveScriptCerts couldhaveScriptCerts where diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Deleg.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Deleg.hs index 5d5a537e1cb..f58ba3d3e3a 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Deleg.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Deleg.hs @@ -95,7 +95,7 @@ tests = in conjoin (map (delegProp delegEnv) delegSsts) -- | Check stake key registration -keyRegistration :: (ShelleyEraTxCert era) => SourceSignalTarget (ShelleyDELEG era) -> Property +keyRegistration :: ShelleyEraTxCert era => SourceSignalTarget (ShelleyDELEG era) -> Property keyRegistration SourceSignalTarget { signal = RegTxCert hk @@ -112,7 +112,7 @@ keyRegistration keyRegistration _ = property () -- | Check stake key de-registration -keyDeRegistration :: (ShelleyEraTxCert era) => SourceSignalTarget (ShelleyDELEG era) -> Property +keyDeRegistration :: ShelleyEraTxCert era => SourceSignalTarget (ShelleyDELEG era) -> Property keyDeRegistration SourceSignalTarget { signal = UnRegTxCert hk @@ -129,7 +129,7 @@ keyDeRegistration keyDeRegistration _ = property () -- | Check stake key delegation -keyDelegation :: (ShelleyEraTxCert era) => SourceSignalTarget (ShelleyDELEG era) -> Property +keyDelegation :: ShelleyEraTxCert era => SourceSignalTarget (ShelleyDELEG era) -> Property keyDelegation SourceSignalTarget { signal = DelegStakeTxCert from to diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/GoldenUtils.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/GoldenUtils.hs index a08eaf6878b..acb99a94fc4 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/GoldenUtils.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/GoldenUtils.hs @@ -80,7 +80,7 @@ checkEncoding :: checkEncoding v encode decode name x t = checkEncodingWithRoundtrip v encode decode roundTripSuccess name x t checkEncodingWithRoundtrip :: - (HasCallStack) => + HasCallStack => Version -> (a -> Encoding) -> (BSL.ByteString -> Either DecoderError a) -> diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs index 3a2ed0917ca..fbc8bf23c3d 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs @@ -151,7 +151,7 @@ evolveNonceUnfrozen n cs = -- instead use 'newEpoch'. newLab :: forall era. - (Era era) => + Era era => Block (BHeader (EraCrypto era)) era -> ChainState era -> ChainState era diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/GenesisDelegation.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/GenesisDelegation.hs index 389c51a348c..38d2bb225a8 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/GenesisDelegation.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/GenesisDelegation.hs @@ -173,7 +173,7 @@ txEx1 = ShelleyTx txbodyEx1 txwits SNothing blockEx1 :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx1 = mkBlockFakeVRF @(ShelleyEra c) @@ -200,7 +200,7 @@ newGenDeleg = expectedStEx1 :: forall c. - (ExMock c) => + ExMock c => ChainState (ShelleyEra c) expectedStEx1 = C.evolveNonceUnfrozen (getBlockNonce @(ShelleyEra c) blockEx1) @@ -214,7 +214,7 @@ expectedStEx1 = -- -- In the first block, stage a new future genesis delegate genesisDelegation1 :: - (ExMock c) => + ExMock c => CHAINExample (BHeader c) (ShelleyEra c) genesisDelegation1 = CHAINExample initStGenesisDeleg blockEx1 (Right expectedStEx1) @@ -224,7 +224,7 @@ genesisDelegation1 = CHAINExample initStGenesisDeleg blockEx1 (Right expectedStE blockEx2 :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx2 = mkBlockFakeVRF @(ShelleyEra c) diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Mir.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Mir.hs index 2dd552ab263..6abc5051802 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Mir.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Mir.hs @@ -165,7 +165,7 @@ insufficientMIRWits = mirWits [0 .. 3] txEx1 :: forall c. - (Mock c) => + Mock c => [KeyPair 'Witness c] -> MIRPot -> ShelleyTx (ShelleyEra c) @@ -182,7 +182,7 @@ txEx1 txwits pot = blockEx1' :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => [KeyPair 'Witness (EraCrypto (ShelleyEra c))] -> MIRPot -> Block (BHeader c) (ShelleyEra c) @@ -202,14 +202,14 @@ blockEx1' txwits pot = blockEx1 :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => MIRPot -> Block (BHeader c) (ShelleyEra c) blockEx1 = blockEx1' sufficientMIRWits expectedStEx1' :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => [KeyPair 'Witness (EraCrypto (ShelleyEra c))] -> MIRPot -> ChainState (ShelleyEra c) @@ -224,7 +224,7 @@ expectedStEx1' txwits pot = expectedStEx1 :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => MIRPot -> ChainState (ShelleyEra c) expectedStEx1 = expectedStEx1' sufficientMIRWits @@ -232,7 +232,7 @@ expectedStEx1 = expectedStEx1' sufficientMIRWits -- === Block 1, Slot 10, Epoch 0, Successful MIR Reserves Example -- -- In the first block, submit a MIR cert drawing from the reserves. -mir1 :: (ExMock (EraCrypto (ShelleyEra c))) => MIRPot -> CHAINExample (BHeader c) (ShelleyEra c) +mir1 :: ExMock (EraCrypto (ShelleyEra c)) => MIRPot -> CHAINExample (BHeader c) (ShelleyEra c) mir1 pot = CHAINExample (initStMIR (Coin 1000)) @@ -244,8 +244,7 @@ mir1 pot = -- In the first block, submit a MIR cert drawing from the reserves. mirFailWits :: forall c. - ( ExMock (EraCrypto (ShelleyEra c)) - ) => + ExMock (EraCrypto (ShelleyEra c)) => MIRPot -> CHAINExample (BHeader c) (ShelleyEra c) mirFailWits pot = @@ -270,7 +269,7 @@ mirFailWits pot = -- -- In the first block, submit a MIR cert drawing from the reserves. mirFailFunds :: - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => MIRPot -> Coin -> Coin -> @@ -305,7 +304,7 @@ mirFailFunds pot treasury llNeeded llReceived = blockEx2 :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => MIRPot -> Block (BHeader c) (ShelleyEra c) blockEx2 pot = @@ -324,14 +323,14 @@ blockEx2 pot = pulserEx2 :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => MIRPot -> PulsingRewUpdate c pulserEx2 pot = makePulser' (expectedStEx1 pot) expectedStEx2 :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => MIRPot -> ChainState (ShelleyEra c) expectedStEx2 pot = @@ -344,7 +343,7 @@ expectedStEx2 pot = -- -- Submit an empty block to create an empty reward update. mir2 :: - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => MIRPot -> CHAINExample (BHeader c) (ShelleyEra c) mir2 pot = @@ -359,14 +358,14 @@ mir2 pot = epoch1Nonce :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => MIRPot -> Nonce epoch1Nonce pot = chainCandidateNonce (expectedStEx2 @c pot) blockEx3 :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => MIRPot -> Block (BHeader c) (ShelleyEra c) blockEx3 pot = @@ -385,7 +384,7 @@ blockEx3 pot = expectedStEx3 :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => MIRPot -> ChainState (ShelleyEra c) expectedStEx3 pot = @@ -398,7 +397,7 @@ expectedStEx3 pot = -- === Block 3, Slot 110, Epoch 1 -- -- Submit an empty block in the next epoch to apply the MIR rewards. -mir3 :: (ExMock (EraCrypto (ShelleyEra c))) => MIRPot -> CHAINExample (BHeader c) (ShelleyEra c) +mir3 :: ExMock (EraCrypto (ShelleyEra c)) => MIRPot -> CHAINExample (BHeader c) (ShelleyEra c) mir3 pot = CHAINExample (expectedStEx2 pot) (blockEx3 pot) (Right $ expectedStEx3 pot) -- diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolLifetime.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolLifetime.hs index 3de0a892926..d9bb363a8da 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolLifetime.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolLifetime.hs @@ -220,7 +220,7 @@ txbodyEx1 = SNothing SNothing -txEx1 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ShelleyTx (ShelleyEra c) +txEx1 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ShelleyTx (ShelleyEra c) txEx1 = ShelleyTx txbodyEx1 @@ -258,7 +258,7 @@ blockEx1 = 0 (mkOCert (coreNodeKeysBySchedule @(ShelleyEra c) ppEx 10) 0 (KESPeriod 0)) -expectedStEx1 :: forall c. (ExMock c) => ChainState (ShelleyEra c) +expectedStEx1 :: forall c. ExMock c => ChainState (ShelleyEra c) expectedStEx1 = C.evolveNonceUnfrozen (getBlockNonce (blockEx1 @c)) . C.newLab blockEx1 @@ -278,7 +278,7 @@ expectedStEx1 = -- all register stake credentials, and Alice registers a stake pool. -- Additionally, a MIR certificate is issued to draw from the reserves -- and give Carl and Daria (who is unregistered) rewards. -poolLifetime1 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolLifetime1 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolLifetime1 = CHAINExample initStPoolLifetime blockEx1 (Right expectedStEx1) -- @@ -317,7 +317,7 @@ txbodyEx2 = , stbMDHash = SNothing } -txEx2 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ShelleyTx (ShelleyEra c) +txEx2 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ShelleyTx (ShelleyEra c) txEx2 = ShelleyTx txbodyEx2 @@ -332,7 +332,7 @@ txEx2 = } SNothing -blockEx2 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx2 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx2 = mkBlockFakeVRF (bhHash $ bheader @(BHeader c) @(ShelleyEra c) blockEx1) @@ -379,12 +379,12 @@ makeCompletedPulser :: PulsingRewUpdate (EraCrypto era) makeCompletedPulser bs cs = Complete . fst . runShelleyBase . completeRupd $ makePulser bs cs -pulserEx2 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => PulsingRewUpdate c +pulserEx2 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => PulsingRewUpdate c pulserEx2 = makeCompletedPulser (BlocksMade mempty) expectedStEx1 expectedStEx2 :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx2 = C.evolveNonceFrozen (getBlockNonce (blockEx2 @c)) @@ -399,17 +399,17 @@ expectedStEx2 = -- === Block 2, Slot 90, Epoch 0 -- -- In the second block Alice and Bob both delegation to Alice's Pool. -poolLifetime2 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolLifetime2 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolLifetime2 = CHAINExample expectedStEx1 blockEx2 (Right expectedStEx2) -- -- Block 3, Slot 110, Epoch 1 -- -epoch1Nonce :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Nonce +epoch1Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce epoch1Nonce = chainCandidateNonce (expectedStEx2 @c) -blockEx3 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx3 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx3 = mkBlockFakeVRF (bhHash $ bheader @(BHeader c) @(ShelleyEra c) blockEx2) @@ -441,7 +441,7 @@ snapEx3 = expectedStEx3 :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx3 = C.newEpoch blockEx3 @@ -454,7 +454,7 @@ expectedStEx3 = -- -- In the third block, an empty block in a new epoch, the first snapshot is created. -- The rewards accounts from the MIR certificate in block 1 are now increased. -poolLifetime3 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolLifetime3 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolLifetime3 = CHAINExample expectedStEx2 blockEx3 (Right expectedStEx3) -- @@ -482,7 +482,7 @@ txbodyEx4 = , stbMDHash = SNothing } -txEx4 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ShelleyTx (ShelleyEra c) +txEx4 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ShelleyTx (ShelleyEra c) txEx4 = ShelleyTx txbodyEx4 @@ -494,7 +494,7 @@ txEx4 = } SNothing -blockEx4 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx4 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx4 = mkBlockFakeVRF (bhHash $ bheader @(BHeader c) @(ShelleyEra c) blockEx3) @@ -509,7 +509,7 @@ blockEx4 = 0 (mkOCert (coreNodeKeysBySchedule @(ShelleyEra c) ppEx 190) 0 (KESPeriod 0)) -pulserEx4 :: forall c. (ExMock c) => PulsingRewUpdate c +pulserEx4 :: forall c. ExMock c => PulsingRewUpdate c pulserEx4 = makeCompletedPulser (BlocksMade mempty) expectedStEx3 rewardUpdateEx4 :: forall c. RewardUpdate c @@ -524,7 +524,7 @@ rewardUpdateEx4 = expectedStEx4 :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx4 = C.evolveNonceFrozen (getBlockNonce (blockEx4 @c)) @@ -540,10 +540,10 @@ expectedStEx4 = -- We process a block late enough in the epoch in order to create a second reward update, -- preparing the way for the first non-empty pool distribution in this running example. -- Additionally, in order to have the stake distribution change, Carl delegates his stake. -poolLifetime4 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolLifetime4 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolLifetime4 = CHAINExample expectedStEx3 blockEx4 (Right expectedStEx4) -epoch2Nonce :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Nonce +epoch2Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce epoch2Nonce = chainCandidateNonce (expectedStEx4 @c) ⭒ hashHeaderToNonce (bhHash $ bheader (blockEx2 @c)) @@ -552,7 +552,7 @@ epoch2Nonce = -- Block 5, Slot 220, Epoch 2 -- -blockEx5 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx5 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx5 = mkBlockFakeVRF (bhHash $ bheader @(BHeader c) @(ShelleyEra c) blockEx4) @@ -593,7 +593,7 @@ pdEx5 = expectedStEx5 :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx5 = C.newEpoch blockEx5 @@ -609,14 +609,14 @@ expectedStEx5 = -- -- Create the first non-empty pool distribution -- by creating a block in the third epoch of this running example. -poolLifetime5 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolLifetime5 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolLifetime5 = CHAINExample expectedStEx4 blockEx5 (Right expectedStEx5) -- -- Block 6, Slot 295, Epoch 2 -- -blockEx6 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx6 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx6 = mkBlockFakeVRF (bhHash $ bheader @(BHeader c) @(ShelleyEra c) blockEx5) @@ -641,10 +641,10 @@ rewardUpdateEx6 = , nonMyopic = def {rewardPotNM = Coin 4} } -pulserEx6 :: forall c. (ExMock c) => PulsingRewUpdate c +pulserEx6 :: forall c. ExMock c => PulsingRewUpdate c pulserEx6 = makeCompletedPulser (BlocksMade mempty) expectedStEx5 -expectedStEx6 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx6 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx6 = C.evolveNonceFrozen (getBlockNonce (blockEx6 @c)) . C.newLab blockEx6 @@ -656,19 +656,19 @@ expectedStEx6 = -- === Block 6, Slot 295, Epoch 2 -- -- Create a decentralized Praos block (ie one not in the overlay schedule) -poolLifetime6 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolLifetime6 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolLifetime6 = CHAINExample expectedStEx5 blockEx6 (Right expectedStEx6) -- -- Block 7, Slot 310, Epoch 3 -- -epoch3Nonce :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Nonce +epoch3Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce epoch3Nonce = chainCandidateNonce (expectedStEx6 @c) ⭒ hashHeaderToNonce (bhHash $ bheader (blockEx4 @c)) -blockEx7 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx7 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx7 = mkBlockFakeVRF (bhHash $ bheader @(BHeader c) @(ShelleyEra c) blockEx6) @@ -683,7 +683,7 @@ blockEx7 = 15 (mkOCert (coreNodeKeysBySchedule @(ShelleyEra c) ppEx 310) 1 (KESPeriod 15)) -expectedStEx7 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx7 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx7 = C.newEpoch blockEx7 . C.newSnapshot snapEx5 (Coin 0) @@ -697,14 +697,14 @@ expectedStEx7 = -- -- Create an empty block in the next epoch -- to prepare the way for the first non-trivial reward update -poolLifetime7 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolLifetime7 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolLifetime7 = CHAINExample expectedStEx6 blockEx7 (Right expectedStEx7) -- -- Block 8, Slot 390, Epoch 3 -- -blockEx8 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx8 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx8 = mkBlockFakeVRF (bhHash $ bheader @(BHeader c) @(ShelleyEra c) blockEx7) @@ -756,7 +756,7 @@ nonMyopicEx8 = (Map.singleton (aikColdKeyHash Cast.alicePoolKeys) alicePerfEx8) rewardPot8 -pulserEx8 :: forall c. (ExMock c) => PulsingRewUpdate c +pulserEx8 :: forall c. ExMock c => PulsingRewUpdate c pulserEx8 = makeCompletedPulser (BlocksMade $ Map.singleton (aikColdKeyHash Cast.alicePoolKeys) 1) expectedStEx7 @@ -780,7 +780,7 @@ rewardUpdateEx8 = , nonMyopic = nonMyopicEx8 } -expectedStEx8 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx8 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx8 = C.evolveNonceFrozen (getBlockNonce (blockEx8 @c)) . C.newLab blockEx8 @@ -793,19 +793,19 @@ expectedStEx8 = -- === Block 8, Slot 390, Epoch 3 -- -- Create the first non-trivial reward update. -poolLifetime8 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolLifetime8 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolLifetime8 = CHAINExample expectedStEx7 blockEx8 (Right expectedStEx8) -- -- Block 9, Slot 410, Epoch 4 -- -epoch4Nonce :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Nonce +epoch4Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce epoch4Nonce = chainCandidateNonce (expectedStEx8 @c) ⭒ hashHeaderToNonce (bhHash $ bheader (blockEx6 @c)) -blockEx9 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx9 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx9 = mkBlockFakeVRF (bhHash $ bheader @(BHeader c) @(ShelleyEra c) blockEx8) @@ -831,7 +831,7 @@ snapEx9 = ] } -expectedStEx9 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx9 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx9 = C.newEpoch blockEx9 . C.newSnapshot snapEx9 (Coin 0) @@ -844,7 +844,7 @@ expectedStEx9 = -- === Block 9, Slot 410, Epoch 4 -- -- Apply the first non-trivial reward update. -poolLifetime9 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolLifetime9 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolLifetime9 = CHAINExample expectedStEx8 blockEx9 (Right expectedStEx9) -- @@ -873,7 +873,7 @@ txbodyEx10 = SNothing SNothing -txEx10 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ShelleyTx (ShelleyEra c) +txEx10 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ShelleyTx (ShelleyEra c) txEx10 = ShelleyTx txbodyEx10 @@ -883,7 +883,7 @@ txEx10 = } SNothing -blockEx10 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx10 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx10 = mkBlockFakeVRF (bhHash $ bheader @(BHeader c) @(ShelleyEra c) blockEx9) @@ -898,7 +898,7 @@ blockEx10 = 19 (mkOCert (coreNodeKeysBySchedule @(ShelleyEra c) ppEx 420) 2 (KESPeriod 19)) -expectedStEx10 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx10 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx10 = C.evolveNonceUnfrozen (getBlockNonce (blockEx10 @c)) . C.newLab blockEx10 @@ -911,7 +911,7 @@ expectedStEx10 = -- === Block 10, Slot 420, Epoch 4 -- -- Drain Bob's reward account and de-register Bob's stake key. -poolLifetime10 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolLifetime10 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolLifetime10 = CHAINExample expectedStEx9 blockEx10 (Right expectedStEx10) -- @@ -953,7 +953,7 @@ txEx11 = } SNothing -blockEx11 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx11 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx11 = mkBlockFakeVRF (bhHash $ bheader @(BHeader c) @(ShelleyEra c) blockEx10) @@ -989,7 +989,7 @@ nonMyopicEx11 = (Map.singleton (aikColdKeyHash Cast.alicePoolKeys) (alicePerfEx11 @c)) (Coin 0) -pulserEx11 :: forall c. (ExMock c) => PulsingRewUpdate c +pulserEx11 :: forall c. ExMock c => PulsingRewUpdate c pulserEx11 = makeCompletedPulser (BlocksMade mempty) expectedStEx10 rewardUpdateEx11 :: forall c. Cr.Crypto c => RewardUpdate c @@ -1002,7 +1002,7 @@ rewardUpdateEx11 = , nonMyopic = nonMyopicEx11 } -expectedStEx11 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx11 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx11 = C.evolveNonceFrozen (getBlockNonce (blockEx11 @c)) . C.newLab blockEx11 @@ -1015,19 +1015,19 @@ expectedStEx11 = -- === Block 11, Slot 490, Epoch 4 -- -- Stage the retirement of Alice's stake pool. -poolLifetime11 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolLifetime11 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolLifetime11 = CHAINExample expectedStEx10 blockEx11 (Right expectedStEx11) -- -- Block 12, Slot 510, Epoch 5 -- -epoch5Nonce :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Nonce +epoch5Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce epoch5Nonce = chainCandidateNonce (expectedStEx11 @c) ⭒ hashHeaderToNonce (bhHash $ bheader (blockEx8 @c)) -blockEx12 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx12 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx12 = mkBlockFakeVRF (bhHash $ bheader @(BHeader c) @(ShelleyEra c) blockEx11) @@ -1056,7 +1056,7 @@ snapEx12 = ] } -expectedStEx12 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx12 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx12 = C.newEpoch blockEx12 . C.newSnapshot snapEx12 (Coin 11) @@ -1070,7 +1070,7 @@ expectedStEx12 = -- === Block 12, Slot 510, Epoch 5 -- -- Reap Alice's stake pool. -poolLifetime12 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolLifetime12 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolLifetime12 = CHAINExample expectedStEx11 blockEx12 (Right expectedStEx12) -- diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolReReg.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolReReg.hs index 2a1978375cc..93c90f31522 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolReReg.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolReReg.hs @@ -148,7 +148,7 @@ blockEx1 = expectedStEx1 :: forall c. - (ExMock (EraCrypto (ShelleyEra c))) => + ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx1 = C.evolveNonceUnfrozen (getBlockNonce (blockEx1 @c)) @@ -161,7 +161,7 @@ expectedStEx1 = -- === Block 1, Slot 10, Epoch 0 -- -- In the first block Alice registers a stake pool. -poolReReg1 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolReReg1 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolReReg1 = CHAINExample initStPoolReReg blockEx1 (Right expectedStEx1) -- @@ -212,7 +212,7 @@ word64SlotToKesPeriodWord :: Word64 -> Word word64SlotToKesPeriodWord slot = fromIntegral (toInteger slot) `div` fromIntegral (toInteger $ slotsPerKESPeriod testGlobals) -blockEx2 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Word64 -> Block (BHeader c) (ShelleyEra c) +blockEx2 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Word64 -> Block (BHeader c) (ShelleyEra c) blockEx2 slot = mkBlockFakeVRF (bhHash $ bheader @(BHeader c) @(ShelleyEra c) blockEx1) @@ -227,17 +227,17 @@ blockEx2 slot = 0 (mkOCert (coreNodeKeysBySchedule @(ShelleyEra c) ppEx 20) 0 (KESPeriod 0)) -blockEx2A :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx2A :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx2A = blockEx2 20 -expectedStEx2 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx2 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx2 = C.feesAndDeposits ppEx feeTx2 [] [newPoolParams] -- The deposit should be ignored because the poolId is already registered . C.newUTxO txbodyEx2 . C.reregPool newPoolParams $ expectedStEx1 -expectedStEx2A :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx2A :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx2A = C.evolveNonceUnfrozen (getBlockNonce (blockEx2A @c)) . C.newLab blockEx2A @@ -247,37 +247,37 @@ expectedStEx2A = -- -- In the second block Alice re-registers with new pool parameters -- early in the epoch. -poolReReg2A :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolReReg2A :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolReReg2A = CHAINExample expectedStEx1 blockEx2A (Right expectedStEx2A) -pulserEx2 :: forall c. (ExMock c) => PulsingRewUpdate c +pulserEx2 :: forall c. ExMock c => PulsingRewUpdate c pulserEx2 = makeCompletedPulser (BlocksMade mempty) expectedStEx2 -expectedStEx2B :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx2B :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx2B = C.evolveNonceFrozen (getBlockNonce (blockEx2B @c)) . C.newLab blockEx2B . C.pulserUpdate pulserEx2 $ expectedStEx2 -blockEx2B :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx2B :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx2B = blockEx2 90 -- === Block 2, Slot 90, Epoch 0 -- -- In the second block Alice re-registers with new pool parameters -- late in the epoch. -poolReReg2B :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolReReg2B :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolReReg2B = CHAINExample expectedStEx1 blockEx2B (Right expectedStEx2B) -- -- Block 3, Slot 110, Epoch 1 -- -epoch1Nonce :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Nonce +epoch1Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce epoch1Nonce = chainCandidateNonce (expectedStEx2B @c) -blockEx3 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx3 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx3 = mkBlockFakeVRF (bhHash $ bheader @(BHeader c) @(ShelleyEra c) blockEx2B) @@ -296,7 +296,7 @@ snapEx3 :: Cr.Crypto c => SnapShot c snapEx3 = emptySnapShot {ssPoolParams = [(aikColdKeyHash Cast.alicePoolKeys, Cast.alicePoolParams)]} -expectedStEx3 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx3 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx3 = C.newEpoch blockEx3 . C.newSnapshot snapEx3 (feeTx1 <+> feeTx2) @@ -308,7 +308,7 @@ expectedStEx3 = -- -- The third block is empty and trigger the epoch change, -- and Alice's new pool parameters are adopted. -poolReReg3 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +poolReReg3 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) poolReReg3 = CHAINExample expectedStEx2B blockEx3 (Right expectedStEx3) -- diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs index c435611b292..e87b9d24d21 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs @@ -145,7 +145,7 @@ txbodyEx1 = (SJust (Update ppVotes1 (EpochNo 0))) SNothing -txEx1 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ShelleyTx (ShelleyEra c) +txEx1 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ShelleyTx (ShelleyEra c) txEx1 = ShelleyTx txbodyEx1 @@ -162,7 +162,7 @@ txEx1 = } SNothing -blockEx1 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Block (BHeader c) (ShelleyEra c) +blockEx1 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) blockEx1 = mkBlockFakeVRF lastByronHeaderHash @@ -177,7 +177,7 @@ blockEx1 = 0 (mkOCert (coreNodeKeysBySchedule @(ShelleyEra c) ppEx 10) 0 (KESPeriod 0)) -expectedStEx1 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx1 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx1 = C.evolveNonceUnfrozen (getBlockNonce (blockEx1 @c)) . C.newLab blockEx1 @@ -189,7 +189,7 @@ expectedStEx1 = -- === Block 1, Slot 10, Epoch 0 -- -- In the first block, three genesis keys vote on the same new parameters. -updates1 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +updates1 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) updates1 = CHAINExample initStUpdates blockEx1 (Right expectedStEx1) -- @@ -220,7 +220,7 @@ txbodyEx2 = (SJust updateEx3B) SNothing -txEx2 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ShelleyTx (ShelleyEra c) +txEx2 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ShelleyTx (ShelleyEra c) txEx2 = ShelleyTx txbodyEx2 @@ -251,7 +251,7 @@ blockEx2 = 0 (mkOCert (coreNodeKeysBySchedule @(ShelleyEra c) ppEx 20) 0 (KESPeriod 0)) -expectedStEx2 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx2 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx2 = C.evolveNonceUnfrozen (getBlockNonce (blockEx2 @c)) . C.newLab blockEx2 @@ -263,7 +263,7 @@ expectedStEx2 = -- === Block 2, Slot 20, Epoch 0 -- -- In the second block, two more genesis keys vote for the same new parameters. -updates2 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +updates2 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) updates2 = CHAINExample expectedStEx1 blockEx2 (Right expectedStEx2) -- @@ -323,10 +323,10 @@ blockEx3 = 0 (mkOCert (coreNodeKeysBySchedule @(ShelleyEra c) ppEx 80) 0 (KESPeriod 0)) -pulserEx3 :: forall c. (ExMock c) => PulsingRewUpdate c +pulserEx3 :: forall c. ExMock c => PulsingRewUpdate c pulserEx3 = makeCompletedPulser (BlocksMade mempty) expectedStEx2 -expectedStEx3 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx3 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx3 = C.evolveNonceFrozen (getBlockNonce (blockEx3 @c)) . C.newLab blockEx3 @@ -339,14 +339,14 @@ expectedStEx3 = -- === Block 3, Slot 80, Epoch 0 -- -- In the third block, one genesis keys votes for the next epoch -updates3 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +updates3 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) updates3 = CHAINExample expectedStEx2 blockEx3 (Right expectedStEx3) -- -- Block 4, Slot 110, Epoch 1 -- -epoch1Nonce :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => Nonce +epoch1Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce epoch1Nonce = chainCandidateNonce (expectedStEx3 @c) ⭒ mkNonceFromNumber 123 blockEx4 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Block (BHeader c) (ShelleyEra c) @@ -370,7 +370,7 @@ ppExUpdated = & ppPoolDepositL .~ Coin 200 & ppExtraEntropyL .~ mkNonceFromNumber 123 -expectedStEx4 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c) +expectedStEx4 :: forall c. ExMock (EraCrypto (ShelleyEra c)) => ChainState (ShelleyEra c) expectedStEx4 = C.newEpoch blockEx4 . C.newSnapshot EB.emptySnapShot (feeTx1 <+> feeTx2 <+> feeTx3) @@ -386,7 +386,7 @@ expectedStEx4 = -- and the future vote becomes a current vote. -- Since the extra entropy was voted on, notice that it is a part -- of the new epoch nonce. -updates4 :: (ExMock (EraCrypto (ShelleyEra c))) => CHAINExample (BHeader c) (ShelleyEra c) +updates4 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c) updates4 = CHAINExample expectedStEx3 blockEx4 (Right expectedStEx4) -- diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/MultiSigExamples.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/MultiSigExamples.hs index cb44c087761..39ab6352c8d 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/MultiSigExamples.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/MultiSigExamples.hs @@ -171,7 +171,7 @@ makeTxBody inp addrCs wdrl = makeTx :: forall c. - (Mock c) => + Mock c => TxBody (ShelleyEra c) -> [KeyPair 'Witness c] -> Map (ScriptHash c) (MultiSig (ShelleyEra c)) -> @@ -218,7 +218,7 @@ initPParams = -- locked by a script for each pair of script, coin value in 'msigs'. initialUTxOState :: forall c. - (Mock c) => + Mock c => Coin -> [(MultiSig (ShelleyEra c), Coin)] -> ( TxId c @@ -269,7 +269,7 @@ initialUTxOState aliceKeep msigs = -- Alice. Return resulting UTxO state or collected errors applyTxWithScript :: forall c. - (Mock c) => + Mock c => [(MultiSig (ShelleyEra c), Coin)] -> [MultiSig (ShelleyEra c)] -> Withdrawals c -> diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs index 92e21243e1f..2805d59ed54 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs @@ -291,7 +291,7 @@ testKey1SigToken = e testOpCertSigTokens :: forall c. - (Mock c) => + Mock c => Tokens -> Tokens testOpCertSigTokens = e diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs index 4f174aed7c3..b621fa074f7 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs @@ -177,7 +177,7 @@ testsPParams = -- | Test @checkLeaderVal@ in 'Cardano.Ledger.Shelley.BlockChain' testCheckLeaderVal :: forall v. - (v ~ VRF StandardCrypto) => + v ~ VRF StandardCrypto => TestTree testCheckLeaderVal = testGroup diff --git a/flake.lock b/flake.lock index fd7f5379104..21c69c05734 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1689254413, - "narHash": "sha256-sPmwlVNBtAXqFHCaIQtnFfqDKRErHmg0jmQZvRILXG4=", + "lastModified": 1689770606, + "narHash": "sha256-30c/iX+enOh+5eJXExvNNm4q8DvV0VkteBgtnQw44zM=", "owner": "input-output-hk", "repo": "cardano-haskell-packages", - "rev": "562fcb96351ae3be1e1c462cc36ae82694636c2f", + "rev": "7cc96e06f91b643725d5b4d67b1021d84ce21552", "type": "github" }, "original": { @@ -221,11 +221,11 @@ "hackage": { "flake": false, "locked": { - "lastModified": 1685924766, - "narHash": "sha256-sq3zvAcp4a4BCEAE4S9Y1lt4jQcpmHl8A+WheImd9OQ=", + "lastModified": 1689640360, + "narHash": "sha256-837/6Bfs6UJx2GDSCLmCg3zyhW2tyBf1Ad4plT021WE=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "6b0975bd09c166cbd84bfcfe58bfd84c5153ec87", + "rev": "c6a15a90fef46d4de1dbdfd6b20873b239599387", "type": "github" }, "original": { @@ -265,11 +265,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1685926350, - "narHash": "sha256-d6uK8/U7zYGrFbW3bd/lWupYTygsIa/cf/ECQ/3KSt0=", + "lastModified": 1689686507, + "narHash": "sha256-Q3lDRmZoxnL1Ddrx4lI8mqQajLV+K0aToBNjUjaqBsw=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "ebef98fdd98b173f336bb7889feb11e2915eca34", + "rev": "b873d6f5bb5b1543bf0c8022e9d0943e24551b95", "type": "github" }, "original": { @@ -298,16 +298,16 @@ "hls-2.0": { "flake": false, "locked": { - "lastModified": 1684398654, - "narHash": "sha256-RW44up2BIyBBYN6tZur5f9kDDR3kr0Rd+TgPbLTfwB4=", + "lastModified": 1687698105, + "narHash": "sha256-OHXlgRzs/kuJH8q7Sxh507H+0Rb8b7VOiPAjcY9sM1k=", "owner": "haskell", "repo": "haskell-language-server", - "rev": "20c6d1e731cd9c0beef7338e2fc7a8126ba9b6fb", + "rev": "783905f211ac63edf982dd1889c671653327e441", "type": "github" }, "original": { "owner": "haskell", - "ref": "2.0.0.0", + "ref": "2.0.0.1", "repo": "haskell-language-server", "type": "github" } @@ -654,11 +654,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1685923834, - "narHash": "sha256-5oTnK+dXt1elpbLwVUYiyKroFcCMvRzEPz/PBKRtIIA=", + "lastModified": 1689639109, + "narHash": "sha256-Jy7nQuxmKsWuxQp7ztCZz3zeVFjVnySLU8zcj/OlPvI=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "fe1d92917a72ec690dbe61a81318931052be6179", + "rev": "c2eec3ceb5fbe77fb6fa008460b9f64622a08ddf", "type": "github" }, "original": { diff --git a/flake.nix b/flake.nix index 65cf68e2c24..f7b3d0ebc4d 100644 --- a/flake.nix +++ b/flake.nix @@ -47,7 +47,7 @@ inherit (nixpkgs) lib; # see flake `variants` below for alternative compilers - defaultCompiler = "ghc927"; + defaultCompiler = "ghc928"; # We use cabalProject' to ensure we don't build the plan for # all systems. cabalProject = nixpkgs.haskell-nix.cabalProject' ({config, ...}: { @@ -101,9 +101,9 @@ } // lib.optionalAttrs (config.compiler-nix-name == defaultCompiler) { # tools that work only with default compiler - fourmolu = "0.10.1.0"; - hlint = "3.5"; - haskell-language-server = "2.0.0.0"; + fourmolu = "0.13.1.0"; + hlint = "3.6.1"; + haskell-language-server = { src = nixpkgs.haskell-nix.sources."hls-2.0"; }; }; # and from nixpkgs or other inputs @@ -168,7 +168,7 @@ cabalProject.flake ( lib.optionalAttrs (system == "x86_64-linux") { # on linux, build/test other supported compilers - variants = lib.genAttrs ["ghc8107" "ghc961"] (compiler-nix-name: { + variants = lib.genAttrs ["ghc8107" "ghc962"] (compiler-nix-name: { inherit compiler-nix-name; }); } @@ -227,12 +227,12 @@ }; devShells = let profillingShell = p: { - # `nix develop .#profiling` (or `.#ghc927.profiling): a shell with profiling enabled + # `nix develop .#profiling` (or `.#ghc928.profiling): a shell with profiling enabled profiling = (p.appendModule {modules = [{enableLibraryProfiling = true;}];}).shell; }; in profillingShell cabalProject - # Additional shells for every GHC version supported by haskell.nix, eg. `nix develop .#ghc927` + # Additional shells for every GHC version supported by haskell.nix, eg. `nix develop .#ghc928` // lib.mapAttrs (compiler-nix-name: _: let p = cabalProject.appendModule {inherit compiler-nix-name;}; in diff --git a/fourmolu.yaml b/fourmolu.yaml index b121f8c5b1e..272d6474882 100644 --- a/fourmolu.yaml +++ b/fourmolu.yaml @@ -12,3 +12,4 @@ in-style: right-align unicode: never respectful: true fixities: [] +single-constraint-parens: never diff --git a/libs/cardano-data/src/Data/ListMap.hs b/libs/cardano-data/src/Data/ListMap.hs index 6783820a481..14a11f6d9dd 100644 --- a/libs/cardano-data/src/Data/ListMap.hs +++ b/libs/cardano-data/src/Data/ListMap.hs @@ -109,7 +109,7 @@ instance (ToJSON v, ToJSONKey k) => ToJSON (ListMap k v) where toEncoding = J.liftToEncoding J.toEncoding J.toEncodingList -instance (FromJSONKey k) => FromJSON1 (ListMap k) where +instance FromJSONKey k => FromJSON1 (ListMap k) where liftParseJSON parser _ = J.withObject "ListMap" $ \obj -> do let kv = KM.toList obj res <- forM kv $ \(k, v) -> do diff --git a/libs/cardano-ledger-api/CHANGELOG.md b/libs/cardano-ledger-api/CHANGELOG.md index 9fcbab94554..c06d88f0a43 100644 --- a/libs/cardano-ledger-api/CHANGELOG.md +++ b/libs/cardano-ledger-api/CHANGELOG.md @@ -1,5 +1,10 @@ # Version history for `cardano-ledger-api` +## 1.4.0.0 + +* Rename `cgTallyL` to `cgGovL` +* Rename `ConwayTallyState` to `ConwayGovState` + ## 1.3.0.0 * Add `queryConstitutionHash` to `Cardano.Ledger.Api.State.Query` #3506 diff --git a/libs/cardano-ledger-api/cardano-ledger-api.cabal b/libs/cardano-ledger-api/cardano-ledger-api.cabal index 367cecc7a97..2fc3ffcebdc 100644 --- a/libs/cardano-ledger-api/cardano-ledger-api.cabal +++ b/libs/cardano-ledger-api/cardano-ledger-api.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-api -version: 1.3.0.1 +version: 1.4.0.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK diff --git a/libs/cardano-ledger-api/src/Cardano/Ledger/Api/Governance.hs b/libs/cardano-ledger-api/src/Cardano/Ledger/Api/Governance.hs index 2802a31d3f2..6e4ed6eabae 100644 --- a/libs/cardano-ledger-api/src/Cardano/Ledger/Api/Governance.hs +++ b/libs/cardano-ledger-api/src/Cardano/Ledger/Api/Governance.hs @@ -18,8 +18,8 @@ module Cardano.Ledger.Api.Governance ( -- ** Conway Governance ConwayGovernance (..), cgRatifyL, - cgTallyL, - ConwayTallyState (..), + cgGovL, + ConwayGovState (..), RatifyState (..), EnactState (..), Voter (..), @@ -42,8 +42,8 @@ import Cardano.Ledger.Api.Era () import Cardano.Ledger.Conway.Governance ( Anchor (..), AnchorDataHash, + ConwayGovState (..), ConwayGovernance (..), - ConwayTallyState (..), EnactState (..), GovernanceAction (..), GovernanceActionId (..), @@ -54,8 +54,8 @@ import Cardano.Ledger.Conway.Governance ( Voter (..), -- Lenses + cgGovL, cgRatifyL, - cgTallyL, ) import Cardano.Ledger.Crypto (Crypto) import Cardano.Ledger.SafeHash (HashAnnotated, SafeHash, SafeToHash, hashAnnotated) diff --git a/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/Tx/Out.hs b/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/Tx/Out.hs index a1e9f21b899..e3f83cbc0e5 100644 --- a/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/Tx/Out.hs +++ b/libs/cardano-ledger-api/test/Test/Cardano/Ledger/Api/Tx/Out.hs @@ -49,7 +49,7 @@ propSetAlonzoMinTxOut = valSize = Val.size (txOut' ^. valueTxOutL) dataHashSize = maybe 0 (const 10) $ strictMaybeToMaybe (txOut' ^. dataHashTxOutL) sz = 27 + valSize + dataHashSize - in txOut' ^. coinTxOutL + in (txOut' ^. coinTxOutL) `shouldBe` Coin (sz * unCoin (unCoinPerWord (pp ^. ppCoinsPerUTxOWordL))) propSetBabbageMinTxOut :: @@ -65,7 +65,7 @@ propSetBabbageMinTxOut = within 1000000 $ -- just in case if there is a problem with termination let txOut' = setMinCoinTxOut pp txOut sz = toInteger (BSL.length (serialize (pvMajor (pp ^. ppProtocolVersionL)) txOut')) - in txOut' ^. coinTxOutL + in (txOut' ^. coinTxOutL) `shouldBe` Coin ((160 + sz) * unCoin (unCoinPerByte (pp ^. ppCoinsPerUTxOByteL))) propSetEnsureMinTxOut :: @@ -79,13 +79,13 @@ propSetEnsureMinTxOut = prop "setEnsureMinTxOut" $ \(pp :: PParams era) (txOut :: TxOut era) -> do ensureMinCoinTxOut pp (txOut & coinTxOutL .~ mempty) `shouldBe` setMinCoinTxOut pp (txOut & coinTxOutL .~ mempty) - ensureMinCoinTxOut pp txOut ^. coinTxOutL + (ensureMinCoinTxOut pp txOut ^. coinTxOutL) `shouldSatisfy` (>= (setMinCoinTxOut pp txOut ^. coinTxOutL)) let v = eraProtVerHigh @era txOutSz = mkSized v txOut ensureMinCoinSizedTxOut pp (mkSized v (txOut & coinTxOutL .~ mempty)) `shouldBe` setMinCoinSizedTxOut pp (mkSized v (txOut & coinTxOutL .~ mempty)) - sizedValue (ensureMinCoinSizedTxOut pp txOutSz) ^. coinTxOutL + (sizedValue (ensureMinCoinSizedTxOut pp txOutSz) ^. coinTxOutL) `shouldSatisfy` (>= (sizedValue (setMinCoinSizedTxOut pp txOutSz) ^. coinTxOutL)) spec :: Spec diff --git a/libs/cardano-ledger-binary/cardano-ledger-binary.cabal b/libs/cardano-ledger-binary/cardano-ledger-binary.cabal index e35c3ee834d..9930dd32e5e 100644 --- a/libs/cardano-ledger-binary/cardano-ledger-binary.cabal +++ b/libs/cardano-ledger-binary/cardano-ledger-binary.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-binary -version: 1.1.1.1 +version: 1.1.1.2 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/Coders.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/Coders.hs index 13c9e993a87..b6e2d7b3efa 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/Coders.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/Coders.hs @@ -140,13 +140,13 @@ invalidField n = field (flip $ const @t @Void) (Invalid n) -- | Sparse decode something with a (DecCBOR (Annotator t)) instance -- A special case of 'field' -fieldA :: (Applicative ann) => (x -> t -> t) -> Decode ('Closed d) x -> Field (ann t) +fieldA :: Applicative ann => (x -> t -> t) -> Decode ('Closed d) x -> Field (ann t) fieldA update dec = Field (liftA2 update) (pure <$> decode dec) {-# INLINE fieldA #-} -- | Sparse decode something with a (DecCBOR (Annotator t)) instance fieldAA :: - (Applicative ann) => + Applicative ann => (x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t) diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/EncCBOR.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/EncCBOR.hs index 28c39ccb838..f13237f3186 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/EncCBOR.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/EncCBOR.hs @@ -318,9 +318,9 @@ instance (Ord b, Num b) => Num (Range b) where negate x = Range {lo = negate (hi x), hi = negate (lo x)} abs x = if - | lo x <= 0 && hi x >= 0 -> Range {lo = 0, hi = max (hi x) (negate $ lo x)} - | lo x <= 0 && hi x <= 0 -> Range {lo = negate (hi x), hi = negate (lo x)} - | otherwise -> x + | lo x <= 0 && hi x >= 0 -> Range {lo = 0, hi = max (hi x) (negate $ lo x)} + | lo x <= 0 && hi x <= 0 -> Range {lo = negate (hi x), hi = negate (lo x)} + | otherwise -> x signum x = Range {lo = signum (lo x), hi = signum (hi x)} fromInteger n = Range {lo = fromInteger n, hi = fromInteger n} @@ -394,7 +394,7 @@ apMono n f = \case -- | Greedily compute the size bounds for a type, using the given context to -- override sizes for specific types. -szWithCtx :: (EncCBOR a) => Map.Map TypeRep SizeOverride -> Proxy a -> Size +szWithCtx :: EncCBOR a => Map.Map TypeRep SizeOverride -> Proxy a -> Size szWithCtx ctx pxy = case Map.lookup (typeRep pxy) ctx of Nothing -> normal Just override -> case override of @@ -496,11 +496,11 @@ withWordSize :: (Integral s, Integral a) => s -> a withWordSize x = let s = fromIntegral x :: Integer in if - | s <= 0x17 && s >= (-0x18) -> 1 - | s <= 0xff && s >= (-0x100) -> 2 - | s <= 0xffff && s >= (-0x10000) -> 3 - | s <= 0xffffffff && s >= (-0x100000000) -> 5 - | otherwise -> 9 + | s <= 0x17 && s >= (-0x18) -> 1 + | s <= 0xff && s >= (-0x100) -> 2 + | s <= 0xffff && s >= (-0x10000) -> 3 + | s <= 0xffffffff && s >= (-0x100000000) -> 5 + | otherwise -> 9 -------------------------------------------------------------------------------- -- Primitive types diff --git a/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Twiddle.hs b/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Twiddle.hs index 960c3c7a74a..45554b3f9d5 100644 --- a/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Twiddle.hs +++ b/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Twiddle.hs @@ -164,7 +164,7 @@ instance (TwiddleL (l x), TwiddleL (r x)) => TwiddleL ((l :+: r) x) where instance Twiddle c => TwiddleL (K1 i c p) where twiddleL v (K1 c) = pure <$> twiddle v c -instance (TwiddleL (f p)) => TwiddleL (M1 i c f p) where +instance TwiddleL (f p) => TwiddleL (M1 i c f p) where twiddleL v (M1 fp) = twiddleL v fp instance Twiddle Integer where diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Keys.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Keys.hs index 866da1ddb36..62149e42d7e 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Keys.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Keys.hs @@ -149,7 +149,7 @@ class HasKeyRole (a :: KeyRole -> Type -> Type) where -- be used as witnesses to some types of transaction. As such, we provide an -- explicit coercion for it. asWitness :: - (HasKeyRole a) => + HasKeyRole a => a r c -> a 'Witness c asWitness = coerceKeyRole @@ -216,7 +216,7 @@ verifySignedDSIGN (VKey vk) vd sigDSIGN = -- | Hash a given signature hashSignature :: - (Crypto c) => + Crypto c => SignedDSIGN c (Hash c h) -> Hash c (SignedDSIGN c (Hash c h)) hashSignature = Hash.hashWith (DSIGN.rawSerialiseSigDSIGN . coerce) @@ -268,8 +268,7 @@ instance HasKeyRole KeyHash -- | Hash a given public key hashKey :: - ( Crypto c - ) => + Crypto c => VKey kd c -> KeyHash kd c hashKey (VKey vk) = KeyHash $ DSIGN.hashVerKeyDSIGN vk diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Bootstrap.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Bootstrap.hs index 958f9fc3dd3..df9caeeaeac 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Bootstrap.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Keys/Bootstrap.hs @@ -182,7 +182,7 @@ bootstrapWitKeyHash (BootstrapWitness (VKey key) _ (ChainCode cc) attributes) = unpackByronVKey :: forall c. - (DSIGN c ~ DSIGN.Ed25519DSIGN) => + DSIGN c ~ DSIGN.Ed25519DSIGN => Byron.VerificationKey -> (VKey 'Witness c, ChainCode) unpackByronVKey diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/UMap.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/UMap.hs index bb28ed0b3de..665e99c958f 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/UMap.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/UMap.hs @@ -205,7 +205,7 @@ data UMElem c instance ToExpr (UMElem c) -instance (Crypto c) => ToJSON (UMElem c) where +instance Crypto c => ToJSON (UMElem c) where toJSON = object . toUMElemair toEncoding = Aeson.pairs . mconcat . toUMElemair diff --git a/libs/cardano-ledger-pretty/CHANGELOG.md b/libs/cardano-ledger-pretty/CHANGELOG.md index 9a62db08875..2e3de98aae4 100644 --- a/libs/cardano-ledger-pretty/CHANGELOG.md +++ b/libs/cardano-ledger-pretty/CHANGELOG.md @@ -1,5 +1,11 @@ # Changelog for `cardano-ledger-pretty` +## 1.3.0.0 + +* Replace `ConwayTallyPredFailure era` with `ConwayGovPredFailure era` +* Replace `ConwayTallyState era` with `ConwayGovState era` +* Replace `ConwayVDelPredFailure era` with `ConwayGovCertPredFailure era` + ## 1.2.1.0 * Added `PrettyA` instance for `DRep` diff --git a/libs/cardano-ledger-pretty/cardano-ledger-pretty.cabal b/libs/cardano-ledger-pretty/cardano-ledger-pretty.cabal index 5cd07d3b2c5..31da826647b 100644 --- a/libs/cardano-ledger-pretty/cardano-ledger-pretty.cabal +++ b/libs/cardano-ledger-pretty/cardano-ledger-pretty.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-pretty -version: 1.2.1.3 +version: 1.3.0.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK @@ -39,8 +39,8 @@ library cardano-ledger-alonzo >=1.2, cardano-ledger-babbage >=1.1, cardano-ledger-byron, - cardano-ledger-conway ^>=1.6, - cardano-ledger-core >=1.3 && <1.6, + cardano-ledger-conway ^>=1.7, + cardano-ledger-core >=1.4 && <1.6, cardano-ledger-mary >=1.0, cardano-ledger-shelley ^>=1.4, cardano-protocol-tpraos >=1.0, diff --git a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs index 84d14c2f55a..b6739c66fc4 100644 --- a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs +++ b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs @@ -1056,7 +1056,7 @@ instance PrettyA (SafeHash c i) where -- ============================ -- Cardano.Ledger.Compactible -ppCompactForm :: (Compactible a) => (a -> PDoc) -> CompactForm a -> PDoc +ppCompactForm :: Compactible a => (a -> PDoc) -> CompactForm a -> PDoc ppCompactForm cf x = cf (fromCompact x) instance (Compactible a, PrettyA a) => PrettyA (CompactForm a) where diff --git a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty/Conway.hs b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty/Conway.hs index 36c85367e88..2ddd09e12ed 100644 --- a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty/Conway.hs +++ b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty/Conway.hs @@ -22,8 +22,8 @@ import Cardano.Ledger.Conway (ConwayEra) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Governance ( Anchor, + ConwayGovState (..), ConwayGovernance (..), - ConwayTallyState (..), GovernanceAction (..), GovernanceActionId (..), GovernanceActionIx (..), @@ -38,9 +38,9 @@ import Cardano.Ledger.Conway.Rules ( ConwayCertPredFailure (..), ConwayCertsPredFailure (..), ConwayDelegPredFailure (..), + ConwayGovCertPredFailure, + ConwayGovPredFailure, ConwayLedgerPredFailure (..), - ConwayTallyPredFailure, - ConwayVDelPredFailure, EnactState (..), PredicateFailure, RatifyState (..), @@ -228,21 +228,21 @@ instance Crypto c => PrettyA (PParamsUpdate (ConwayEra c)) where instance ( PrettyA (PredicateFailure (EraRule "UTXOW" era)) , PrettyA (PredicateFailure (EraRule "CERTS" era)) - , PrettyA (PredicateFailure (EraRule "TALLY" era)) + , PrettyA (PredicateFailure (EraRule "GOV" era)) ) => PrettyA (ConwayLedgerPredFailure era) where prettyA (ConwayUtxowFailure x) = prettyA x prettyA (ConwayCertsFailure x) = prettyA x - prettyA (ConwayTallyFailure x) = prettyA x + prettyA (ConwayGovFailure x) = prettyA x prettyA (ConwayWdrlNotDelegatedToDRep x) = ppSexp "ConwayWdrlNotDelegatedToDRep" [prettyA x] -instance PrettyA (ConwayTallyPredFailure era) where +instance PrettyA (ConwayGovPredFailure era) where prettyA = viaShow -instance PrettyA (PParamsUpdate era) => PrettyA (ConwayTallyState era) where - prettyA (ConwayTallyState x) = prettyA x +instance PrettyA (PParamsUpdate era) => PrettyA (ConwayGovState era) where + prettyA (ConwayGovState x) = prettyA x instance PrettyA (GovernanceActionId era) where prettyA gaid@(GovernanceActionId _ _) = @@ -313,7 +313,7 @@ instance let ConwayGovernance {..} = cg in ppRecord "ConwayGovernance" - [ ("Tally", prettyA cgTally) + [ ("Gov", prettyA cgGov) , ("Ratify", prettyA cgRatify) ] @@ -334,7 +334,7 @@ instance instance ( PrettyA (PredicateFailure (EraRule "DELEG" era)) , PrettyA (PredicateFailure (EraRule "POOL" era)) - , PrettyA (PredicateFailure (EraRule "VDEL" era)) + , PrettyA (PredicateFailure (EraRule "GOVCERT" era)) ) => PrettyA (ConwayCertPredFailure era) where @@ -347,10 +347,10 @@ instance ppRecord "ConwayPoolFailure" [("POOL", prettyA x)] - VDelFailure x -> + GovCertFailure x -> ppRecord - "ConwayVDelFailure" - [("VDEL", prettyA x)] + "ConwayGovCertFailure" + [("GOVCERT", prettyA x)] instance PrettyA (ConwayDelegPredFailure era) where prettyA = \case @@ -379,5 +379,5 @@ instance PrettyA (ConwayDelegPredFailure era) where "WrongCertificateTypeDELEG" [] -instance PrettyA (ConwayVDelPredFailure era) where - prettyA = const $ ppRecord "ConwayVDelPredFailure" [] +instance PrettyA (ConwayGovCertPredFailure era) where + prettyA = const $ ppRecord "ConwayGovCertPredFailure" [] diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Ast.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Ast.hs index b702296602b..1dbc6ee6ac8 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Ast.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Ast.hs @@ -33,7 +33,7 @@ data Term era t where Var :: V era t -> Term era t Dom :: Ord a => Term era (Map a b) -> Term era (Set a) Rng :: (Ord a, Ord b) => Term era (Map a b) -> Term era (Set b) - ProjM :: (Ord a) => Lens' b t -> Rep era t -> Term era (Map a b) -> Term era (Map a t) + ProjM :: Ord a => Lens' b t -> Rep era t -> Term era (Map a b) -> Term era (Map a t) ProjS :: (Ord b, Ord t) => Lens' b t -> Rep era t -> Term era (Set b) -> Term era (Set t) Delta :: Term era Coin -> Term era DeltaCoin Negate :: Term era DeltaCoin -> Term era DeltaCoin diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Classes.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Classes.hs index 7155389b45e..753d7aa061b 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Classes.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Classes.hs @@ -219,7 +219,7 @@ instance GoodCrypto c => Sums (IndividualPoolStake c) Rational where getSum (IndividualPoolStake r _) = r genT _ r = IndividualPoolStake r <$> arbitrary -instance (Reflect era) => Sums (TxOutF era) Coin where +instance Reflect era => Sums (TxOutF era) Coin where getSum (TxOutF _ txout) = coin (txout ^. valueTxOutL) genT _ cn = genTxOutX reify cn diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Spec.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Spec.hs index 38b776bb2b1..90f81880d6e 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Spec.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Spec.hs @@ -648,7 +648,7 @@ data RngSpec era rng where RngSpec era rng -- | The range must sum upto 'c' through the projection witnessed by the (Sums t c) class RngProj :: - (Sums x c) => + Sums x c => c -> -- the smallest element in the partition (usually 0 or 1) Rep era c -> Size -> -- the sum of all the elements must fall in the range denoted by the Size @@ -967,10 +967,10 @@ data MapSpec era dom rng where instance Ord d => Show (MapSpec w d r) where show = showMapSpec -instance (Ord dom) => Semigroup (MapSpec era dom rng) where +instance Ord dom => Semigroup (MapSpec era dom rng) where (<>) = mergeMapSpec -instance (Ord dom) => Monoid (MapSpec era dom rng) where +instance Ord dom => Monoid (MapSpec era dom rng) where mempty = MapSpec SzAny RelAny RngAny instance LiftT (MapSpec era a b) where @@ -1144,7 +1144,7 @@ reportManyMergeMapSpec = do -- =================================================================================== data SetSpec era a where - SetSpec :: (Ord a) => Size -> RelSpec era a -> SetSpec era a + SetSpec :: Ord a => Size -> RelSpec era a -> SetSpec era a SetNever :: [String] -> SetSpec era a instance Show (SetSpec era a) where show = showSetSpec @@ -1152,7 +1152,7 @@ instance Show (SetSpec era a) where show = showSetSpec instance Ord a => Semigroup (SetSpec era a) where (<>) = mergeSetSpec -instance (Ord a) => Monoid (SetSpec era a) where +instance Ord a => Monoid (SetSpec era a) where mempty = SetSpec SzAny RelAny instance LiftT (SetSpec era t) where diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/TypeRep.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/TypeRep.hs index 1133db64ebd..7603384d549 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/TypeRep.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/TypeRep.hs @@ -397,7 +397,7 @@ compareRep x y = cmpIndex @(Rep era) x y -- ================================================ genSizedRep :: - (Era era) => + Era era => Int -> Rep era t -> Gen t diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs index a0c1a279c20..4e7d97d7426 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs @@ -69,7 +69,7 @@ import Test.Cardano.Ledger.Constrained.Lenses import Test.Cardano.Ledger.Constrained.TypeRep (Rep (..), testEql, (:~:) (Refl)) import Test.Cardano.Ledger.Generic.Proof (Evidence (..), Proof (..)) -import Cardano.Ledger.Conway.Governance (ConwayTallyState (..)) +import Cardano.Ledger.Conway.Governance (ConwayGovState (..)) import Cardano.Ledger.Shelley.Governance (ShelleyPPUPState (..)) import qualified Cardano.Ledger.Shelley.Governance as Core (GovernanceState (..)) import qualified Cardano.Ledger.Shelley.PParams as Core (ProposedPPUpdates (..)) diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/BabbageFeatures.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/BabbageFeatures.hs index d12860a5b4f..506eabae205 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/BabbageFeatures.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/BabbageFeatures.hs @@ -117,7 +117,7 @@ keysForMultisigWitnessKeyRole pf = KeyPairWitness (keysForMultisig pf) keyHashForMultisig :: forall era. Era era => Proof era -> KeyHash 'Witness (EraCrypto era) keyHashForMultisig pf = hashKey . vKey $ keysForMultisig pf -simpleScript :: forall era. (Scriptic era) => Proof era -> Script era +simpleScript :: forall era. Scriptic era => Proof era -> Script era simpleScript pf = allOf [require @era (keyHashForMultisig pf)] pf evenData3ArgsScript :: HasCallStack => Proof era -> Script era @@ -148,7 +148,7 @@ plainAddr pf = Addr Testnet pCred sCred pCred = KeyHashObj . hashKey . vKey $ someKeys pf sCred = StakeRefBase . KeyHashObj . hashKey $ svk -scriptAddr :: forall era. (Scriptic era) => Proof era -> Script era -> Addr (EraCrypto era) +scriptAddr :: forall era. Scriptic era => Proof era -> Script era -> Addr (EraCrypto era) scriptAddr _pf s = Addr Testnet pCred sCred where pCred = ScriptHashObj . hashScript @era $ s @@ -162,7 +162,7 @@ malformedScriptAddr pf = Addr Testnet pCred sCred (_ssk, svk) = mkKeyPair @(EraCrypto era) (RawSeed 0 0 0 0 0) sCred = StakeRefBase . KeyHashObj . hashKey $ svk -simpleScriptAddr :: forall era. (Scriptic era) => Proof era -> Addr (EraCrypto era) +simpleScriptAddr :: forall era. Scriptic era => Proof era -> Addr (EraCrypto era) simpleScriptAddr pf = scriptAddr pf (simpleScript pf) datumExampleEven :: Era era => Data era @@ -898,7 +898,7 @@ simpleScriptOutWithRefScriptUTxOState pf = largeDatum :: Era era => Data era largeDatum = Data (PV1.B . BS.pack $ replicate 1500 0) -largeOutput' :: forall era. (EraTxOut era) => Proof era -> TxOut era +largeOutput' :: forall era. EraTxOut era => Proof era -> TxOut era largeOutput' pf = newTxOut pf diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Functions.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Functions.hs index 43dcc1033b7..b664fe7d452 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Functions.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Functions.hs @@ -36,8 +36,8 @@ import Cardano.Ledger.BaseTypes ( import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Governance ( + ConwayGovState (..), ConwayGovernance (..), - ConwayTallyState (..), GovernanceActionState (..), RatifyState (..), ) @@ -422,9 +422,9 @@ instance TotalAda (CertState era) where instance TotalAda (ShelleyPPUPState era) where totalAda _ = mempty -instance TotalAda (ConwayTallyState era) where +instance TotalAda (ConwayGovState era) where -- TODO Might need a review once the specification is done - totalAda (ConwayTallyState x) = mconcat $ gasDeposit <$> Map.elems x + totalAda (ConwayGovState x) = mconcat $ gasDeposit <$> Map.elems x governanceStateTotalAda :: forall era. Reflect era => GovernanceState era -> Coin governanceStateTotalAda = case reify @era of diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Indexed.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Indexed.hs index d23612325d2..7e6e4dc4e08 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Indexed.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Indexed.hs @@ -158,7 +158,7 @@ theSKey n = SKey (sKey (theKeyPair @c n)) theKeyHash :: CC.Crypto c => Int -> KeyHash kr c theKeyHash n = hashKey (theVKey n) -theWitVKey :: (GoodCrypto c) => Int -> SafeHash c EraIndependentTxBody -> WitVKey 'Witness c +theWitVKey :: GoodCrypto c => Int -> SafeHash c EraIndependentTxBody -> WitVKey 'Witness c theWitVKey n hash = mkWitnessVKey hash (theKeyPair n) theKeyHashObj :: CC.Crypto c => Int -> Credential kr c @@ -334,7 +334,7 @@ instance Crypto c => PrettyA (KeyPair r c) where prettyA (KeyPair x y) = ppRecord "KeyPair" [("vKey", ppVKey x), ("sKey", reAnnotate (Width 5 :) (viaShow y))] -instance (CC.Crypto c) => PrettyA (PublicSecret kr kr' c) where +instance CC.Crypto c => PrettyA (PublicSecret kr kr' c) where prettyA (PublicSecret x y) = ppPair prettyA prettyA (x, y) instance PrettyA (SKey kr c) where diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs index f933e58c632..13c010f9a1a 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs @@ -51,7 +51,7 @@ import Cardano.Ledger.BaseTypes ( ) import qualified Cardano.Ledger.CertState as DP import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..)) -import Cardano.Ledger.Conway.Governance (ConwayTallyState (..)) +import Cardano.Ledger.Conway.Governance (ConwayGovState (..)) import Cardano.Ledger.Conway.Rules ( ConwayEpochPredFailure (..), ConwayNewEpochPredFailure, @@ -875,8 +875,7 @@ instance -- =============== ppTickPredicateFailure :: forall era. - ( Reflect era - ) => + Reflect era => ShelleyTickPredFailure era -> PDoc ppTickPredicateFailure (NewEpochFailure x) = ppNewEpochPredicateFailure @era x @@ -895,8 +894,7 @@ instance -- =============== ppNewEpochPredicateFailure :: forall era. - ( Reflect era - ) => + Reflect era => PredicateFailure (EraRule "NEWEPOCH" era) -> PDoc ppNewEpochPredicateFailure x = case reify @era of @@ -1007,7 +1005,7 @@ ppUpecPredicateFailure :: ShelleyUpecPredFailure era -> PDoc ppUpecPredicateFailure (NewPpFailure x) = ppNewppPredicateFailure x instance - (ShelleyUpecPredFailure era ~ PredicateFailure (EraRule "UPEC" era)) => + ShelleyUpecPredFailure era ~ PredicateFailure (EraRule "UPEC" era) => PrettyA (ShelleyUpecPredFailure era) where prettyA = ppUpecPredicateFailure @@ -1565,8 +1563,8 @@ pcTxBody proof txbody = ppRecord "TxBody" pairs fields = abstractTxBody proof txbody pairs = concatMap (pcTxBodyField proof) fields -instance PrettyC (ConwayTallyState era) era where - prettyC proof (ConwayTallyState x) = case proof of +instance PrettyC (ConwayGovState era) era where + prettyC proof (ConwayGovState x) = case proof of Shelley _ -> ppMap prettyA prettyA x Mary _ -> ppMap prettyA prettyA x Allegra _ -> ppMap prettyA prettyA x diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Proof.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Proof.hs index e61453a062e..ab64abd5f6c 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Proof.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Proof.hs @@ -134,7 +134,7 @@ type GoodCrypto c = , PraosCrypto c ) -class (GoodCrypto c) => ReflectC c where +class GoodCrypto c => ReflectC c where evidence :: Evidence c liftC :: forall a. (Evidence c -> a) -> a liftC f = f (evidence @c) diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Properties.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Properties.hs index 6337d6577cd..db87d511642 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Properties.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Properties.hs @@ -323,8 +323,7 @@ epochPreserveAda genSize = adaIsPreservedInEachEpoch :: forall era. - ( Reflect era - ) => + Reflect era => Proof era -> GenSize -> TestTree diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Same.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Same.hs index 5809cce8d25..276d677d13e 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Same.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Same.hs @@ -107,7 +107,7 @@ eqByShow :: (Eq t, Show t) => t -> t -> Maybe PDoc eqByShow x y = if x == y then Nothing else Just (notEq (ppString (show x)) (ppString (show y))) -- | Compare for equality, and display differences using 'pcf' -eqVia :: (Eq t) => (t -> PDoc) -> t -> t -> Maybe PDoc +eqVia :: Eq t => (t -> PDoc) -> t -> t -> Maybe PDoc eqVia pcf x y = if x == y then Nothing else Just (notEq (pcf x) (pcf y)) -- ========================================== @@ -352,7 +352,7 @@ sameTransCtx (Conway _) x y = eqByShow x y sameShelleyTxWits :: forall era. - (Reflect era) => + Reflect era => Proof era -> ShelleyTxWits era -> ShelleyTxWits era -> diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/TxGen.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/TxGen.hs index c5a4a7ef2ff..78d44b7c1dc 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/TxGen.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/TxGen.hs @@ -210,7 +210,7 @@ lookupScript scriptHash mTag = do -- ===================================== genGenericScriptWitness :: - (Reflect era) => + Reflect era => Proof era -> Maybe Tag -> Script era -> @@ -234,7 +234,7 @@ genGenericScriptWitness proof mTag script = -- Because scripts vary be Era, we need some Era specific code here: genGenericScriptWitness mkWitVKey :: forall era kr. - (Reflect era) => + Reflect era => Proof era -> Maybe Tag -> Credential kr (EraCrypto era) -> @@ -259,7 +259,7 @@ mkWitVKey era mTag (ScriptHashObj scriptHash) = -- | Used in Shelley Eras mkMultiSigWit :: forall era. - (Reflect era) => + Reflect era => Proof era -> Maybe Tag -> Shelley.MultiSig era -> @@ -276,7 +276,7 @@ mkMultiSigWit era mTag (Shelley.RequireMOf m timelocks) = do -- | Timeock scripts are used in Mary and subsequent Eras. mkTimelockWit :: forall era. - (Reflect era) => + Reflect era => Proof era -> Maybe Tag -> Timelock era -> @@ -316,7 +316,7 @@ genTxOutKeyWitness era mTag txOut = genCredKeyWit :: forall era k. - (Reflect era) => + Reflect era => Proof era -> Maybe Tag -> Credential k (EraCrypto era) -> diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs index c4870c5524b..871c551b2c4 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs @@ -326,11 +326,11 @@ newtype FutureLedgerViewError era = FutureLedgerViewError [PredicateFailure (EraRule "TICKF" era)] deriving stock instance - (Eq (PredicateFailure (EraRule "TICKF" era))) => + Eq (PredicateFailure (EraRule "TICKF" era)) => Eq (FutureLedgerViewError era) deriving stock instance - (Show (PredicateFailure (EraRule "TICKF" era))) => + Show (PredicateFailure (EraRule "TICKF" era)) => Show (FutureLedgerViewError era) -- | Anachronistic ledger view @@ -441,11 +441,11 @@ newtype ChainTransitionError c = ChainTransitionError [PredicateFailure (STS.Prtcl.PRTCL c)] deriving (Generic) -instance (Crypto c) => NoThunks (ChainTransitionError c) +instance Crypto c => NoThunks (ChainTransitionError c) -deriving instance (Crypto c) => Eq (ChainTransitionError c) +deriving instance Crypto c => Eq (ChainTransitionError c) -deriving instance (Crypto c) => Show (ChainTransitionError c) +deriving instance Crypto c => Show (ChainTransitionError c) -- | Tick the chain state to a new epoch. tickChainDepState :: diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs index 13c36ba91f9..d960e21245f 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs @@ -390,7 +390,7 @@ assertBoundedNatural maxVal val = -- being slot leader. checkLeaderValue :: forall v. - (VRF.VRFAlgorithm v) => + VRF.VRFAlgorithm v => VRF.OutputVRF v -> Rational -> ActiveSlotCoeff -> diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/OCert.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/OCert.hs index 24d3a74fd05..a8c284bec46 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/OCert.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/OCert.hs @@ -93,8 +93,8 @@ ocertTransition = c0 <= kp ?! KESBeforeStartOCERT c0 kp kp_ < c0_ - + fromIntegral maxKESiterations - ?! KESAfterEndOCERT kp c0 maxKESiterations + + fromIntegral maxKESiterations + ?! KESAfterEndOCERT kp c0 maxKESiterations let t = if kp_ >= c0_ then kp_ - c0_ else 0 -- this is required to prevent an -- arithmetic underflow, in the diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Overlay.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Overlay.hs index 7674d0ed66c..c3e6ebdc8cf 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Overlay.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Overlay.hs @@ -161,11 +161,11 @@ instance transitionRules = [overlayTransition] deriving instance - (VRF.VRFAlgorithm (VRF c)) => + VRF.VRFAlgorithm (VRF c) => Show (OverlayPredicateFailure c) deriving instance - (VRF.VRFAlgorithm (VRF c)) => + VRF.VRFAlgorithm (VRF c) => Eq (OverlayPredicateFailure c) vrfChecks :: @@ -291,7 +291,7 @@ overlayTransition = trans @(OCERT c) $ TRC (oce, cs, bh) instance - (VRF.VRFAlgorithm (VRF c)) => + VRF.VRFAlgorithm (VRF c) => NoThunks (OverlayPredicateFailure c) instance diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Prtcl.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Prtcl.hs index 5aae29adb96..05370ba3159 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Prtcl.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Prtcl.hs @@ -73,12 +73,12 @@ data PRTCL c data PrtclState c = PrtclState + -- | Operation Certificate counters !(Map (KeyHash 'BlockIssuer c) Word64) - -- ^ Operation Certificate counters + -- | Evolving nonce !Nonce - -- ^ Evolving nonce + -- | Candidate nonce !Nonce - -- ^ Candidate nonce deriving (Generic, Show, Eq) instance Crypto c => EncCBOR (PrtclState c) @@ -127,11 +127,11 @@ data PrtclEvent c | NoEvent Void deriving instance - (VRF.VRFAlgorithm (VRF c)) => + VRF.VRFAlgorithm (VRF c) => Show (PrtclPredicateFailure c) deriving instance - (VRF.VRFAlgorithm (VRF c)) => + VRF.VRFAlgorithm (VRF c) => Eq (PrtclPredicateFailure c) instance @@ -198,7 +198,7 @@ prtclTransition = do etaV' etaC' -instance (Crypto c) => NoThunks (PrtclPredicateFailure c) +instance Crypto c => NoThunks (PrtclPredicateFailure c) instance ( Crypto c @@ -224,20 +224,20 @@ instance data PrtlSeqFailure c = WrongSlotIntervalPrtclSeq + -- | Last slot number. SlotNo - -- ^ Last slot number. + -- | Current slot number. SlotNo - -- ^ Current slot number. | WrongBlockNoPrtclSeq + -- | Last applied block. (WithOrigin (LastAppliedBlock c)) - -- ^ Last applied block. + -- | Current block number. BlockNo - -- ^ Current block number. | WrongBlockSequencePrtclSeq + -- | Last applied hash (PrevHash c) - -- ^ Last applied hash + -- | Current block's previous hash (PrevHash c) - -- ^ Current block's previous hash deriving (Show, Eq, Generic) instance Crypto c => NoThunks (PrtlSeqFailure c) diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Updn.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Updn.hs index 9fd1aa27cc3..78cac38a33d 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Updn.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/Rules/Updn.hs @@ -38,7 +38,7 @@ instance NoThunks (UpdnPredicateFailure c) newtype UpdnEvent c = NewEpoch EpochNo instance - (Crypto c) => + Crypto c => STS (UPDN c) where type State (UPDN c) = UpdnState diff --git a/libs/ledger-state/src/Cardano/Ledger/State/UTxO.hs b/libs/ledger-state/src/Cardano/Ledger/State/UTxO.hs index 4d09fe2d738..8f649a16523 100644 --- a/libs/ledger-state/src/Cardano/Ledger/State/UTxO.hs +++ b/libs/ledger-state/src/Cardano/Ledger/State/UTxO.hs @@ -151,7 +151,9 @@ instance Pretty (Stat k) where pretty n <+> "/" <+> pretty statCount - <+> "(" <> pretty (intPercent n statCount) <> " unique)" + <+> "(" + <> pretty (intPercent n statCount) + <> " unique)" where n = Set.size statUnique diff --git a/libs/non-integral/src/Cardano/Ledger/NonIntegral.hs b/libs/non-integral/src/Cardano/Ledger/NonIntegral.hs index f77a184b38b..b352a611395 100644 --- a/libs/non-integral/src/Cardano/Ledger/NonIntegral.hs +++ b/libs/non-integral/src/Cardano/Ledger/NonIntegral.hs @@ -16,7 +16,7 @@ data CompareResult a | MaxReached Int deriving (Show, Eq) -scaleExp :: (RealFrac a) => a -> (Integer, a) +scaleExp :: RealFrac a => a -> (Integer, a) scaleExp x = (x', x / fromIntegral x') where x' = ceiling x @@ -42,7 +42,7 @@ ipow x n | n < 0 = 1 / ipow' x (-n) | otherwise = ipow' x n -logAs :: (Num a) => a -> [a] +logAs :: Num a => a -> [a] logAs a = a' : a' : logAs (a + 1) where a' = a * a @@ -57,7 +57,7 @@ lncf maxN x where as = x : map (* x) (logAs 1) -eps :: (Fractional a) => a +eps :: Fractional a => a eps = 1 / 10 ^ (24 :: Int) -- | Compute continued fraction using max steps or bounded list of a/b factors. @@ -153,7 +153,7 @@ exp1 :: (RealFrac a, Show a) => a exp1 = exp' 1 -- | find n with `e^n<=x a -> a -> Integer +findE :: RealFrac a => a -> a -> Integer findE e x = contract e x lower upper where (lower, upper) = bound e x (1 / e) e (-1) 1 @@ -194,7 +194,7 @@ taylorExp maxN n x lastX acc divisor -- exponential function to a threshold value. Using error estimation one can -- stop early, once it's known the result will certainly be above or below the -- target value. -taylorExpCmp :: (RealFrac a) => a -> a -> a -> CompareResult a +taylorExpCmp :: RealFrac a => a -> a -> a -> CompareResult a taylorExpCmp boundX cmp x = go 1000 0 x 1 1 where go maxN n err acc divisor diff --git a/libs/set-algebra/src/Control/Iterate/BaseTypes.hs b/libs/set-algebra/src/Control/Iterate/BaseTypes.hs index 83f0987f674..2e0a9d3558d 100644 --- a/libs/set-algebra/src/Control/Iterate/BaseTypes.hs +++ b/libs/set-algebra/src/Control/Iterate/BaseTypes.hs @@ -47,7 +47,7 @@ class Iter f where isnull f = isempty (nxt f) lookup :: Ord key => key -> f key rng -> Maybe rng lookup k x = case hasLub k x of Nothing -> Nothing; Just (key, v, _) -> if k == key then Just v else Nothing - element :: (Ord k) => k -> f k v -> Collect () + element :: Ord k => k -> f k v -> Collect () element k f = when (haskey k f) -- ================================================================================================== @@ -58,14 +58,14 @@ class Iter f where -- Instances of this algebra are functional in that every key has exactly one value associated with it. class Basic f where -- | in addpair the new value always prevails, to make a choice use 'addkv' which has a combining function that allows choice. - addpair :: (Ord k) => k -> v -> f k v -> f k v + addpair :: Ord k => k -> v -> f k v -> f k v addpair k v f = addkv (k, v) f (\_old new -> new) -- | use (\ old new -> old) if you want the v in (f k v) to prevail, and use (\ old new -> new) if you want the v in (k,v) to prevail addkv :: Ord k => (k, v) -> f k v -> (v -> v -> v) -> f k v -- | remove the pair with key 'k', if it is there. - removekey :: (Ord k) => k -> f k v -> f k v + removekey :: Ord k => k -> f k v -> f k v -- | the set of keys domain :: Ord k => f k v -> Set k diff --git a/libs/set-algebra/src/Control/Iterate/Exp.hs b/libs/set-algebra/src/Control/Iterate/Exp.hs index cd99de5c45f..05af288f052 100644 --- a/libs/set-algebra/src/Control/Iterate/Exp.hs +++ b/libs/set-algebra/src/Control/Iterate/Exp.hs @@ -65,8 +65,8 @@ data Exp t where UnionPlus :: (Ord k, Monoid n) => Exp (f k n) -> Exp (g k n) -> Exp (f k n) UnionOverrideRight :: Ord k => Exp (f k v) -> Exp (g k v) -> Exp (f k v) -- If 'k' appears in both, then choose the 'v' from the right 'g' - Singleton :: (Ord k) => k -> v -> Exp (Single k v) - SetSingleton :: (Ord k) => k -> Exp (Single k ()) + Singleton :: Ord k => k -> v -> Exp (Single k v) + SetSingleton :: Ord k => k -> Exp (Single k ()) KeyEqual :: (Ord k, Iter f, Iter g) => Exp (f k v) -> Exp (g k u) -> Exp Bool instance Show (Exp t) where @@ -107,16 +107,16 @@ class HasExp s t | s -> t where instance HasExp (Exp t) t where toExp x = x -instance (Ord k) => HasExp (Map k v) (Map k v) where +instance Ord k => HasExp (Map k v) (Map k v) where toExp x = Base MapR x -instance (Ord k) => HasExp (Set.Set k) (Sett k ()) where +instance Ord k => HasExp (Set.Set k) (Sett k ()) where toExp x = Base SetR (Sett x) -instance (Ord k) => HasExp [(k, v)] (List k v) where +instance Ord k => HasExp [(k, v)] (List k v) where toExp l = Base ListR (UnSafeList (sortBy (\x y -> compare (fst x) (fst y)) l)) -instance (Ord k) => HasExp (Single k v) (Single k v) where +instance Ord k => HasExp (Single k v) (Single k v) where toExp x = Base SingleR x type OrdAll coin cred pool ptr k = (Ord k, Ord coin, Ord cred, Ord ptr, Ord pool) @@ -204,11 +204,11 @@ unionright = (⨃) unionplus = (∪+) -- | create a singleton map. -singleton :: (Ord k) => k -> v -> Exp (Single k v) +singleton :: Ord k => k -> v -> Exp (Single k v) singleton k v = Singleton k v -- | create a singleton set. -setSingleton :: (Ord k) => k -> Exp (Single k ()) +setSingleton :: Ord k => k -> Exp (Single k ()) setSingleton k = SetSingleton k -- | intersect two sets, or the intersection of the domain of two maps. diff --git a/libs/set-algebra/src/Control/Iterate/SetAlgebra.hs b/libs/set-algebra/src/Control/Iterate/SetAlgebra.hs index ad51546973e..512449d01e5 100644 --- a/libs/set-algebra/src/Control/Iterate/SetAlgebra.hs +++ b/libs/set-algebra/src/Control/Iterate/SetAlgebra.hs @@ -113,7 +113,7 @@ compileSubterm _whole sub = fst (compile sub) -- convert it. -- =========================================================================== -run :: (Ord k) => (Query k v, BaseRep f k v) -> f k v +run :: Ord k => (Query k v, BaseRep f k v) -> f k v run (BaseD SetR x, SetR) = x -- If it is already data (BaseD) run (BaseD MapR x, MapR) = x -- and in the right form (the BaseRep's match) run (BaseD SingleR x, SingleR) = x -- just return the data @@ -373,7 +373,7 @@ fromList SingleR combine xs = foldr (addp combine) Fail xs -- the witness describes how to turn them into the chosen datatype. Note that materialize is meant -- to be applied to a collection built by iterating over a Query. This produces the keys in -- ascending order, with no duplicate keys. So we do not need to specify how to merge duplicate values. -materialize :: (Ord k) => BaseRep f k v -> Collect (k, v) -> f k v +materialize :: Ord k => BaseRep f k v -> Collect (k, v) -> f k v materialize ListR x = fromPairs (\l _r -> l) (runCollect x [] (:)) materialize MapR x = runCollect x Map.empty (\(k, v) ans -> Map.insert k v ans) materialize SetR x = Sett (runCollect x Set.empty (\(k, _) ans -> Set.insert k ans)) diff --git a/libs/set-algebra/test/Test/Control/Iterate/RelationReference.hs b/libs/set-algebra/test/Test/Control/Iterate/RelationReference.hs index 418438ca813..1daae2eaf19 100644 --- a/libs/set-algebra/test/Test/Control/Iterate/RelationReference.hs +++ b/libs/set-algebra/test/Test/Control/Iterate/RelationReference.hs @@ -38,12 +38,12 @@ class Relation m where -- | Domain restriction -- -- Unicode: 25c1 - (◁) :: (Ord (Domain m)) => Set (Domain m) -> m -> m + (◁) :: Ord (Domain m) => Set (Domain m) -> m -> m -- | Domain exclusion -- -- Unicode: 22ea - (⋪) :: (Ord (Domain m)) => Set (Domain m) -> m -> m + (⋪) :: Ord (Domain m) => Set (Domain m) -> m -> m -- | Range restriction -- diff --git a/libs/small-steps-test/src/Control/State/Transition/Generator.hs b/libs/small-steps-test/src/Control/State/Transition/Generator.hs index 7a5a2964ca0..17a60e6e97f 100644 --- a/libs/small-steps-test/src/Control/State/Transition/Generator.hs +++ b/libs/small-steps-test/src/Control/State/Transition/Generator.hs @@ -131,7 +131,7 @@ class STS s => HasTrace s where -- initial environment. This obviously places some contraints on the nature of -- the base monad for a trace to be completed. interpretSTS :: forall a. (BaseEnv s -> BaseM s a -> a) - default interpretSTS :: (BaseM s ~ Identity) => forall a. BaseEnv s -> BaseM s a -> a + default interpretSTS :: BaseM s ~ Identity => forall a. BaseEnv s -> BaseM s a -> a interpretSTS _ (Identity x) = x -- | Generate an initial environment that is based on the given trace length. @@ -280,7 +280,7 @@ genTraceOfMaxOrDesiredLength baseEnv aTraceLength profile env st0 gen = -- signal generator. genTrace :: forall s. - (HasTrace s) => + HasTrace s => BaseEnv s -> -- | Trace upper bound. This will be linearly scaled as a function of the -- generator size. @@ -298,7 +298,7 @@ genTrace baseEnv ub = genTraceWithProfile baseEnv ub allValid -- | Return a trace generator given an initial state, environment, and signal generator. genTraceWithProfile :: forall s. - (HasTrace s) => + HasTrace s => BaseEnv s -> -- | Trace upper bound. This will be linearly scaled as a function of the -- generator size. @@ -337,7 +337,7 @@ genTraceWithProfile baseEnv ub profile env st0 aSigGen = -- generator can generate invalid signals, then the size of resulting trace is not guaranteed. genTraceOfLength :: forall s. - (HasTrace s) => + HasTrace s => BaseEnv s -> -- | Desired trace length. Word64 -> diff --git a/libs/small-steps-test/src/Control/State/Transition/Trace.hs b/libs/small-steps-test/src/Control/State/Transition/Trace.hs index c4f05e92143..efe7532b2ac 100644 --- a/libs/small-steps-test/src/Control/State/Transition/Trace.hs +++ b/libs/small-steps-test/src/Control/State/Transition/Trace.hs @@ -485,7 +485,7 @@ extractValues d = catMaybes (gmapQ extractValue d) ++ concat (gmapQ extractValues d) where - extractValue :: forall d1. (Data d1) => d1 -> Maybe a + extractValue :: forall d1. Data d1 => d1 -> Maybe a extractValue d1 = cast d1 data SourceSignalTarget a = SourceSignalTarget diff --git a/libs/small-steps-test/src/Control/State/Transition/Trace/Generator/QuickCheck.hs b/libs/small-steps-test/src/Control/State/Transition/Trace/Generator/QuickCheck.hs index 37089c38f04..9c267181ae3 100644 --- a/libs/small-steps-test/src/Control/State/Transition/Trace/Generator/QuickCheck.hs +++ b/libs/small-steps-test/src/Control/State/Transition/Trace/Generator/QuickCheck.hs @@ -62,7 +62,7 @@ class STS sts => HasTrace sts traceGenEnv where -- initial environment. This obviously places some contraints on the nature of -- the base monad for a trace to be completed. interpretSTS :: forall a. HasCallStack => (BaseEnv sts -> STS.BaseM sts a -> a) - default interpretSTS :: (STS.BaseM sts ~ Identity) => forall a. BaseEnv sts -> STS.BaseM sts a -> a + default interpretSTS :: STS.BaseM sts ~ Identity => forall a. BaseEnv sts -> STS.BaseM sts a -> a interpretSTS _ (Identity x) = x envGen :: HasCallStack => traceGenEnv -> QuickCheck.Gen (Environment sts) @@ -79,8 +79,7 @@ class STS sts => HasTrace sts traceGenEnv where -- | Generate a random trace starting in the given environment and initial state. traceFrom :: forall sts traceGenEnv. - ( HasTrace sts traceGenEnv - ) => + HasTrace sts traceGenEnv => BaseEnv sts -> -- | Maximum trace length. Word64 -> @@ -205,8 +204,7 @@ forAllTrace baseEnv maxTraceLength traceGenEnv = -- in the shrunk traces. shrinkTrace :: forall sts traceGenEnv. - ( HasTrace sts traceGenEnv - ) => + HasTrace sts traceGenEnv => BaseEnv sts -> Trace sts -> [Trace sts] diff --git a/libs/small-steps-test/test/Control/State/Transition/Examples/CommitReveal.hs b/libs/small-steps-test/test/Control/State/Transition/Examples/CommitReveal.hs index e1882565535..c21e9d1e6dd 100644 --- a/libs/small-steps-test/test/Control/State/Transition/Examples/CommitReveal.hs +++ b/libs/small-steps-test/test/Control/State/Transition/Examples/CommitReveal.hs @@ -67,11 +67,11 @@ data CRSt hashAlgo hashToDataMap commitData = CRSt } deriving instance - (Eq (hashToDataMap (Hash hashAlgo Data) commitData)) => + Eq (hashToDataMap (Hash hashAlgo Data) commitData) => Eq (CRSt hashAlgo hashToDataMap commitData) deriving instance - (Show (hashToDataMap (Hash hashAlgo Data) commitData)) => + Show (hashToDataMap (Hash hashAlgo Data) commitData) => Show (CRSt hashAlgo hashToDataMap commitData) class MapLike m k v where diff --git a/libs/small-steps/src/Control/Provenance.hs b/libs/small-steps/src/Control/Provenance.hs index 2bc9b29e27c..bffbc3746ba 100644 --- a/libs/small-steps/src/Control/Provenance.hs +++ b/libs/small-steps/src/Control/Provenance.hs @@ -115,7 +115,7 @@ runWithProvM s (ProvM m) = do {-# INLINE runWithProvM #-} -- | Run the computation with SNothing. Expend no resources to compute provenance. -runProvM :: (Monad m) => ProvM s m b -> m b +runProvM :: Monad m => ProvM s m b -> m b runProvM (ProvM m) = do pair <- runStateT m SNothing case pair of @@ -304,7 +304,7 @@ instance Show PObject where -- does not have the right type, returns SNothing. If the type context -- of the call does not fix the type, one can use a type application like -- extract @[Int] pobject -extract :: forall t. (Typeable t) => PObject -> StrictMaybe t +extract :: forall t. Typeable t => PObject -> StrictMaybe t extract (PObject ty n) = case testEquality ty (typeRep @t) of Just Refl -> SJust n; Nothing -> SNothing -- | inject a type into the PObject type. diff --git a/libs/vector-map/src/Data/VMap.hs b/libs/vector-map/src/Data/VMap.hs index 1550defc093..e8e8b654707 100644 --- a/libs/vector-map/src/Data/VMap.hs +++ b/libs/vector-map/src/Data/VMap.hs @@ -107,7 +107,7 @@ instance empty :: (VG.Vector kv k, VG.Vector vv v) => VMap kv vv k v empty = VMap VG.empty -size :: (VG.Vector kv k) => VMap kv vv k v -> Int +size :: VG.Vector kv k => VMap kv vv k v -> Int size = VG.length . KV.keysVector . unVMap {-# INLINE size #-}