From 935d09811b863b9c1c99cf5d564f156190e1dce3 Mon Sep 17 00:00:00 2001 From: Thomas Winant Date: Tue, 3 Mar 2020 10:37:06 +0100 Subject: [PATCH 1/3] Make ouroboros-consensus warning free 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 commit fixes all warnings produced by these flags. --- .../ouroboros-consensus-byron.cabal | 34 +++++++++-- .../Consensus/Byron/Ledger/Conversions.hs | 4 +- .../Consensus/Byron/Ledger/Ledger.hs | 5 +- .../test/Test/Consensus/Byron/Ledger.hs | 2 +- .../test/Test/ThreadNet/RealPBFT.hs | 6 +- .../tools/db-converter/Main.hs | 56 +++++++++---------- .../ouroboros-consensus-byronspec.cabal | 6 ++ .../ouroboros-consensus-cardano.cabal | 6 ++ .../ouroboros-consensus-mock.cabal | 13 ++++- .../Consensus/Mock/Protocol/Praos.hs | 2 +- .../test/Test/ThreadNet/PBFT.hs | 2 +- .../test/Test/ThreadNet/Praos.hs | 3 +- .../ouroboros-consensus-test-infra.cabal | 12 ++++ .../src/Test/ThreadNet/General.hs | 2 +- .../src/Test/ThreadNet/Ref/PBFT.hs | 9 ++- .../src/Test/ThreadNet/Util.hs | 2 +- .../src/Test/ThreadNet/Util/NodeRestarts.hs | 4 +- .../src/Test/Util/FS/Sim/MockFS.hs | 2 +- .../src/Test/Util/TestBlock.hs | 1 + ouroboros-consensus/ouroboros-consensus.cabal | 19 +++++++ .../src/Ouroboros/Consensus/Protocol/BFT.hs | 4 +- .../Consensus/Protocol/MockChainSel.hs | 5 +- .../src/Ouroboros/Consensus/Storage/FS/API.hs | 2 +- .../src/Ouroboros/Consensus/Storage/FS/IO.hs | 4 +- .../Consensus/Storage/LedgerDB/InMemory.hs | 11 ++-- .../src/Ouroboros/Consensus/Util.hs | 8 ++- .../test-consensus/Test/Consensus/Mempool.hs | 2 +- .../MiniProtocol/ChainSync/Client.hs | 2 +- .../Test/Consensus/Protocol/PBFT.hs | 3 +- .../Ouroboros/Storage/ChainDB/Model/Test.hs | 2 +- .../Ouroboros/Storage/ImmutableDB/Primary.hs | 2 +- .../Ouroboros/Storage/LedgerDB/InMemory.hs | 3 +- .../Test/Ouroboros/Storage/LedgerDB/OnDisk.hs | 2 +- 33 files changed, 163 insertions(+), 77 deletions(-) diff --git a/ouroboros-consensus-byron/ouroboros-consensus-byron.cabal b/ouroboros-consensus-byron/ouroboros-consensus-byron.cabal index 39c12980151..6d87d3fc963 100644 --- 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/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Conversions.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Conversions.hs index 820a1796acf..f42cd55c032 100644 --- 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/Ledger.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Ledger.hs index a1ba603df9a..0e7cd334737 100644 --- 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/test/Test/Consensus/Byron/Ledger.hs b/ouroboros-consensus-byron/test/Test/Consensus/Byron/Ledger.hs index 046d296816f..5e631e6ff44 100644 --- 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/RealPBFT.hs b/ouroboros-consensus-byron/test/Test/ThreadNet/RealPBFT.hs index fbaa022f8b5..5ec93acd190 100644 --- 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 index b33981aace3..8422d03defa 100644 --- 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 index 2e7782df679..c14ae9eecb3 100644 --- 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-cardano/ouroboros-consensus-cardano.cabal b/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal index 312c4258457..70e86d7ce5e 100644 --- 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 index f8432d0861b..6a7fa820468 100644 --- 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 diff --git a/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Protocol/Praos.hs b/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Protocol/Praos.hs index 66c04edc1d1..a494fa4f985 100644 --- a/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Protocol/Praos.hs +++ b/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Protocol/Praos.hs @@ -413,7 +413,7 @@ infosEta l xs e = eta' = infosEta l xs e' from = epochFirst l e' n = div (2 * praosSlotsPerEpoch) 3 - to = SlotNo $ unSlotNo from + fromIntegral n + to = SlotNo $ unSlotNo from + n rhos = reverse [biRho b | b <- infosSlice from to xs] in fromHash $ hash @(PraosHash c) (eta', e, rhos) where diff --git a/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/PBFT.hs b/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/PBFT.hs index 3dc2a655c2f..a3a8fef0899 100644 --- a/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/PBFT.hs +++ b/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/PBFT.hs @@ -166,5 +166,5 @@ expectedBlockRejection (NumCoreNodes nn) BlockRejection -- 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 s (fromIntegral nn) + ownBlock = i == mod s nn expectedBlockRejection _ _ = False diff --git a/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/Praos.hs b/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/Praos.hs index a573d4f9422..38a2110cc61 100644 --- a/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/Praos.hs +++ b/ouroboros-consensus/ouroboros-consensus-mock/test/Test/ThreadNet/Praos.hs @@ -75,8 +75,7 @@ tests = testGroup "Praos" numCoreNodes = NumCoreNodes 3 numEpochs = 3 - numSlots = NumSlots $ fromIntegral $ - maxRollbacks k * praosSlotsPerEpoch * numEpochs + numSlots = NumSlots $ maxRollbacks k * praosSlotsPerEpoch * numEpochs params@PraosParams{praosSecurityParam = k, ..} = PraosParams { praosSecurityParam = SecurityParam 5 diff --git a/ouroboros-consensus/ouroboros-consensus-test-infra/ouroboros-consensus-test-infra.cabal b/ouroboros-consensus/ouroboros-consensus-test-infra/ouroboros-consensus-test-infra.cabal index f0a892307f0..a237d3acf6a 100644 --- a/ouroboros-consensus/ouroboros-consensus-test-infra/ouroboros-consensus-test-infra.cabal +++ b/ouroboros-consensus/ouroboros-consensus-test-infra/ouroboros-consensus-test-infra.cabal @@ -93,7 +93,13 @@ library default-language: Haskell2010 ghc-options: -Wall + -Wcompat + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wpartial-fields + -Widentities -Wredundant-constraints + -Wmissing-export-lists -fno-ignore-asserts test-suite test @@ -114,5 +120,11 @@ 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 diff --git a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/General.hs b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/General.hs index 7a32dcb61e8..cb14f20be04 100644 --- a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/General.hs +++ b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/General.hs @@ -108,7 +108,7 @@ truncateNodeTopology (NodeTopology m) (NumCoreNodes n') = truncateNodeRestarts :: NodeRestarts -> NumSlots -> NodeRestarts truncateNodeRestarts (NodeRestarts m) (NumSlots t) = - NodeRestarts $ Map.filterWithKey (\(SlotNo s) _ -> s < fromIntegral t) m + NodeRestarts $ Map.filterWithKey (\(SlotNo s) _ -> s < t) m instance Arbitrary TestConfig where arbitrary = do diff --git a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Ref/PBFT.hs b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Ref/PBFT.hs index 2e188accdee..38c18aa6537 100644 --- a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Ref/PBFT.hs +++ b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Ref/PBFT.hs @@ -2,7 +2,6 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} -- | A reference simulator of the PBFT protocol under \"ideal circumstances\" -- @@ -139,7 +138,7 @@ count a bs = length [ () | b <- toList bs, a == b ] prune :: Int -> Seq a -> (Seq a, Seq a) prune lim x = Seq.splitAt excess x where - excess = Seq.length x - fromIntegral lim + excess = Seq.length x - lim -- | Record the latest outcome in the state -- @@ -579,13 +578,13 @@ definitelyEnoughBlocks params = \case tick :: Outcome -> Word64 tick Nominal = 0 - tick _ = 1 + tick _ = 1 go :: Word64 -> [(Word64, Word64)] -> Bool go badCount exens | badCount > k = False | otherwise = case exens of - [] -> True + [] -> True (exit, enter) : exens' -> go (badCount - exit + enter) exens' {------------------------------------------------------------------------------- @@ -594,7 +593,7 @@ definitelyEnoughBlocks params = \case mkLeaderOf :: PBftParams -> SlotNo -> CoreNodeId mkLeaderOf params (SlotNo s) = - CoreNodeId $ fromIntegral $ s `mod` n + CoreNodeId $ s `mod` n where PBftParams{pbftNumNodes} = params NumCoreNodes n = pbftNumNodes diff --git a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Util.hs b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Util.hs index 7d44dd44d88..5bc851beae3 100644 --- a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Util.hs +++ b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Util.hs @@ -241,6 +241,6 @@ emptyLeaderSchedule (NumSlots t) = LeaderSchedule $ roundRobinLeaderSchedule :: NumCoreNodes -> NumSlots -> LeaderSchedule roundRobinLeaderSchedule (NumCoreNodes n) (NumSlots t) = LeaderSchedule $ Map.fromList $ - [ (SlotNo i, [CoreNodeId (fromIntegral i `mod` n)]) + [ (SlotNo i, [CoreNodeId (i `mod` n)]) | i <- [ 0 .. t - 1 ] ] diff --git a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Util/NodeRestarts.hs b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Util/NodeRestarts.hs index 202ecd9f2d7..04601978352 100644 --- a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Util/NodeRestarts.hs +++ b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/ThreadNet/Util/NodeRestarts.hs @@ -65,7 +65,7 @@ genNodeRestarts (NodeJoinPlan m) (NumSlots t) | t < 1 = pure noRestarts | otherwise = fmap (NodeRestarts . Map.filter (not . Map.null) . Map.fromList) $ do - ss <- sublistOf [0 .. SlotNo (fromIntegral t - 1)] + ss <- sublistOf [0 .. SlotNo (t - 1)] forM ss $ \s -> fmap ((,) s) $ let alreadyJoined = Map.keysSet $ Map.filter (< s) m @@ -81,7 +81,7 @@ genNodeRestarts (NodeJoinPlan m) (NumSlots t) else fmap (Map.fromList . map (flip (,) NodeRestart)) $ sublistOf $ Map.keys $ candidates where - isLeading (CoreNodeId i) s = fromIntegral i /= unSlotNo s `mod` n + isLeading (CoreNodeId i) s = i /= unSlotNo s `mod` n where n = fromIntegral $ Map.size m diff --git a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/FS/Sim/MockFS.hs b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/FS/Sim/MockFS.hs index 0c5e9eb7704..40a4ba7acf5 100644 --- a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/FS/Sim/MockFS.hs +++ b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/FS/Sim/MockFS.hs @@ -628,7 +628,7 @@ hPutSome h toWrite = snip :: Int -> Int -> ByteString -> (ByteString, ByteString) snip n m bs = (a, c) where - (a, bc) = BS.splitAt (fromIntegral n) bs + (a, bc) = BS.splitAt n bs c = BS.drop m bc -- | Truncate a file diff --git a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/TestBlock.hs b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/TestBlock.hs index c0028664fd0..eec9a427a25 100644 --- a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/TestBlock.hs +++ b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/TestBlock.hs @@ -14,6 +14,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | Minimal instantiation of the consensus layer to be able to run the ChainDB module Test.Util.TestBlock ( -- * Blocks diff --git a/ouroboros-consensus/ouroboros-consensus.cabal b/ouroboros-consensus/ouroboros-consensus.cabal index 2508defd592..4e3fb7267bc 100644 --- a/ouroboros-consensus/ouroboros-consensus.cabal +++ b/ouroboros-consensus/ouroboros-consensus.cabal @@ -236,7 +236,14 @@ library , unix-bytestring 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 cpp-options: -DENABLE_ASSERTIONS @@ -333,7 +340,13 @@ test-suite test-consensus 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 @@ -428,5 +441,11 @@ test-suite test-storage default-language: Haskell2010 ghc-options: -Wall + -Wcompat + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wpartial-fields + -Widentities -Wredundant-constraints + -Wmissing-export-lists -fno-ignore-asserts diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/BFT.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/BFT.hs index 6daabd9c8cb..cdc8be2e6fc 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/BFT.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/BFT.hs @@ -140,7 +140,7 @@ instance BftCrypto c => ConsensusProtocol (Bft c) where -- Relays are never leaders Nothing CoreId (CoreNodeId i) -> - if n `mod` numCoreNodes == fromIntegral i + if n `mod` numCoreNodes == i then Just () else Nothing where @@ -161,7 +161,7 @@ instance BftCrypto c => ConsensusProtocol (Bft c) where Left err -> throwError $ BftInvalidSignature err where BftParams{..} = bftParams - expectedLeader = CoreId . CoreNodeId $ fromIntegral (n `mod` numCoreNodes) + expectedLeader = CoreId $ CoreNodeId (n `mod` numCoreNodes) NumCoreNodes numCoreNodes = bftNumNodes rewindConsensusState _ _ _ = Just () diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/MockChainSel.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/MockChainSel.hs index 388432eac5d..e6d9398103a 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/MockChainSel.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Protocol/MockChainSel.hs @@ -2,7 +2,10 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -module Ouroboros.Consensus.Protocol.MockChainSel where +module Ouroboros.Consensus.Protocol.MockChainSel + ( selectChain + , selectUnvalidatedChain + ) where import Data.Function (on) import Data.List (sortBy) diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/FS/API.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/FS/API.hs index 2e1a3708e67..5c39d94a12e 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/FS/API.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/FS/API.hs @@ -238,7 +238,7 @@ hPutAllStrict hasFS h = go 0 go !written bs = do n <- hPutSome hasFS h bs let bs' = BS.drop (fromIntegral n) bs - written' = written + fromIntegral n + written' = written + n if BS.null bs' then return written' else go written' bs' diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/FS/IO.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/FS/IO.hs index 938127ae063..d38b4d3b74b 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/FS/IO.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/FS/IO.hs @@ -43,9 +43,9 @@ ioHasFS mount = HasFS { , hSeek = \(Handle h fp) mode o -> rethrowFsError fp $ F.seek h mode o , hGetSome = \(Handle h fp) n -> rethrowFsError fp $ - F.read h (fromIntegral n) + F.read h n , hGetSomeAt = \(Handle h fp) n o -> rethrowFsError fp $ - F.pread h (fromIntegral n) (unAbsOffset o) + F.pread h n (unAbsOffset o) , hTruncate = \(Handle h fp) sz -> rethrowFsError fp $ F.truncate h sz , hGetSize = \(Handle h fp) -> rethrowFsError fp $ diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/LedgerDB/InMemory.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/LedgerDB/InMemory.hs index be96c57ae02..880932ffe09 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/LedgerDB/InMemory.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/LedgerDB/InMemory.hs @@ -862,13 +862,14 @@ _demo = db0 : go 1 8 db0 let blockInfos = [ (Apply, Val (DR ('b', n-1)) (DB ('b', n-1))) , (Apply, Val (DR ('b', n-0)) (DB ('b', n-0))) ] - Identity (RollbackSuccessful (ValidBlocks db')) = - ledgerDbSwitch demoConf 1 blockInfos db - in [db'] + in case runIdentity $ ledgerDbSwitch demoConf 1 blockInfos db of + RollbackSuccessful (ValidBlocks db') -> [db'] + _ -> error "unexpected outcome" else let blockInfo = (Apply, Val (DR ('a', n)) (DB ('a', n))) - Identity (Right db') = ledgerDbPush demoConf blockInfo db - in db' : go (n + 1) m db' + in case runIdentity $ ledgerDbPush demoConf blockInfo db of + Right db' -> db' : go (n + 1) m db' + _ -> error "unexpected outcome" {------------------------------------------------------------------------------- Auxiliary diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Util.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Util.hs index 6196831d2cc..045ed8a648b 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Util.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Util.hs @@ -134,9 +134,11 @@ pickOne (x:xs) = ([], x, xs) -- | Mark the last element of the list as 'Right' markLast :: [a] -> [Either a a] -markLast [] = [] -markLast xs = let (y:ys) = reverse xs - in reverse $ Right y : map Left ys +markLast = go + where + go [] = [] + go [x] = [Right x] + go (x:xs) = Left x : go xs lastMaybe :: [a] -> Maybe a lastMaybe [] = Nothing diff --git a/ouroboros-consensus/test-consensus/Test/Consensus/Mempool.hs b/ouroboros-consensus/test-consensus/Test/Consensus/Mempool.hs index c189e523826..c0094dd2763 100644 --- a/ouroboros-consensus/test-consensus/Test/Consensus/Mempool.hs +++ b/ouroboros-consensus/test-consensus/Test/Consensus/Mempool.hs @@ -457,7 +457,7 @@ genValidTx ledgerState@(SimpleLedgerState MockState { mockUtxo = utxo }) = do ins = Set.fromList $ map fst assets -- At most spent half of someone's fortune - amount <- fromIntegral <$> choose (1, fortune `div` 2) + amount <- choose (1, fortune `div` 2) let outRecipient = (recipient, amount) outs | amount == fortune diff --git a/ouroboros-consensus/test-consensus/Test/Consensus/MiniProtocol/ChainSync/Client.hs b/ouroboros-consensus/test-consensus/Test/Consensus/MiniProtocol/ChainSync/Client.hs index 86f78192a4c..479a550a313 100644 --- a/ouroboros-consensus/test-consensus/Test/Consensus/MiniProtocol/ChainSync/Client.hs +++ b/ouroboros-consensus/test-consensus/Test/Consensus/MiniProtocol/ChainSync/Client.hs @@ -420,7 +420,7 @@ runChainSync securityParam maxClockSkew (ClientUpdates clientUpdates) -- | Take the last slot at which a client or server update is planned, or -- the slot at which syncing starts, and add one to it numSlots :: NumSlots - numSlots = NumSlots $ fromIntegral $ unSlotNo $ succ $ maximum + numSlots = NumSlots $ unSlotNo $ succ $ maximum [ lastSlot clientUpdates , lastSlot serverUpdates , startSyncingAt diff --git a/ouroboros-consensus/test-consensus/Test/Consensus/Protocol/PBFT.hs b/ouroboros-consensus/test-consensus/Test/Consensus/Protocol/PBFT.hs index ece51a0b5be..12bbe260f71 100644 --- a/ouroboros-consensus/test-consensus/Test/Consensus/Protocol/PBFT.hs +++ b/ouroboros-consensus/test-consensus/Test/Consensus/Protocol/PBFT.hs @@ -520,8 +520,7 @@ prop_appendOldStatePreservesInvariant TestPBftState{..} = -- add a sufficient number signed blocks (and any number of EBBs). prop_appendOldStateRestoresPreWindow :: TestPBftState -> Property prop_appendOldStateRestoresPreWindow TestPBftState{..} = - let missing = fromIntegral - $ maxRollbacks testPBftStateK + let missing = maxRollbacks testPBftStateK + S.getWindowSize testPBftStateN - S.countSignatures testOldPBftState inps = pre' <> post' diff --git a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/Model/Test.hs b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/Model/Test.hs index 959840ce6ec..399f62cc8cd 100644 --- a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/Model/Test.hs +++ b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/Model/Test.hs @@ -5,7 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-orphans -Wno-incomplete-uni-patterns #-} module Test.Ouroboros.Storage.ChainDB.Model.Test ( tests ) where diff --git a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ImmutableDB/Primary.hs b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ImmutableDB/Primary.hs index 0773c57e8c5..9761a362c4d 100644 --- a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ImmutableDB/Primary.hs +++ b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ImmutableDB/Primary.hs @@ -1,5 +1,5 @@ {-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-orphans -Wno-incomplete-uni-patterns #-} module Test.Ouroboros.Storage.ImmutableDB.Primary (tests) where import Data.Binary (get, put) diff --git a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/InMemory.hs b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/InMemory.hs index bf971c7f97e..4e27b1e7ae0 100644 --- a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/InMemory.hs +++ b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/InMemory.hs @@ -13,6 +13,7 @@ module Test.Ouroboros.Storage.LedgerDB.InMemory ( tests ) where +import Data.Maybe (fromJust) import Data.Word import Test.QuickCheck import Test.Tasty @@ -327,7 +328,7 @@ mkRollbackSetup ssChainSetup ssNumRollback ssNumNew ssPrefixLen = take (fromIntegral (csNumBlocks - ssNumRollback)) csChain , ssNewBlocks ] - Just ssSwitched = ledgerDbSwitch' callbacks ssNumRollback ssNewBlocks csPushed + ssSwitched = fromJust $ ledgerDbSwitch' callbacks ssNumRollback ssNewBlocks csPushed instance Arbitrary ChainSetup where arbitrary = do diff --git a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/OnDisk.hs b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/OnDisk.hs index 13a39c3e1d4..29510203e61 100644 --- a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/OnDisk.hs +++ b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/OnDisk.hs @@ -795,7 +795,7 @@ generator lgrDbParams (Model mock hs) = Just $ QC.oneof $ concat [ Switch numRollback <$> genBlocks numNewBlocks (mockCurrent afterRollback) , fmap At $ return Snap , fmap At $ return Restore - , fmap At $ (Drop . fromIntegral) <$> QC.choose (0, mockChainLength mock) + , fmap At $ Drop <$> QC.choose (0, mockChainLength mock) ] possibleCorruptions :: [(Corruption, Reference DiskSnapshot Symbolic)] From fab205477bf97e832ed6d18236ae07d72ca0203e Mon Sep 17 00:00:00 2001 From: Thomas Winant Date: Mon, 9 Mar 2020 10:13:28 +0100 Subject: [PATCH 2/3] Remove redundant module-local warning flags No need to repeat warning flags in a module that are enabled for the whole package already. --- .../src/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs | 1 - .../src/Ouroboros/Consensus/MiniProtocol/ChainSync/Server.hs | 1 - ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs | 2 +- ouroboros-consensus/src/Ouroboros/Consensus/NodeNetwork.hs | 3 +-- .../src/Ouroboros/Consensus/Storage/ChainDB/Impl.hs | 2 -- .../src/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs | 1 - .../src/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs | 1 - .../src/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs | 1 - .../src/Ouroboros/Consensus/Storage/ChainDB/Impl/ImmDB.hs | 1 - .../src/Ouroboros/Consensus/Storage/ChainDB/Impl/Iterator.hs | 1 - .../Ouroboros/Consensus/Storage/ChainDB/Impl/LedgerCursor.hs | 1 - .../src/Ouroboros/Consensus/Storage/ChainDB/Impl/LgrDB.hs | 1 - .../src/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs | 1 - .../src/Ouroboros/Consensus/Storage/ChainDB/Impl/Reader.hs | 1 - .../src/Ouroboros/Consensus/Storage/ChainDB/Impl/Reopen.hs | 2 -- .../src/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs | 1 - .../src/Ouroboros/Consensus/Storage/ChainDB/Impl/VolDB.hs | 1 - .../src/Ouroboros/Consensus/Storage/ImmutableDB/Impl.hs | 1 - .../src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Index.hs | 1 - .../Consensus/Storage/ImmutableDB/Impl/Index/Cache.hs | 1 - .../Consensus/Storage/ImmutableDB/Impl/Index/Primary.hs | 1 - .../Ouroboros/Consensus/Storage/ImmutableDB/Impl/Iterator.hs | 1 - .../Test/Ouroboros/Storage/ChainDB/StateMachine.hs | 2 +- .../test-storage/Test/Ouroboros/Storage/ImmutableDB/Model.hs | 1 - 24 files changed, 3 insertions(+), 27 deletions(-) diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs b/ouroboros-consensus/src/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs index cbc8f7dc60f..c4906911047 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs @@ -15,7 +15,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} module Ouroboros.Consensus.MiniProtocol.ChainSync.Client ( Consensus , chainSyncClient diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/MiniProtocol/ChainSync/Server.hs b/ouroboros-consensus/src/Ouroboros/Consensus/MiniProtocol/ChainSync/Server.hs index eea547fc6d7..f435a7a859d 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/MiniProtocol/ChainSync/Server.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/MiniProtocol/ChainSync/Server.hs @@ -4,7 +4,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} module Ouroboros.Consensus.MiniProtocol.ChainSync.Server ( chainSyncHeadersServer , chainSyncBlocksServer diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs b/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs index 508dff79d93..f5322a9bdd9 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs @@ -10,7 +10,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -Wredundant-constraints -Werror=missing-fields #-} +{-# OPTIONS_GHC -Werror=missing-fields #-} module Ouroboros.Consensus.NodeKernel ( -- * Node kernel diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/NodeNetwork.hs b/ouroboros-consensus/src/Ouroboros/Consensus/NodeNetwork.hs index 417713e3f37..68fc26deefa 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/NodeNetwork.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/NodeNetwork.hs @@ -10,8 +10,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -Wredundant-constraints -Werror=missing-fields - -Wno-unticked-promoted-constructors #-} +{-# OPTIONS_GHC -Werror=missing-fields -Wno-unticked-promoted-constructors #-} module Ouroboros.Consensus.NodeNetwork ( ProtocolHandlers (..) diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl.hs index 855bba03201..775e0591d7f 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl.hs @@ -1,8 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} - module Ouroboros.Consensus.Storage.ChainDB.Impl ( -- * Initialization ChainDbArgs(..) diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs index e36f57d9143..4df4add905a 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs @@ -2,7 +2,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} module Ouroboros.Consensus.Storage.ChainDB.Impl.Args ( ChainDbArgs (..) , ChainDbSpecificArgs (..) diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs index f2238179ef1..976c981bb92 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs @@ -4,7 +4,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} -- | Background tasks: -- -- * Copying blocks from the VolatileDB to the ImmutableDB diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs index ed9d9cce3e0..1da0b6feaab 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs @@ -9,7 +9,6 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} -- | Operations involving chain selection: the initial chain selection and -- adding a block. module Ouroboros.Consensus.Storage.ChainDB.Impl.ChainSel diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/ImmDB.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/ImmDB.hs index bcf735e7bed..32d2050425a 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/ImmDB.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/ImmDB.hs @@ -7,7 +7,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} -- | Thin wrapper around the ImmutableDB module Ouroboros.Consensus.Storage.ChainDB.Impl.ImmDB ( ImmDB -- Opaque diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Iterator.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Iterator.hs index b2d81c07237..65123c973b3 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Iterator.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Iterator.hs @@ -7,7 +7,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} -- | Iterators module Ouroboros.Consensus.Storage.ChainDB.Impl.Iterator ( stream diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/LedgerCursor.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/LedgerCursor.hs index 39f4a31a598..4aa209eb688 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/LedgerCursor.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/LedgerCursor.hs @@ -1,7 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} module Ouroboros.Consensus.Storage.ChainDB.Impl.LedgerCursor ( newLedgerCursor ) where diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/LgrDB.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/LgrDB.hs index b1a337d3fdc..6bcc9e486fd 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/LgrDB.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/LgrDB.hs @@ -14,7 +14,6 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} -- | Thin wrapper around the LedgerDB module Ouroboros.Consensus.Storage.ChainDB.Impl.LgrDB ( LgrDB -- opaque diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs index 1edcb2d020c..383054e06dc 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs @@ -2,7 +2,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} -- | Queries module Ouroboros.Consensus.Storage.ChainDB.Impl.Query ( -- * Queries diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Reader.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Reader.hs index 0423fd8a050..fe13b876bda 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Reader.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Reader.hs @@ -5,7 +5,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} -- | Readers module Ouroboros.Consensus.Storage.ChainDB.Impl.Reader ( newReader diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Reopen.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Reopen.hs index 1c2a0f4a4a4..1afcc107d67 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Reopen.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Reopen.hs @@ -4,8 +4,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} - -- | Closing and reopening module Ouroboros.Consensus.Storage.ChainDB.Impl.Reopen ( isOpen diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs index d3034a4be58..1e0eda54403 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs @@ -13,7 +13,6 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} -- | Types used throughout the implementation: handle, state, environment, -- types, trace types, etc. module Ouroboros.Consensus.Storage.ChainDB.Impl.Types ( diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/VolDB.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/VolDB.hs index 172986aaa5c..63112af6254 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/VolDB.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ChainDB/Impl/VolDB.hs @@ -13,7 +13,6 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} -- | Thin wrapper around the VolatileDB module Ouroboros.Consensus.Storage.ChainDB.Impl.VolDB ( VolDB -- Opaque diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl.hs index f7b3caa8c4a..a03b220c67a 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl.hs @@ -7,7 +7,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} -- | Immutable on-disk database of binary blobs -- -- = Internal format diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Index.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Index.hs index adb59aca0d8..c808c292c3f 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Index.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Index.hs @@ -3,7 +3,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} module Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index ( -- * Index Index (..) diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Index/Cache.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Index/Cache.hs index d8b496f1cae..0e818ffe296 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Index/Cache.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Index/Cache.hs @@ -11,7 +11,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} module Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index.Cache ( -- * Environment CacheEnv diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Index/Primary.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Index/Primary.hs index 9f76e9499f9..2319ef7f44d 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Index/Primary.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Index/Primary.hs @@ -6,7 +6,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} -- | Primary Index -- -- Intended for qualified import diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Iterator.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Iterator.hs index ef3d5f592a4..ca135b657f5 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Iterator.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Storage/ImmutableDB/Impl/Iterator.hs @@ -10,7 +10,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} module Ouroboros.Consensus.Storage.ImmutableDB.Impl.Iterator ( streamImpl , getSlotInfo diff --git a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/StateMachine.hs b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/StateMachine.hs index f43f435f69e..75a34553633 100644 --- a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/StateMachine.hs +++ b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/StateMachine.hs @@ -17,7 +17,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans -Wredundant-constraints #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Test.Ouroboros.Storage.ChainDB.StateMachine ( tests ) where import Prelude hiding (elem) diff --git a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ImmutableDB/Model.hs b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ImmutableDB/Model.hs index f7719ee3b2e..01234f1e8ff 100644 --- a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ImmutableDB/Model.hs +++ b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ImmutableDB/Model.hs @@ -8,7 +8,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{-# OPTIONS_GHC -Wredundant-constraints #-} -- | Model for the 'ImmutableDB' based on a chain. -- From 4ad69d4c6ef585f2fdee8633fff51e5fa74388fe Mon Sep 17 00:00:00 2001 From: Thomas Winant Date: Mon, 9 Mar 2020 10:17:38 +0100 Subject: [PATCH 3/3] Use -Wno-orphans consistently instead of -fno-warn-orphans --- .../src/Ouroboros/Consensus/ByronDual/Ledger.hs | 2 +- .../src/Ouroboros/Consensus/ByronDual/Node.hs | 2 +- .../src/Ouroboros/Consensus/Byron/Ledger/Config.hs | 2 +- .../src/Ouroboros/Consensus/Byron/Ledger/HeaderValidation.hs | 2 +- .../src/Ouroboros/Consensus/Byron/Ledger/Mempool.hs | 2 +- .../Ouroboros/Consensus/Byron/Ledger/NetworkProtocolVersion.hs | 2 +- .../src/Ouroboros/Consensus/Byron/Ledger/PBFT.hs | 2 +- .../src/Ouroboros/Consensus/Byron/Ledger/Serialisation.hs | 2 +- ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Node.hs | 2 +- ouroboros-consensus-byron/test/Test/ThreadNet/DualPBFT.hs | 2 +- .../src/Ouroboros/Consensus/ByronSpec/Ledger/Ledger.hs | 2 +- .../src/Ouroboros/Consensus/ByronSpec/Ledger/Mempool.hs | 2 +- .../src/Ouroboros/Consensus/ByronSpec/Ledger/Orphans.hs | 2 +- .../src/Ouroboros/Consensus/Mock/Ledger/Block/BFT.hs | 2 +- .../src/Ouroboros/Consensus/Mock/Ledger/Block/PBFT.hs | 2 +- .../src/Ouroboros/Consensus/Mock/Ledger/Block/Praos.hs | 2 +- .../src/Ouroboros/Consensus/Mock/Ledger/Block/PraosRule.hs | 2 +- .../src/Ouroboros/Consensus/Mock/Node.hs | 2 +- .../src/Test/Util/Orphans/Arbitrary.hs | 2 +- .../src/Test/Util/Orphans/IOLike.hs | 2 +- ouroboros-consensus/src/Ouroboros/Consensus/Util/Orphans.hs | 2 +- .../test-consensus/Test/Consensus/BlockchainTime/SlotLengths.hs | 2 +- .../test-storage/Test/Ouroboros/Storage/FS/StateMachine.hs | 2 +- .../test-storage/Test/Ouroboros/Storage/LedgerDB/InMemory.hs | 2 +- .../test-storage/Test/Ouroboros/Storage/LedgerDB/OnDisk.hs | 2 +- 25 files changed, 25 insertions(+), 25 deletions(-) diff --git a/ouroboros-consensus-byron/ouroboros-consensus-byrondual/src/Ouroboros/Consensus/ByronDual/Ledger.hs b/ouroboros-consensus-byron/ouroboros-consensus-byrondual/src/Ouroboros/Consensus/ByronDual/Ledger.hs index 75d0c85e393..92b18934f36 100644 --- a/ouroboros-consensus-byron/ouroboros-consensus-byrondual/src/Ouroboros/Consensus/ByronDual/Ledger.hs +++ b/ouroboros-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/ouroboros-consensus-byron/ouroboros-consensus-byrondual/src/Ouroboros/Consensus/ByronDual/Node.hs b/ouroboros-consensus-byron/ouroboros-consensus-byrondual/src/Ouroboros/Consensus/ByronDual/Node.hs index 07887884500..6cd5209ec80 100644 --- a/ouroboros-consensus-byron/ouroboros-consensus-byrondual/src/Ouroboros/Consensus/ByronDual/Node.hs +++ b/ouroboros-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 index 97708975b64..86f76e755e0 100644 --- 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/HeaderValidation.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/HeaderValidation.hs index 4108d80d384..a30097cce94 100644 --- 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/Mempool.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Mempool.hs index 584241dc6cb..38d35065b38 100644 --- 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 index 73008f7eb15..097691eb237 100644 --- 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 index 538edd91d9b..9c0101a628e 100644 --- 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 index aa46e25893e..39c5ec5b79c 100644 --- 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 index 006c000826c..bb2e0c64163 100644 --- 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/ThreadNet/DualPBFT.hs b/ouroboros-consensus-byron/test/Test/ThreadNet/DualPBFT.hs index 59d39ed79b7..4fa4041e0cb 100644 --- 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-byronspec/src/Ouroboros/Consensus/ByronSpec/Ledger/Ledger.hs b/ouroboros-consensus-byronspec/src/Ouroboros/Consensus/ByronSpec/Ledger/Ledger.hs index 86b1f5dca37..c1775aab5fb 100644 --- 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 index 6060daf8654..7803f86e8c8 100644 --- 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 index 32fa3398ab8..77d5abb03fb 100644 --- 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/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/BFT.hs b/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/BFT.hs index 33654ed58fb..cda594ed46f 100644 --- a/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/BFT.hs +++ b/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/BFT.hs @@ -9,7 +9,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Ouroboros.Consensus.Mock.Ledger.Block.BFT ( SimpleBftBlock diff --git a/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/PBFT.hs b/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/PBFT.hs index 6d673b5c778..25e6873b835 100644 --- a/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/PBFT.hs +++ b/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/PBFT.hs @@ -10,7 +10,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Ouroboros.Consensus.Mock.Ledger.Block.PBFT ( SimplePBftBlock diff --git a/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/Praos.hs b/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/Praos.hs index 41f7dbacbf1..5fa7bb93a63 100644 --- a/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/Praos.hs +++ b/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/Praos.hs @@ -9,7 +9,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Ouroboros.Consensus.Mock.Ledger.Block.Praos ( SimplePraosBlock diff --git a/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/PraosRule.hs b/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/PraosRule.hs index 67a2b372a16..dce0e4a09e9 100644 --- a/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/PraosRule.hs +++ b/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Ledger/Block/PraosRule.hs @@ -8,7 +8,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- | Test the Praos chain selection rule (with explicit leader schedule) module Ouroboros.Consensus.Mock.Ledger.Block.PraosRule ( diff --git a/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Node.hs b/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Node.hs index b364e37e49e..0e380a9488c 100644 --- a/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Node.hs +++ b/ouroboros-consensus/ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Node.hs @@ -4,7 +4,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Ouroboros.Consensus.Mock.Node () where import Codec.Serialise (Serialise, decode, encode) diff --git a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/Orphans/Arbitrary.hs b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/Orphans/Arbitrary.hs index 339668fe9da..720727900c6 100644 --- a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/Orphans/Arbitrary.hs +++ b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/Orphans/Arbitrary.hs @@ -2,7 +2,7 @@ {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Test.Util.Orphans.Arbitrary ( genLimitedEpochSize diff --git a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/Orphans/IOLike.hs b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/Orphans/IOLike.hs index a5f8de495cf..36ae690f609 100644 --- a/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/Orphans/IOLike.hs +++ b/ouroboros-consensus/ouroboros-consensus-test-infra/src/Test/Util/Orphans/IOLike.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Test.Util.Orphans.IOLike () where import Control.Monad.Class.MonadSTM (lengthTBQueueDefault) diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Util/Orphans.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Util/Orphans.hs index be3cc68c4c9..d64c7a48ebc 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Util/Orphans.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Util/Orphans.hs @@ -5,7 +5,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Ouroboros.Consensus.Util.Orphans () where import Codec.CBOR.Decoding (Decoder) diff --git a/ouroboros-consensus/test-consensus/Test/Consensus/BlockchainTime/SlotLengths.hs b/ouroboros-consensus/test-consensus/Test/Consensus/BlockchainTime/SlotLengths.hs index a7178886331..46720aa63a8 100644 --- a/ouroboros-consensus/test-consensus/Test/Consensus/BlockchainTime/SlotLengths.hs +++ b/ouroboros-consensus/test-consensus/Test/Consensus/BlockchainTime/SlotLengths.hs @@ -1,5 +1,5 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Test.Consensus.BlockchainTime.SlotLengths (tests) where import Data.Maybe diff --git a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/FS/StateMachine.hs b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/FS/StateMachine.hs index 250b266453e..1ba85005be9 100644 --- a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/FS/StateMachine.hs +++ b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/FS/StateMachine.hs @@ -15,7 +15,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Test.Ouroboros.Storage.FS.StateMachine ( tests diff --git a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/InMemory.hs b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/InMemory.hs index 4e27b1e7ae0..01353bcce43 100644 --- a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/InMemory.hs +++ b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/InMemory.hs @@ -7,7 +7,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Test.Ouroboros.Storage.LedgerDB.InMemory ( tests diff --git a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/OnDisk.hs b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/OnDisk.hs index 29510203e61..ccb2f44c13a 100644 --- a/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/OnDisk.hs +++ b/ouroboros-consensus/test-storage/Test/Ouroboros/Storage/LedgerDB/OnDisk.hs @@ -21,7 +21,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Test.Ouroboros.Storage.LedgerDB.OnDisk ( tests