Merge pull request #1984 from sgillespie/feature/remove-ghc-810

Nix: Drop GHC < 9.6 and update flake inputs

Author: kderme

.hlint.yaml

@@ -21,33 +21,31 @@
 # - flags:
 #   - {name: -w, within: []} # -w is allowed nowhere
 #
-# - modules:
-#   - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
-#   - {name: Control.Arrow, within: []} # Certain modules are banned entirely
-#
-# - functions:
-#   - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules
-
 
 - modules:
   # If Data.List is imported qualified, it must be as 'List'
   - {name: [Data.List], as: List}
   - {name: [Data.Map.Strict], as: Map}
   - {name: [Data.Set], as: Set}
   - {name: [Data.Text], as: Text}
-  - {name: [Data.ByteString.Char8], as: BS}
-  - {name: [Data.ByteString.Lazy.Char8], as: LBS}
   - {name: [Data.ByteString.Short], as: SBS}
 
-# Banned functions
 - functions:
   - {name: coerce, within: []}
+  - {name: unsafePerformIO, within: []}
 
 # Add custom hints for this project
 #
 # Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"
 # - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}
 
+# The hints are named by the string they display in warning messages.
+# For example, if you see a warning starting like
+#
+# Main.hs:116:51: Warning: Redundant ==
+#
+# You can refer to that hint with `{name: Redundant ==}` (see below).
+
 # The monad of no return will be here one day
 - error: {lhs: "return x", rhs: pure x}
 
@@ -62,12 +60,19 @@
 #
 # Generalise map to fmap, ++ to <>
 # - group: {name: generalise, enabled: true}
+#
+# Warn on use of partial functions
+# - group: {name: partial, enabled: true}
 
 
 # Ignore some builtin hints
 # - ignore: {name: Use let}
 # - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
 
+# Fuse on/on conflicts with Esqueleto's `on`
+- ignore: { name: "Fuse on/on" }
+
+
 
 # Define some custom infix operators
 # - fixity: infixr 3 ~^#^~

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/Scenarios.hs

@@ -51,9 +51,10 @@ delegateAndSendBlocks n interpreter = do
     stakeCreds = createStakeCredentials n
     payCreds = createPaymentCredentials n
     addresses =
-      map
-        (\(payCred, stakeCred) -> Addr Testnet payCred (StakeRefBase stakeCred))
-        (zip payCreds stakeCreds)
+      zipWith
+        (\payCred stakeCred -> Addr Testnet payCred (StakeRefBase stakeCred))
+        payCreds
+        stakeCreds
 
 mkRegisterBlocks :: [StakeCredential] -> Interpreter -> IO [CardanoBlock]
 mkRegisterBlocks creds interpreter = forgeBlocksChunked interpreter creds $ \txCreds _ ->
@@ -65,7 +66,7 @@ mkRegisterBlocks creds interpreter = forgeBlocksChunked interpreter creds $ \txC
 mkDelegateBlocks :: [StakeCredential] -> Interpreter -> IO [CardanoBlock]
 mkDelegateBlocks creds interpreter = forgeBlocksChunked interpreter creds $ \txCreds state' ->
   Conway.mkDCertTx
-    (map (mkDelegCert state') $ zip (cycle [0, 1, 2]) txCreds)
+    (zipWith (curry (mkDelegCert state')) (cycle [0, 1, 2]) txCreds)
     (Withdrawals mempty)
     Nothing
   where

cardano-chain-gen/src/Cardano/Mock/Query.hs

@@ -99,10 +99,10 @@ queryDRepDistrAmount ::
 queryDRepDistrAmount drepHash epochNo = do
   res <- selectOne $ do
     (distr :& hash) <-
-      from
-        $ table @Db.DrepDistr
+      from $
+        table @Db.DrepDistr
           `innerJoin` table @Db.DrepHash
-        `on` (\(distr :& hash) -> (hash ^. Db.DrepHashId) ==. (distr ^. Db.DrepDistrHashId))
+            `on` (\(distr :& hash) -> (hash ^. Db.DrepHashId) ==. (distr ^. Db.DrepDistrHashId))
 
     where_ $ hash ^. Db.DrepHashRaw ==. just (val drepHash)
     where_ $ distr ^. Db.DrepDistrEpochNo ==. val epochNo
@@ -141,16 +141,16 @@ queryConstitutionAnchor ::
 queryConstitutionAnchor epochNo = do
   res <- selectOne $ do
     (_ :& anchor :& epochState) <-
-      from
-        $ table @Db.Constitution
+      from $
+        table @Db.Constitution
           `innerJoin` table @Db.VotingAnchor
-        `on` ( \(constit :& anchor) ->
-                (constit ^. Db.ConstitutionVotingAnchorId) ==. (anchor ^. Db.VotingAnchorId)
-             )
+            `on` ( \(constit :& anchor) ->
+                     (constit ^. Db.ConstitutionVotingAnchorId) ==. (anchor ^. Db.VotingAnchorId)
+                 )
           `innerJoin` table @Db.EpochState
-        `on` ( \(constit :& _ :& epoch) ->
-                just (constit ^. Db.ConstitutionId) ==. (epoch ^. Db.EpochStateConstitutionId)
-             )
+            `on` ( \(constit :& _ :& epoch) ->
+                     just (constit ^. Db.ConstitutionId) ==. (epoch ^. Db.EpochStateConstitutionId)
+                 )
 
     where_ (epochState ^. Db.EpochStateEpochNo ==. val epochNo)
 
@@ -176,7 +176,7 @@ queryTreasuryDonations = do
     txs <- from $ table @Db.Tx
     pure $ sum_ (txs ^. Db.TxTreasuryDonation)
 
-  let total = join (unValue <$> res)
+  let total = unValue =<< res
   pure $ maybe 0 Db.unDbLovelace total
 
 queryVoteCounts ::
@@ -194,10 +194,10 @@ queryVoteCounts txHash idx = do
     countVotes v = do
       res <- selectOne $ do
         (vote :& tx) <-
-          from
-            $ table @Db.VotingProcedure
+          from $
+            table @Db.VotingProcedure
               `innerJoin` table @Db.Tx
-            `on` (\(vote :& tx) -> vote ^. Db.VotingProcedureTxId ==. tx ^. Db.TxId)
+                `on` (\(vote :& tx) -> vote ^. Db.VotingProcedureTxId ==. tx ^. Db.TxId)
         where_ $
           vote
             ^. Db.VotingProcedureVote
@@ -226,16 +226,16 @@ queryCommitteeByTxHash ::
 queryCommitteeByTxHash txHash = do
   res <- selectOne $ do
     (committee :& _ :& tx) <-
-      from
-        $ table @Db.Committee
+      from $
+        table @Db.Committee
           `innerJoin` table @Db.GovActionProposal
-        `on` ( \(committee :& govAction) ->
-                committee ^. Db.CommitteeGovActionProposalId ==. just (govAction ^. Db.GovActionProposalId)
-             )
+            `on` ( \(committee :& govAction) ->
+                     committee ^. Db.CommitteeGovActionProposalId ==. just (govAction ^. Db.GovActionProposalId)
+                 )
           `innerJoin` table @Db.Tx
-        `on` ( \(_ :& govAction :& tx) ->
-                govAction ^. Db.GovActionProposalTxId ==. tx ^. Db.TxId
-             )
+            `on` ( \(_ :& govAction :& tx) ->
+                     govAction ^. Db.GovActionProposalTxId ==. tx ^. Db.TxId
+                 )
     where_ (tx ^. Db.TxHash ==. val txHash)
     pure committee
 
@@ -248,20 +248,20 @@ queryCommitteeMemberCountByTxHash ::
 queryCommitteeMemberCountByTxHash txHash = do
   res <- selectOne $ do
     (_ :& committee :& _ :& tx) <-
-      from
-        $ table @Db.CommitteeMember
+      from $
+        table @Db.CommitteeMember
           `innerJoin` table @Db.Committee
-        `on` ( \(member :& committee) ->
-                member ^. Db.CommitteeMemberCommitteeId ==. committee ^. Db.CommitteeId
-             )
+            `on` ( \(member :& committee) ->
+                     member ^. Db.CommitteeMemberCommitteeId ==. committee ^. Db.CommitteeId
+                 )
           `leftJoin` table @Db.GovActionProposal
-        `on` ( \(_ :& committee :& govAction) ->
-                committee ^. Db.CommitteeGovActionProposalId ==. govAction ?. Db.GovActionProposalId
-             )
+            `on` ( \(_ :& committee :& govAction) ->
+                     committee ^. Db.CommitteeGovActionProposalId ==. govAction ?. Db.GovActionProposalId
+                 )
           `leftJoin` table @Db.Tx
-        `on` ( \(_ :& _ :& govAction :& tx) ->
-                govAction ?. Db.GovActionProposalTxId ==. tx ?. Db.TxId
-             )
+            `on` ( \(_ :& _ :& govAction :& tx) ->
+                     govAction ?. Db.GovActionProposalTxId ==. tx ?. Db.TxId
+                 )
 
     where_ $
       case txHash of

cardano-chain-gen/test/Test/Cardano/Db/Mock/UnifiedApi.hs

@@ -33,7 +33,7 @@ import qualified Cardano.Mock.Forging.Tx.Conway.Scenarios as Conway
 import Cardano.Mock.Forging.Types
 import Cardano.Slotting.Slot (SlotNo (..))
 import Control.Concurrent.Class.MonadSTM.Strict (atomically)
-import Control.Monad (forM, replicateM)
+import Control.Monad (replicateM)
 import Data.Word (Word64)
 import Ouroboros.Consensus.Cardano.Block (
   BabbageEra,
@@ -63,7 +63,7 @@ forgeNextSkipSlotsFindLeaderAndSubmit interpreter mockServer skipSlots txs' = do
 
 forgeAndSubmitBlocks :: Interpreter -> ServerHandle IO CardanoBlock -> Int -> IO [CardanoBlock]
 forgeAndSubmitBlocks interpreter mockServer blocksToCreate =
-  forM [1 .. blocksToCreate] $ \_ -> forgeNextFindLeaderAndSubmit interpreter mockServer []
+  replicateM blocksToCreate (forgeNextFindLeaderAndSubmit interpreter mockServer [])
 
 withAlonzoFindLeaderAndSubmit ::
   Interpreter ->

cardano-db-sync/app/test-http-get-json-metadata.hs

@@ -142,10 +142,10 @@ queryTestOffChainData :: MonadIO m => ReaderT SqlBackend m [TestOffChain]
 queryTestOffChainData = do
   res <- select $ do
     (pod :& pmr) <-
-      from
-        $ table @OffChainPoolData
+      from $
+        table @OffChainPoolData
           `innerJoin` table @PoolMetadataRef
-        `on` (\(pod :& pmr) -> pod ^. OffChainPoolDataPmrId ==. pmr ^. PoolMetadataRefId)
+            `on` (\(pod :& pmr) -> pod ^. OffChainPoolDataPmrId ==. pmr ^. PoolMetadataRefId)
     where_ $ notExists (from (table @PoolRetire) >>= \pr -> where_ (pod ^. OffChainPoolDataPoolId ==. pr ^. PoolRetireHashId))
     pure
       ( pod ^. OffChainPoolDataTickerName

cardano-db-sync/src/Cardano/DbSync/Config/Node.hs

@@ -78,8 +78,8 @@ readByteStringFromFile fp cfgType =
 -- -------------------------------------------------------------------------------------------------
 
 instance FromJSON NodeConfig where
-  parseJSON v =
-    Aeson.withObject "NodeConfig" parse v
+  parseJSON =
+    Aeson.withObject "NodeConfig" parse
     where
       parse :: Object -> Parser NodeConfig
       parse o =

cardano-db-sync/src/Cardano/DbSync/DbAction.hs

@@ -56,7 +56,7 @@ waitRestartState tc = do
 waitDoneInit :: ThreadChannels -> IO ()
 waitDoneInit tc = atomically $ do
   isDone <- readTVar (tcDoneInit tc)
-  if isDone then pure () else retry
+  unless isDone retry
 
 runAndSetDone :: ThreadChannels -> IO Bool -> IO Bool
 runAndSetDone tc action = do

cardano-db-sync/src/Cardano/DbSync/Epoch.hs

@@ -82,20 +82,20 @@ updateEpochStart syncEnv cache slotDetails isNewEpochEvent isBoundaryBlock = do
   let curEpochNo = unEpochNo $ sdEpochNo slotDetails
 
   if
-      -- The tip has been reached so now replace/update the epoch every block.
-      | getSyncStatus slotDetails == SyncFollowing ->
-          handleEpochWhenFollowing syncEnv cache mLastMapEpochFromCache mEpochBlockDiff curEpochNo
-      -- When syncing we check if current block is the first block in an epoch.
-      -- If so then it's time to put the previous epoch into the DB.
-      | isNewEpochEvent ->
-          updateEpochWhenSyncing syncEnv cache mEpochBlockDiff mLastMapEpochFromCache curEpochNo isBoundaryBlock
-      -- we're syncing and the epochNo are the same so we just update the cache until above check passes.
-      | otherwise ->
-          handleEpochCachingWhenSyncing
-            syncEnv
-            cache
-            mLastMapEpochFromCache
-            mEpochBlockDiff
+    -- The tip has been reached so now replace/update the epoch every block.
+    | getSyncStatus slotDetails == SyncFollowing ->
+        handleEpochWhenFollowing syncEnv cache mLastMapEpochFromCache mEpochBlockDiff curEpochNo
+    -- When syncing we check if current block is the first block in an epoch.
+    -- If so then it's time to put the previous epoch into the DB.
+    | isNewEpochEvent ->
+        updateEpochWhenSyncing syncEnv cache mEpochBlockDiff mLastMapEpochFromCache curEpochNo isBoundaryBlock
+    -- we're syncing and the epochNo are the same so we just update the cache until above check passes.
+    | otherwise ->
+        handleEpochCachingWhenSyncing
+          syncEnv
+          cache
+          mLastMapEpochFromCache
+          mEpochBlockDiff
 
 -----------------------------------------------------------------------------------------------------
 -- When Following

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/Block.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}

cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Generic/ProtoParams.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE NoImplicitPrelude #-}