WIP: Cleanup and documentation

.gitignore

@@ -42,6 +42,7 @@ launch-*
 stack.yaml.local.lock
 stack.yaml.local
 .envrc
+.dir-locals.el
 
 # latex files
 doc/*.fdb_latexmk

ouroboros-consensus-mock/src/Ouroboros/Consensus/Mock/Protocol/Praos.hs

@@ -446,6 +446,8 @@ instance PraosCrypto c => ConsensusProtocol (Praos c) where
 
   protocolSecurityParam = praosSecurityParam . praosParams
   protocolGenesisWindowLength p =
+    -- See the haddock of GenesisWindowLength. As this is a mock protocol, it is
+    -- set to the "default" value, 3k/f.
       GenesisWindowLength
     $ floor
     $ 3 * (fromIntegral $ maxRollbacks $ protocolSecurityParam p)

ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Protocol.hs

@@ -73,6 +73,7 @@ import qualified Cardano.Protocol.TPraos.OCert as Absolute (KESPeriod (..))
 import qualified Shelley.Spec.Ledger.API as SL
 
 import           Ouroboros.Consensus.Config.GenesisWindowLength
+import qualified Ouroboros.Consensus.Config.GenesisWindowLength as Consensus.Config
 import           Ouroboros.Consensus.Shelley.Protocol.HotKey (HotKey)
 import qualified Ouroboros.Consensus.Shelley.Protocol.HotKey as HotKey
 import           Ouroboros.Consensus.Shelley.Protocol.Util
@@ -170,37 +171,39 @@ data TPraos c
 -- | TPraos parameters that are node independent
 data TPraosParams = TPraosParams {
       -- | See 'Globals.slotsPerKESPeriod'.
-      tpraosSlotsPerKESPeriod :: !Word64
+      tpraosSlotsPerKESPeriod   :: !Word64
       -- | Active slots coefficient. This parameter represents the proportion
       -- of slots in which blocks should be issued. This can be interpreted as
       -- the probability that a party holding all the stake will be elected as
       -- leader for a given slot.
-    , tpraosLeaderF           :: !SL.ActiveSlotCoeff
+    , tpraosLeaderF             :: !SL.ActiveSlotCoeff
       -- | See 'Globals.securityParameter'.
-    , tpraosSecurityParam     :: !SecurityParam
+    , tpraosSecurityParam       :: !SecurityParam
+      -- | See 'Ouroboros.Consensus.Config.GenesisWindowLength'.
+    , tpraosGenesisWindowLength :: !GenesisWindowLength
       -- | Maximum number of KES iterations, see 'Globals.maxKESEvo'.
-    , tpraosMaxKESEvo         :: !Word64
+    , tpraosMaxKESEvo           :: !Word64
       -- | Quorum for update system votes and MIR certificates, see
       -- 'Globals.quorum'.
-    , tpraosQuorum            :: !Word64
+    , tpraosQuorum              :: !Word64
       -- | All blocks invalid after this protocol version, see
       -- 'Globals.maxMajorPV'.
-    , tpraosMaxMajorPV        :: !MaxMajorProtVer
+    , tpraosMaxMajorPV          :: !MaxMajorProtVer
       -- | Maximum number of lovelace in the system, see
       -- 'Globals.maxLovelaceSupply'.
-    , tpraosMaxLovelaceSupply :: !Word64
+    , tpraosMaxLovelaceSupply   :: !Word64
       -- | Testnet or mainnet?
-    , tpraosNetworkId         :: !SL.Network
+    , tpraosNetworkId           :: !SL.Network
       -- | Initial nonce used for the TPraos protocol state. Typically this is
       -- derived from the hash of the Shelley genesis config JSON file, but
       -- different values may be used for testing purposes.
       --
       -- NOTE: this is only used when translating the Byron 'ChainDepState' to
       -- the Shelley 'ChainDepState', at which point we'll need access to the
       -- initial nonce at runtime. TODO #2326.
-    , tpraosInitialNonce      :: !SL.Nonce
+    , tpraosInitialNonce        :: !SL.Nonce
       -- | The system start, as projected from the chain's genesis block.
-    , tpraosSystemStart       :: !SystemStart
+    , tpraosSystemStart         :: !SystemStart
     }
   deriving (Generic, NoThunks)
 
@@ -372,12 +375,8 @@ instance SL.PraosCrypto c => ConsensusProtocol (TPraos c) where
   type ValidationErr (TPraos c) = SL.ChainTransitionError c
   type ValidateView  (TPraos c) = TPraosValidateView c
 
-  protocolSecurityParam         = tpraosSecurityParam . tpraosParams
-  protocolGenesisWindowLength p =
-    GenesisWindowLength
-    $ floor
-    $ 3 * (fromIntegral $ maxRollbacks $ protocolSecurityParam p)
-      / (undefined $ tpraosLeaderF (tpraosParams p) :: Double)
+  protocolSecurityParam       = tpraosSecurityParam       . tpraosParams
+  protocolGenesisWindowLength = tpraosGenesisWindowLength . tpraosParams
 
   checkIsLeader cfg TPraosCanBeLeader{..} slot cs = do
       -- First, check whether we're in the overlay schedule

ouroboros-consensus-test/test-consensus/Test/Consensus/HardFork/Combinator/B.hs

@@ -105,7 +105,7 @@ instance ConsensusProtocol ProtocolB where
       then Just ()
       else Nothing
 
-  protocolSecurityParam = cfgB_k
+  protocolSecurityParam       = cfgB_k
   protocolGenesisWindowLength = cfgB_s
 
   tickChainDepState     _ _ _ _ = TickedTrivial

ouroboros-consensus-test/test-consensus/Test/Consensus/MiniProtocol/ChainSync/Client.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections       #-}
 {-# LANGUAGE TypeApplications    #-}
 module Test.Consensus.MiniProtocol.ChainSync.Client (tests) where
 

ouroboros-consensus/src/Ouroboros/Consensus/Config/GenesisWindowLength.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingVia                #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
--- | Module
 
 module Ouroboros.Consensus.Config.GenesisWindowLength (GenesisWindowLength (..)) where
 
@@ -10,6 +9,38 @@ import           GHC.Generics (Generic)
 import           NoThunks.Class (NoThunks)
 import           Quiet
 
+-- | The Genesis window length as needed for Ouroboros Genesis.
+--
+-- The paper 'Ouroboros Genesis: Composable Proof-of-Stake Blockchains with
+-- Dynamic Availability' specifies that when two chains intersect more than @k@
+-- blocks in the past, then the best chain is the one that has more blocks in
+-- the window of length @s@.
+--
+-- After discussing what value should be used for @s@ with the researchers, it
+-- was set to @3k/f@.
+--
+-- The genesis window must be available for all eras. Ouroboros Genesis is a
+-- refinement of Praos that aims to solve the problem of nodes joining the
+-- network. Therefore it does not make sense to enable the genesis window only
+-- for certain eras or periods.
+--
+-- The length of the genesis window, @s@, does not vary between eras. If this
+-- was the case we would need to solve the following problems:
+--
+-- - What would happen if the new era has a smaller active-slot coefficient?
+-- - What would happen if the new era has a bigger active-slot coefficient?
+-- - How to compare chains when the era transition happens inside the genesis
+--   window?
+-- - What if the genesis window of the old era, considering the active slot
+--   coefficient on the second era, would go over the transition to a third era?
+--
+-- Due to the problems mentioned above, we established that the length of the
+-- genesis window will not change, much like the @k@ parameter doesn't change
+-- between eras. @s@ will then not be computed through the formula above, but
+-- instead set as a global configuration parameter, that will satisfy the
+-- formula in the present situation (k = 2160, f = 0.05, s = 129600). If this
+-- value is to change in the future, then further specifications will be
+-- required.
 newtype GenesisWindowLength = GenesisWindowLength { genesisWindowLength :: Word64 }
   deriving (Eq, Generic, NoThunks)
   deriving Show via Quiet GenesisWindowLength

ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs

@@ -3,12 +3,10 @@
 {-# LANGUAGE DerivingVia           #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE NamedFieldPuns        #-}
 {-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TupleSections         #-}
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeFamilies          #-}
 
@@ -29,8 +27,9 @@ import           Control.Monad
 import           Control.Monad.Except
 import           Data.Bifunctor (second)
 import           Data.Hashable (Hashable)
-import qualified Data.List.NonEmpty as NE
-import           Data.Map.Strict (Map)
+import           Data.List.NonEmpty (NonEmpty)
+import           Data.Map (Map)
+import qualified Data.Map.Strict as Map
 import           Data.Maybe (isJust, mapMaybe)
 import           Data.Proxy
 import qualified Data.Text as Text
@@ -57,6 +56,7 @@ import           Ouroboros.Consensus.Block hiding (blockMatchesHeader)
 import qualified Ouroboros.Consensus.Block as Block
 import           Ouroboros.Consensus.BlockchainTime
 import           Ouroboros.Consensus.Config
+import           Ouroboros.Consensus.Config.GenesisWindowLength
 import qualified Ouroboros.Consensus.Config.SupportsNode as SupportsNode
 import           Ouroboros.Consensus.Forecast
 import qualified Ouroboros.Consensus.HardFork.Abstract as History
@@ -70,6 +70,7 @@ import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.Mempool
 import           Ouroboros.Consensus.Node.Run
 import           Ouroboros.Consensus.Node.Tracers
+import qualified Ouroboros.Consensus.NodeKernel.Genesis as Genesis
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Util.AnchoredFragment
 import           Ouroboros.Consensus.Util.EarlyExit
@@ -83,10 +84,6 @@ import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
 import           Ouroboros.Consensus.Storage.ChainDB.Init (InitChainDB)
 import qualified Ouroboros.Consensus.Storage.ChainDB.Init as InitChainDB
 
-import qualified Data.Map.Strict as Map
-import           Ouroboros.Consensus.Config.GenesisWindowLength
-import qualified Ouroboros.Consensus.NodeKernel.Genesis as Genesis
-
 {-------------------------------------------------------------------------------
   Relay node
 -------------------------------------------------------------------------------}
@@ -130,10 +127,10 @@ data NodeKernelArgs m remotePeer localPeer blk = NodeKernelArgs {
 
 initNodeKernel
     :: forall m remotePeer localPeer blk.
-       ( IOLike   m
-       , RunNode  blk
+       ( IOLike m
+       , RunNode blk
        , NoThunks remotePeer
-       , Ord      remotePeer
+       , Ord remotePeer
        , Hashable remotePeer
        )
     => NodeKernelArgs m remotePeer localPeer blk
@@ -245,7 +242,9 @@ initBlockFetchConsensusInterface cfg chainDB getCandidates blockFetchSize btime
       History.runWithCachedSummary
         (toSummary <$> ChainDB.getCurrentLedger chainDB)
     let slotToUTCTime rp =
-                either errMsg toAbsolute <$> History.cachedRunQuery
+              fmap
+                (either errMsg toAbsolute)
+            $ History.cachedRunQuery
                 cache
                 (fst <$> History.slotToWallclock (realPointSlot rp))
           where
@@ -732,9 +731,9 @@ getMempoolWriter
   -> TxSubmissionMempoolWriter (GenTxId blk) (GenTx blk) TicketNo m
 getMempoolWriter mempool = Inbound.TxSubmissionMempoolWriter
     { Inbound.txId          = txId
-    , mempoolAddTxs = fmap
-      (map (txId . txForgetValidated) . mapMaybe mempoolTxAddedToMaybe)
-      . addTxs mempool
+    , mempoolAddTxs = \txs ->
+        map (txId . txForgetValidated) . mapMaybe mempoolTxAddedToMaybe <$>
+        addTxs mempool txs
     }
 
 {-------------------------------------------------------------------------------
@@ -759,7 +758,7 @@ getPeersFromCurrentLedger ::
      (IOLike m, LedgerSupportsPeerSelection blk)
   => NodeKernel m remotePeer localPeer blk
   -> (LedgerState blk -> Bool)
-  -> STM m (Maybe [(PoolStake, NE.NonEmpty RelayAddress)])
+  -> STM m (Maybe [(PoolStake, NonEmpty RelayAddress)])
 getPeersFromCurrentLedger kernel p = do
     immutableLedger <-
       ledgerState <$> ChainDB.getImmutableLedger (getChainDB kernel)
@@ -779,7 +778,7 @@ getPeersFromCurrentLedgerAfterSlot ::
      )
   => NodeKernel m remotePeer localPeer blk
   -> SlotNo
-  -> STM m (Maybe [(PoolStake, NE.NonEmpty RelayAddress)])
+  -> STM m (Maybe [(PoolStake, NonEmpty RelayAddress)])
 getPeersFromCurrentLedgerAfterSlot kernel slotNo =
     getPeersFromCurrentLedger kernel afterSlotNo
   where

ouroboros-network/demo/chain-sync.hs

@@ -19,8 +19,8 @@ import qualified Data.Map as Map
 import           Data.Proxy (Proxy (..))
 import           Data.Set (Set)
 import qualified Data.Set as Set
-import           Data.Void (Void)
 import           Text.Read (readMaybe)
+import           Data.Void (Void)
 
 import           Control.Concurrent (threadDelay)
 import           Control.Concurrent.Async
@@ -40,11 +40,11 @@ import qualified Codec.Serialise as CBOR
 
 import qualified Ouroboros.Network.AnchoredFragment as AF
 import           Ouroboros.Network.Block
-import           Ouroboros.Network.IOManager
 import qualified Ouroboros.Network.MockChain.Chain as Chain
 import           Ouroboros.Network.Mux
 import           Ouroboros.Network.NodeToClient (LocalConnectionId)
 import           Ouroboros.Network.NodeToNode
+import           Ouroboros.Network.IOManager
 import           Ouroboros.Network.Point (WithOrigin (..))
 import           Ouroboros.Network.Snocket
 import           Ouroboros.Network.Socket