Merge #1602

1602: Fix thunks in RealPBFT r=mrBliss a=mrBliss

This fixes the thunks found by running the RealPBFT consensus tests with the `checktvarinvariant` flag enabled for the `io-sim-classes` package.

Co-authored-by: Thomas Winant <[email protected]>

cabal.project

@@ -116,25 +116,25 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger
-  tag: 98048d95823b72e409b07481761b8a59c892c56c
+  tag: e8475e33772e7408e83ff22e4406673ea73f93fd
   subdir: cardano-ledger
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger
-  tag: 98048d95823b72e409b07481761b8a59c892c56c
+  tag: e8475e33772e7408e83ff22e4406673ea73f93fd
   subdir: crypto
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger
-  tag: 98048d95823b72e409b07481761b8a59c892c56c
+  tag: e8475e33772e7408e83ff22e4406673ea73f93fd
   subdir: cardano-ledger/test
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger
-  tag: 98048d95823b72e409b07481761b8a59c892c56c
+  tag: e8475e33772e7408e83ff22e4406673ea73f93fd
   subdir: crypto/test
 
 -- version number matching the one specified in the stack resolver file

ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts          #-}
 {-# LANGUAGE FlexibleInstances         #-}
-{-# LANGUAGE LambdaCase                #-}
 {-# LANGUAGE MultiParamTypeClasses     #-}
 {-# LANGUAGE NamedFieldPuns            #-}
 {-# LANGUAGE PatternSynonyms           #-}
@@ -50,6 +49,8 @@ import qualified Data.Bimap as Bimap
 import           Data.Proxy (Proxy (..))
 import           Data.Set (Set)
 import qualified Data.Set as Set
+import           Data.Text (Text)
+import qualified Data.Text as Text
 import           Data.Typeable (Typeable)
 import           Data.Word (Word64)
 import           GHC.Generics (Generic)
@@ -314,7 +315,7 @@ instance PBftCrypto c => OuroborosTag (PBft c) where
                  signed
                  pbftSignature of
             Right () -> return ()
-            Left err -> throwError $ PBftInvalidSignature err
+            Left err -> throwError $ PBftInvalidSignature (Text.pack err)
 
           -- FIXME confirm that non-strict inequality is ok in general.
           -- It's here because EBBs have the same slot as the first block of their
@@ -461,11 +462,13 @@ genesisKeyHashes = CC.Genesis.unGenesisKeyHashes
   PBFT specific types
 -------------------------------------------------------------------------------}
 
+-- | NOTE: this type is stored in the state, so it must be in normal form to
+-- avoid space leaks.
 data PBftValidationErr c
-  = PBftInvalidSignature String
-  | PBftNotGenesisDelegate (PBftVerKeyHash c) (PBftLedgerView c)
+  = PBftInvalidSignature !Text
+  | PBftNotGenesisDelegate !(PBftVerKeyHash c) !(PBftLedgerView c)
   -- | We record how many slots this key signed
-  | PBftExceededSignThreshold (PBftVerKeyHash c) Word64
+  | PBftExceededSignThreshold !(PBftVerKeyHash c) !Word64
   | PBftInvalidSlot
   deriving (Generic, NoUnexpectedThunks)
 

stack.yaml

@@ -50,7 +50,7 @@ extra-deps:
   - gray-code-0.3.1
 
   - git: https://github.com/input-output-hk/cardano-ledger
-    commit: 98048d95823b72e409b07481761b8a59c892c56c
+    commit: e8475e33772e7408e83ff22e4406673ea73f93fd
     subdirs:
       - cardano-ledger
       - cardano-ledger/test