Merge #4504

4504: GHC 9.2.4 preparations r=newhoggy a=newhoggy

These changes move the code towards `ghc-9.2.4` compatibility.

Co-authored-by: John Ky <[email protected]>

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs

@@ -57,7 +57,7 @@ assumeMapCosts _proxy = stepFunction [
     , ( 744 , 4)          -- 744 entries at 4 bytes.
     ]
   where
-    firstEntry = case shelleyBasedEra @ era of
+    firstEntry = case shelleyBasedEra @era of
       ShelleyBasedEraShelley -> 37
       ShelleyBasedEraAllegra -> 39
       ShelleyBasedEraMary    -> 39
@@ -128,11 +128,11 @@ dummyTxSizeInEra metadata = case createAndValidateTransactionBody dummyTx of
     }
 
 dummyTxSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int
-dummyTxSize _p m = (dummyTxSizeInEra @ era) $ metadataInEra m
+dummyTxSize _p m = (dummyTxSizeInEra @era) $ metadataInEra m
 
 metadataInEra :: forall era . IsShelleyBasedEra era => Maybe TxMetadata -> TxMetadataInEra era
 metadataInEra Nothing = TxMetadataNone
-metadataInEra (Just m) = case txMetadataSupportedInEra (cardanoEra @ era) of
+metadataInEra (Just m) = case txMetadataSupportedInEra (cardanoEra @era) of
   Nothing -> error "unreachable"
   Just e -> TxMetadataInEra e m
 
@@ -143,7 +143,7 @@ mkMetadata size
       then Left $ "Error : metadata must be 0 or at least " ++ show minSize ++ " bytes in this era."
       else Right $ metadataInEra $ Just metadata
  where
-  minSize = case shelleyBasedEra @ era of
+  minSize = case shelleyBasedEra @era of
     ShelleyBasedEraShelley -> 37
     ShelleyBasedEraAllegra -> 39
     ShelleyBasedEraMary    -> 39

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs

@@ -186,7 +186,7 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
   txToIdSize = (Mempool.txId &&& txInBlockSize) . toGenTx
 
   toGenTx :: tx -> GenTx CardanoBlock
-  toGenTx tx = case shelleyBasedEra @ era of
+  toGenTx tx = case shelleyBasedEra @era of
     ShelleyBasedEraShelley  -> toConsensusGenTx $ TxInMode tx ShelleyEraInCardanoMode
     ShelleyBasedEraAllegra  -> toConsensusGenTx $ TxInMode tx AllegraEraInCardanoMode
     ShelleyBasedEraMary     -> toConsensusGenTx $ TxInMode tx MaryEraInCardanoMode

bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs

@@ -112,7 +112,7 @@ addFund era wallet txIn lovelace keyName = do
   fundKey  <- getName keyName
   let
     mkOutValue :: forall era. IsShelleyBasedEra era => AsType era -> ActionM (InAnyCardanoEra TxOutValue)
-    mkOutValue = \_ -> return $ InAnyCardanoEra (cardanoEra @ era) (lovelaceToTxOutValue lovelace)
+    mkOutValue = \_ -> return $ InAnyCardanoEra (cardanoEra @era) (lovelaceToTxOutValue lovelace)
   outValue <- withEra era mkOutValue
   addFundToWallet wallet txIn outValue fundKey
 
@@ -145,7 +145,7 @@ getConnectClient = do
   tracers  <- get BenchTracers
   (Testnet networkMagic) <- getUser TNetworkId
   protocol <- get Protocol
-  void $ return $(btSubmission2_ tracers)
+  void $ return $ btSubmission2_ tracers -- TODO this line looks strange
   ioManager <- askIOManager
   return $ benchmarkConnectTxSubmit
                        ioManager
@@ -354,8 +354,8 @@ selectCollateralFunds (Just walletName) = do
   collateralFunds <- liftIO ( askWalletRef cw FundQueue.toList ) >>= \case
     [] -> throwE $ WalletError "selectCollateralFunds: emptylist"
     l -> return l
-  case collateralSupportedInEra (cardanoEra @ era) of
-      Nothing -> throwE $ WalletError $ "selectCollateralFunds: collateral: era not supported :" ++ show (cardanoEra @ era)
+  case collateralSupportedInEra (cardanoEra @era) of
+      Nothing -> throwE $ WalletError $ "selectCollateralFunds: collateral: era not supported :" ++ show (cardanoEra @era)
       Just p -> return (TxInsCollateral p $  map getFundTxIn collateralFunds, collateralFunds)
 
 dumpToFile :: FilePath -> TxInMode CardanoMode -> ActionM ()
@@ -375,7 +375,7 @@ interpretPayMode payMode = do
       fundKey <- getName keyName
       walletRef <- getName destWallet
       return ( createAndStore (mkUTxOVariant networkId fundKey) (mkWalletFundStore walletRef)
-             , Text.unpack $ serialiseAddress $ Utils.keyAddress @ era networkId fundKey)
+             , Text.unpack $ serialiseAddress $ Utils.keyAddress @era networkId fundKey)
     PayToScript scriptSpec destWallet -> do
       walletRef <- getName destWallet
       (witness, script, scriptData, _scriptFee) <- makePlutusContext scriptSpec
@@ -483,8 +483,8 @@ makePlutusContext scriptSpec = do
 
     PlutusScript PlutusScriptV1 script' = script
     scriptWitness :: ScriptWitness WitCtxTxIn era
-    scriptWitness = case scriptLanguageSupportedInEra (cardanoEra @ era) (PlutusScriptLanguage PlutusScriptV1) of
-      Nothing -> error $ "runPlutusBenchmark: Plutus V1 scriptlanguage not supported : in era" ++ show (cardanoEra @ era)
+    scriptWitness = case scriptLanguageSupportedInEra (cardanoEra @era) (PlutusScriptLanguage PlutusScriptV1) of
+      Nothing -> error $ "runPlutusBenchmark: Plutus V1 scriptlanguage not supported : in era" ++ show (cardanoEra @era)
       Just scriptLang -> PlutusScriptWitness
                           scriptLang
                           PlutusScriptV1

bench/tx-generator/test/Main.hs

@@ -17,6 +17,7 @@ tests =  testGroup "cardano-tx-generator"
     sizedMetadata
   ]
 
+sizedMetadata :: TestTree
 sizedMetadata = testGroup "properties of the CBOR encoding relevant for generating sized metadat"
   [ testCase "Shelley metadata map costs"          $ assertBool "metadata map costs" prop_mapCostsShelley
   , testCase "Shelley metadata ByteString costs"   $ assertBool "metadata ByteString costs" prop_bsCostsShelley

cardano-api/cardano-api.cabal

@@ -201,10 +201,8 @@ test-suite cardano-api-test
   type:                 exitcode-stdio-1.0
 
   build-depends:        aeson             >= 1.5.6.0
-                      , bytestring
                       , cardano-api
                       , cardano-api:gen
-                      , cardano-binary
                       , cardano-data
                       , cardano-crypto
                       , cardano-crypto-class

cardano-api/src/Cardano/Api/LedgerEvent.hs

@@ -97,7 +97,7 @@ instance
 instance All ConvertLedgerEvent xs => ConvertLedgerEvent (HardForkBlock xs) where
   toLedgerEvent =
     hcollapse
-      . hcmap (Proxy @ ConvertLedgerEvent) (K . toLedgerEvent)
+      . hcmap (Proxy @ConvertLedgerEvent) (K . toLedgerEvent)
       . getOneEraLedgerEvent
       . unwrapLedgerEvent
 

cardano-api/src/Cardano/Api/LedgerState.hs

@@ -82,7 +82,7 @@ import           Data.SOP.Strict (NP (..))
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
-import           Data.Text.Lazy (toStrict)
+import qualified Data.Text.Lazy as LT
 import           Data.Text.Lazy.Builder (toLazyText)
 import           Data.Word
 import qualified Data.Yaml as Yaml
@@ -1294,7 +1294,7 @@ instance Error LeadershipError where
   displayError LeaderErrDecodeLedgerStateFailure =
     "Failed to successfully decode ledger state"
   displayError (LeaderErrDecodeProtocolStateFailure (_, decErr)) =
-    "Failed to successfully decode protocol state: " <> Text.unpack (toStrict . toLazyText $ build decErr)
+    "Failed to successfully decode protocol state: " <> Text.unpack (LT.toStrict . toLazyText $ build decErr)
   displayError LeaderErrGenesisSlot =
     "Leadership schedule currently cannot be calculated from genesis"
   displayError (LeaderErrStakePoolHasNoStake poolId) =

cardano-api/src/Cardano/Api/Query.hs

@@ -292,7 +292,7 @@ instance IsCardanoEra era => ToJSON (UTxO era) where
   toJSON (UTxO m) = toJSON m
   toEncoding (UTxO m) = toEncoding m
 
-instance (IsCardanoEra era, IsShelleyBasedEra era, FromJSON (TxOut CtxUTxO era))
+instance (IsShelleyBasedEra era, FromJSON (TxOut CtxUTxO era))
   => FromJSON (UTxO era) where
     parseJSON = withObject "UTxO" $ \hm -> do
       let l = HMS.toList $ KeyMap.toHashMapText hm
@@ -381,7 +381,6 @@ newtype CurrentEpochState era = CurrentEpochState (Shelley.EpochState (ShelleyLe
 
 decodeCurrentEpochState
   :: forall era. Ledger.Era (ShelleyLedgerEra era)
-  => Share (Core.TxOut (ShelleyLedgerEra era)) ~ Interns (Shelley.Credential 'Shelley.Staking (Ledger.Crypto (ShelleyLedgerEra era)))
   => FromSharedCBOR (Core.TxOut (ShelleyLedgerEra era))
   => Share (Core.TxOut (ShelleyLedgerEra era)) ~ Interns (Shelley.Credential 'Shelley.Staking (Ledger.Crypto (ShelleyLedgerEra era)))
   => FromCBOR (Core.PParams (ShelleyLedgerEra era))

cardano-api/src/Cardano/Api/TxSubmit/ErrorRender.hs

@@ -39,15 +39,15 @@ renderTxValidationError tve =
   "Tx Validation: " <>
     case tve of
       TxValidationLovelaceError txt e ->
-        sformat ("Lovelace error "% stext %": "% build) txt e
+        sformat ("Lovelace error " % stext % ": " % build) txt e
       TxValidationFeeTooSmall tx expected actual ->
-        sformat ("Tx "% build %" fee "% build %"too low, expected "% build) tx actual expected
+        sformat ("Tx " % build % " fee " % build % "too low, expected " % build) tx actual expected
       TxValidationWitnessWrongSignature wit pmid sig ->
-        sformat ("Bad witness "% build %" for signature "% stext %" protocol magic id "% stext) wit (textShow sig) (textShow pmid)
+        sformat ("Bad witness " % build % " for signature " % stext % " protocol magic id " % stext) wit (textShow sig) (textShow pmid)
       TxValidationWitnessWrongKey wit addr ->
-        sformat ("Bad witness "% build %" for address "% build) wit addr
+        sformat ("Bad witness " % build % " for address " % build) wit addr
       TxValidationMissingInput tx ->
-        sformat ("Validation cannot find input tx "% build) tx
+        sformat ("Validation cannot find input tx " % build) tx
       -- Fields are <expected> <actual>
       TxValidationNetworkMagicMismatch expected actual ->
         mconcat [ "Bad network magic  ", textShow actual, ", expected ", textShow expected ]
@@ -62,6 +62,6 @@ renderUTxOError :: UTxOError -> Text
 renderUTxOError ue =
   "UTxOError: " <>
     case ue of
-      UTxOMissingInput tx -> sformat ("Lookup of tx "% build %" failed") tx
+      UTxOMissingInput tx -> sformat ("Lookup of tx " % build % " failed") tx
       UTxOOverlappingUnion -> "Union or two overlapping UTxO sets"
 

cardano-api/src/Cardano/Api/TxSubmit/Types.hs

@@ -56,7 +56,7 @@ convertJson st =
 renderTxSubmitStatus :: TxSubmitStatus -> Text
 renderTxSubmitStatus st =
   case st of
-    TxSubmitOk tx -> sformat ("Tx "% build %" submitted successfully") tx
+    TxSubmitOk tx -> sformat ("Tx " % build % " submitted successfully") tx
     TxSubmitDecodeHex -> "Provided data was hex encoded and this webapi expects raw binary"
     TxSubmitEmpty -> "Provided transaction has zero length"
     TxSubmitDecodeFail err -> sformat build err

cardano-api/test/Test/Cardano/Api/Crypto.hs

@@ -69,13 +69,13 @@ testDSIGNAlgorithm _ n =
       , testGroup "size"
         [ testProperty "VerKey"  $ prop_size_serialise @(VerKeyDSIGN v)
                                                        rawSerialiseVerKeyDSIGN
-                                                       (sizeVerKeyDSIGN (Proxy @ v))
+                                                       (sizeVerKeyDSIGN (Proxy @v))
         , testProperty "SignKey" $ prop_size_serialise @(SignKeyDSIGN v)
                                                        rawSerialiseSignKeyDSIGN
-                                                       (sizeSignKeyDSIGN (Proxy @ v))
+                                                       (sizeSignKeyDSIGN (Proxy @v))
         , testProperty "Sig"     $ prop_size_serialise @(SigDSIGN v)
                                                        rawSerialiseSigDSIGN
-                                                       (sizeSigDSIGN (Proxy @ v))
+                                                       (sizeSigDSIGN (Proxy @v))
         ]
 
       , testGroup "direct CBOR"

cardano-cli/app/cardano-cli.hs

@@ -5,7 +5,7 @@
 #define UNIX
 #endif
 
-import           Cardano.Prelude hiding (option)
+import           Cardano.Prelude
 
 import           Control.Monad.Trans.Except.Exit (orDie)
 import qualified Options.Applicative as Opt

cardano-cli/cardano-cli.cabal

@@ -171,7 +171,6 @@ test-suite cardano-cli-test
 
   build-depends:        aeson
                       , bech32            >= 1.1.0
-                      , bytestring
                       , base16-bytestring
                       , cardano-api
                       , cardano-api:gen

cardano-cli/src/Cardano/CLI/Byron/Delegation.hs

@@ -12,7 +12,7 @@ module Cardano.CLI.Byron.Delegation
   )
 where
 
-import           Cardano.Prelude hiding (option, show, trace)
+import           Cardano.Prelude hiding (show, trace)
 
 import           Control.Monad.Trans.Except.Extra (left)
 import qualified Data.ByteString.Lazy as LB

cardano-cli/src/Cardano/CLI/Byron/Genesis.hs

@@ -12,7 +12,7 @@ module Cardano.CLI.Byron.Genesis
   )
 where
 
-import           Cardano.Prelude hiding (option, show, trace)
+import           Cardano.Prelude hiding (show, trace)
 import           Prelude (String)
 
 import           Control.Monad.Trans.Except.Extra (firstExceptT, left, right)
@@ -23,6 +23,7 @@ import           Data.Time (UTCTime)
 import           Formatting.Buildable
 
 import           Cardano.Api (Key (..), NetworkId, textShow, writeSecrets)
+
 import           Cardano.Api.Byron (ByronKey, SerialiseAsRawBytes (..), SigningKey (..),
                    toByronRequiresNetworkMagic)
 import           System.Directory (createDirectory, doesPathExist)

cardano-cli/src/Cardano/CLI/Byron/Key.hs

@@ -14,7 +14,7 @@ module Cardano.CLI.Byron.Key
   )
 where
 
-import           Cardano.Prelude hiding (option, show, trace, (%))
+import           Cardano.Prelude hiding (show, trace, (%))
 import           Prelude (show)
 
 import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left,
@@ -70,9 +70,9 @@ newtype NewVerificationKeyFile =
 --   its hash and formatted view.
 prettyPublicKey :: VerificationKey ByronKey-> Text
 prettyPublicKey (ByronVerificationKey vk) =
-  sformat (  "    public key hash: "% build %
-           "\npublic key (base64): "% Crypto.fullVerificationKeyF %
-           "\n   public key (hex): "% Crypto.fullVerificationKeyHexF)
+  sformat (  "    public key hash: " % build %
+           "\npublic key (base64): " % Crypto.fullVerificationKeyF %
+           "\n   public key (hex): " % Crypto.fullVerificationKeyHexF)
     (Common.addressHash vk) vk vk
 
 byronWitnessToVerKey :: SomeByronSigningKey -> VerificationKey ByronKey