Merge #1761

1761: Make ouroboros-consensus warning free r=mrBliss a=mrBliss Fixes #1659. We now use the following warning flags for all components in consensus: -Wall -Wcompat -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -Widentities -Wredundant-constraints -Wmissing-export-lists This PR fixes all warnings produced by these flags. Co-authored-by: Thomas Winant <[email protected]>
IntersectMBO · Mar 9, 2020 · 84bc329 · 84bc329
2 parents ef2e699 + 4ad69d4
commit 84bc329
Show file tree

Hide file tree

Showing 80 changed files with 191 additions and 129 deletions.
diff --git a/ouroboros-consensus-byron/ouroboros-consensus-byron.cabal b/ouroboros-consensus-byron/ouroboros-consensus-byron.cabal
@@ -67,7 +67,13 @@ library
 
   default-language:    Haskell2010
   ghc-options:         -Wall
+                       -Wcompat
+                       -Wincomplete-uni-patterns
+                       -Wincomplete-record-updates
+                       -Wpartial-fields
+                       -Widentities
                        -Wredundant-constraints
+                       -Wmissing-export-lists
   if flag(asserts)
     ghc-options:       -fno-ignore-asserts
 
@@ -124,14 +130,20 @@ test-suite test
 
   default-language:    Haskell2010
   ghc-options:         -Wall
+                       -Wcompat
+                       -Wincomplete-uni-patterns
+                       -Wincomplete-record-updates
+                       -Wpartial-fields
+                       -Widentities
                        -Wredundant-constraints
+                       -Wmissing-export-lists
                        -threaded
                        -rtsopts
 
 executable db-converter
-   hs-source-dirs:     tools/db-converter
-   main-is:            Main.hs
-   build-depends:      base
+  hs-source-dirs:      tools/db-converter
+  main-is:             Main.hs
+  build-depends:       base
                      , bytestring
                      , cardano-binary
                      , cardano-crypto-wrapper
@@ -152,9 +164,15 @@ executable db-converter
                      , ouroboros-consensus
                      , ouroboros-consensus-byron
 
-   default-language:   Haskell2010
-   ghc-options:        -Wall
+  default-language:    Haskell2010
+  ghc-options:         -Wall
+                       -Wcompat
+                       -Wincomplete-uni-patterns
+                       -Wincomplete-record-updates
+                       -Wpartial-fields
+                       -Widentities
                        -Wredundant-constraints
+                       -Wmissing-export-lists
 
 executable db-analyser
   hs-source-dirs:      tools/db-analyser
@@ -174,4 +192,10 @@ executable db-analyser
 
   default-language:    Haskell2010
   ghc-options:         -Wall
+                       -Wcompat
+                       -Wincomplete-uni-patterns
+                       -Wincomplete-record-updates
+                       -Wpartial-fields
+                       -Widentities
                        -Wredundant-constraints
+                       -Wmissing-export-lists
diff --git a/...consensus-byron/ouroboros-consensus-byrondual/src/Ouroboros/Consensus/ByronDual/Ledger.hs b/...consensus-byron/ouroboros-consensus-byrondual/src/Ouroboros/Consensus/ByronDual/Ledger.hs
@@ -6,7 +6,7 @@
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeFamilies          #-}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Ouroboros.Consensus.ByronDual.Ledger (
     -- * Shorthand

diff --git a/...s-consensus-byron/ouroboros-consensus-byrondual/src/Ouroboros/Consensus/ByronDual/Node.hs b/...s-consensus-byron/ouroboros-consensus-byrondual/src/Ouroboros/Consensus/ByronDual/Node.hs
@@ -5,7 +5,7 @@
 {-# LANGUAGE RecordWildCards   #-}
 {-# LANGUAGE TypeFamilies      #-}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Ouroboros.Consensus.ByronDual.Node (
     protocolInfoDualByron

diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Config.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Config.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TypeFamilies      #-}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Ouroboros.Consensus.Byron.Ledger.Config (
     BlockConfig(..)

diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Conversions.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Conversions.hs
@@ -46,7 +46,7 @@ fromByronBlockNo :: CC.ChainDifficulty -> BlockNo
 fromByronBlockNo = coerce
 
 fromByronBlockCount :: CC.BlockCount -> SecurityParam
-fromByronBlockCount (CC.BlockCount k) = SecurityParam (fromIntegral k)
+fromByronBlockCount (CC.BlockCount k) = SecurityParam k
 
 fromByronEpochSlots :: CC.EpochSlots -> EpochSize
 fromByronEpochSlots (CC.EpochSlots n) = EpochSize n
@@ -59,7 +59,7 @@ toByronSlotNo :: SlotNo -> CC.SlotNumber
 toByronSlotNo = coerce
 
 toByronBlockCount :: SecurityParam -> CC.BlockCount
-toByronBlockCount (SecurityParam k) = CC.BlockCount (fromIntegral k)
+toByronBlockCount (SecurityParam k) = CC.BlockCount k
 
 {-------------------------------------------------------------------------------
   Extract info from genesis

diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/HeaderValidation.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/HeaderValidation.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TypeFamilies #-}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Ouroboros.Consensus.Byron.Ledger.HeaderValidation () where
 

diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Ledger.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Ledger.hs
@@ -121,7 +121,10 @@ initByronLedgerState genesis mUtxo = ByronLedgerState {
     }
   where
     initState :: CC.ChainValidationState
-    Right initState = runExcept $ CC.initialChainValidationState genesis
+    initState = case runExcept $ CC.initialChainValidationState genesis of
+      Right st -> st
+      Left e   -> error $
+        "could not create initial ChainValidationState: " <> show e
 
     override :: Maybe CC.UTxO
              -> CC.ChainValidationState -> CC.ChainValidationState

diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Mempool.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Mempool.hs
@@ -11,7 +11,7 @@
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE TypeFamilies      #-}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 -- | Byron mempool integration
 module Ouroboros.Consensus.Byron.Ledger.Mempool (

diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/NetworkProtocolVersion.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/NetworkProtocolVersion.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TypeFamilies #-}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Ouroboros.Consensus.Byron.Ledger.NetworkProtocolVersion (
     ByronNetworkProtocolVersion(..)

diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/PBFT.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/PBFT.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE TupleSections         #-}
 {-# LANGUAGE TypeFamilies          #-}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 -- | Instances required to support PBFT
 module Ouroboros.Consensus.Byron.Ledger.PBFT (
     toPBftLedgerView

diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Serialisation.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Serialisation.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies      #-}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Ouroboros.Consensus.Byron.Ledger.Serialisation (
     -- * Serialisation

diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Node.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Node.hs
@@ -8,7 +8,7 @@
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE UndecidableInstances  #-}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Ouroboros.Consensus.Byron.Node (
     protocolInfoByron

diff --git a/ouroboros-consensus-byron/test/Test/Consensus/Byron/Ledger.hs b/ouroboros-consensus-byron/test/Test/Consensus/Byron/Ledger.hs
@@ -9,7 +9,7 @@
 {-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE StandaloneDeriving         #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans -Wno-incomplete-uni-patterns #-}
 module Test.Consensus.Byron.Ledger (tests) where
 
 import           Codec.CBOR.Decoding (Decoder)

diff --git a/ouroboros-consensus-byron/test/Test/ThreadNet/DualPBFT.hs b/ouroboros-consensus-byron/test/Test/ThreadNet/DualPBFT.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Test.ThreadNet.DualPBFT (
     tests

diff --git a/ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT.hs b/ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT.hs
@@ -510,7 +510,7 @@ expectedBlockRejection
     -- the node lead but rejected its own block. This is the only case we
     -- expect. (Rejecting its own block also prevents the node from propagating
     -- that block.)
-    ownBlock = fromIntegral i == mod (unSlotNo s) (fromIntegral nn)
+    ownBlock = i == mod (unSlotNo s) nn
 expectedBlockRejection _ _ _ _ = False
 
 -- | If we rekey in slot rekeySlot, it is in general possible that the leader
@@ -535,7 +535,7 @@ latestPossibleDlgMaturation
   :: SecurityParam -> NumCoreNodes -> SlotNo -> SlotNo
 latestPossibleDlgMaturation
   (SecurityParam k) (NumCoreNodes n) (SlotNo rekeySlot) =
-    SlotNo $ rekeySlot + fromIntegral n + 2 * k
+    SlotNo $ rekeySlot + n + 2 * k
 
 prop_simple_real_pbft_convergence :: ProduceEBBs
                                   -> SecurityParam
@@ -677,7 +677,7 @@ hasAllEBBs k (NumSlots t) produceEBBs (nid, c) =
       ProduceEBBs -> coerce [0 .. hi]
         where
           hi :: Word64
-          hi = if t < 1 then 0 else fromIntegral (t - 1) `div` denom
+          hi = if t < 1 then 0 else (t - 1) `div` denom
           denom = unEpochSlots $ kEpochSlots $ coerce k
 
     actual   = mapMaybe (nodeIsEBB . getHeader) $ Chain.toOldestFirst c

diff --git a/ouroboros-consensus-byron/tools/db-converter/Main.hs b/ouroboros-consensus-byron/tools/db-converter/Main.hs
@@ -11,11 +11,11 @@
 {-# LANGUAGE TypeApplications    #-}
 {-# LANGUAGE TypeOperators       #-}
 
-{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans -Wno-partial-fields #-}
 {-
   Database conversion tool.
 -}
-module Main where
+module Main (main) where
 
 import           Control.Exception (Exception, throwIO)
 import           Control.Monad.Except (liftIO, runExceptT)
@@ -71,34 +71,31 @@ instance ParseField UTCTime
 instance ParseFields UTCTime
 
 instance ParseRecord UTCTime where
-
   parseRecord = fmap getOnly parseRecord
 
 instance ParseField (Hash CB.Raw) where
-
   readField = Options.eitherReader (first Text.unpack . decodeAbstractHash . Text.pack)
 
 instance ParseFields (Hash CB.Raw)
 
 instance ParseRecord (Hash CB.Raw) where
-
   parseRecord = fmap getOnly parseRecord
 
 data Args w
   = Convert
-      { epochDir :: w ::: FilePath <?> "Path to the directory containing old epoch files"
-      , dbDir :: w ::: FilePath <?> "Path to the new database directory"
-      , epochSlots :: w ::: Word64 <?> "Slots per epoch"
-      }
+    { epochDir             :: w ::: FilePath      <?> "Path to the directory containing old epoch files"
+    , dbDir                :: w ::: FilePath      <?> "Path to the new database directory"
+    , epochSlots           :: w ::: Word64        <?> "Slots per epoch"
+    }
   | Validate
-      { dbDir :: w ::: FilePath <?> "Path to the new database directory"
-      , configFile :: w ::: FilePath <?> "Configuration file (e.g. mainnet-genesis.json)"
-      , systemStart :: w ::: Maybe UTCTime <?> "System start time"
-      , requiresNetworkMagic :: w ::: Bool <?> "Expecto patronum?"
-      , genesisHash :: w ::: Hash CB.Raw <?> "Expected genesis hash"
-      , verbose :: w ::: Bool <?> "Enable verbose logging"
-      , onlyImmDB :: w ::: Bool <?> "Validate only the immutable DB (e.g. do not do ledger validation)"
-      }
+    { dbDir                :: w ::: FilePath      <?> "Path to the new database directory"
+    , configFile           :: w ::: FilePath      <?> "Configuration file (e.g. mainnet-genesis.json)"
+    , systemStart          :: w ::: Maybe UTCTime <?> "System start time"
+    , requiresNetworkMagic :: w ::: Bool          <?> "Expecto patronum?"
+    , genesisHash          :: w ::: Hash CB.Raw   <?> "Expected genesis hash"
+    , verbose              :: w ::: Bool          <?> "Enable verbose logging"
+    , onlyImmDB            :: w ::: Bool          <?> "Validate only the immutable DB (e.g. do not do ledger validation)"
+    }
   deriving (Generic)
 
 instance ParseRecord (Args Wrapped)
@@ -147,17 +144,20 @@ convertEpochFile
   -> Path Abs File -- ^ Input
   -> Path Abs Dir -- ^ Ouput directory
   -> IO (Either CC.ParseError ())
-convertEpochFile es inFile outDir =
-  let inStream = CC.parseEpochFileWithBoundary es (toFilePath inFile)
-      dbDir = outDir </> [reldir|immutable|]
-      encode = CB.serializeEncoding' . Byron.encodeByronBlock . Byron.mkByronBlock es
-   in do
-        createDirIfMissing True dbDir
-        -- Old filename format is XXXXX.dat, new is XXXXX.epoch
-        outFileName <- parseRelFile (toFilePath (filename inFile))
-        outFile <- (dbDir </> outFileName) -<.> "epoch"
-        IO.withFile (toFilePath outFile) IO.WriteMode $ \h ->
-          runResourceT $ runExceptT $ S.mapM_ (liftIO . BS.hPut h) . S.map encode $ inStream
+convertEpochFile es inFile outDir = do
+    createDirIfMissing True dbDir
+    -- Old filename format is XXXXX.dat, new is XXXXX.epoch
+    outFileName <- parseRelFile (toFilePath (filename inFile))
+    outFile <- (dbDir </> outFileName) -<.> "epoch"
+    IO.withFile (toFilePath outFile) IO.WriteMode $ \h ->
+      runResourceT $ runExceptT $ S.mapM_ (liftIO . BS.hPut h) . S.map encode $ inStream
+  where
+    inStream = CC.parseEpochFileWithBoundary es (toFilePath inFile)
+    dbDir = outDir </> [reldir|immutable|]
+    encode =
+        CB.serializeEncoding'
+      . Byron.encodeByronBlock
+      . Byron.mkByronBlock es
 
 validateChainDb
   :: Path Abs Dir -- ^ DB directory

diff --git a/ouroboros-consensus-byronspec/ouroboros-consensus-byronspec.cabal b/ouroboros-consensus-byronspec/ouroboros-consensus-byronspec.cabal
@@ -53,4 +53,10 @@ library
 
   default-language:    Haskell2010
   ghc-options:         -Wall
+                       -Wcompat
+                       -Wincomplete-uni-patterns
+                       -Wincomplete-record-updates
+                       -Wpartial-fields
+                       -Widentities
                        -Wredundant-constraints
+                       -Wmissing-export-lists
diff --git a/ouroboros-consensus-byronspec/src/Ouroboros/Consensus/ByronSpec/Ledger/Ledger.hs b/ouroboros-consensus-byronspec/src/Ouroboros/Consensus/ByronSpec/Ledger/Ledger.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeFamilies    #-}
 
-{-# OPTIONS -fno-warn-orphans #-}
+{-# OPTIONS -Wno-orphans #-}
 
 module Ouroboros.Consensus.ByronSpec.Ledger.Ledger (
     ByronSpecLedgerError(..)

diff --git a/ouroboros-consensus-byronspec/src/Ouroboros/Consensus/ByronSpec/Ledger/Mempool.hs b/ouroboros-consensus-byronspec/src/Ouroboros/Consensus/ByronSpec/Ledger/Mempool.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE DerivingVia    #-}
 {-# LANGUAGE TypeFamilies   #-}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Ouroboros.Consensus.ByronSpec.Ledger.Mempool (
     -- * Type family instances

diff --git a/ouroboros-consensus-byronspec/src/Ouroboros/Consensus/ByronSpec/Ledger/Orphans.hs b/ouroboros-consensus-byronspec/src/Ouroboros/Consensus/ByronSpec/Ledger/Orphans.hs
@@ -5,7 +5,7 @@
 {-# LANGUAGE RecordWildCards    #-}
 {-# LANGUAGE StandaloneDeriving #-}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 -- | Missing instances for standard type classes in the Byron spec
 module Ouroboros.Consensus.ByronSpec.Ledger.Orphans () where

diff --git a/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal b/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal
@@ -36,6 +36,12 @@ library
 
   default-language:    Haskell2010
   ghc-options:         -Wall
+                       -Wcompat
+                       -Wincomplete-uni-patterns
+                       -Wincomplete-record-updates
+                       -Wpartial-fields
+                       -Widentities
                        -Wredundant-constraints
+                       -Wmissing-export-lists
   if flag(asserts)
     ghc-options:       -fno-ignore-asserts
diff --git a/ouroboros-consensus/ouroboros-consensus-mock/ouroboros-consensus-mock.cabal b/ouroboros-consensus/ouroboros-consensus-mock/ouroboros-consensus-mock.cabal
@@ -63,10 +63,15 @@ library
 
   default-language:    Haskell2010
   ghc-options:         -Wall
+                       -Wcompat
+                       -Wincomplete-uni-patterns
+                       -Wincomplete-record-updates
+                       -Wpartial-fields
+                       -Widentities
                        -Wredundant-constraints
+                       -Wmissing-export-lists
                        -Wno-unticked-promoted-constructors
 
-
 test-suite test
   type:                exitcode-stdio-1.0
   hs-source-dirs:      test
@@ -100,7 +105,13 @@ test-suite test
 
   default-language:    Haskell2010
   ghc-options:         -Wall
+                       -Wcompat
+                       -Wincomplete-uni-patterns
+                       -Wincomplete-record-updates
+                       -Wpartial-fields
+                       -Widentities
                        -Wredundant-constraints
+                       -Wmissing-export-lists
                        -fno-ignore-asserts
                        -threaded
                        -rtsopts