TOSQUASH fourmolu

Author: nfrisby

simulation/src/LeiosProtocol/Short.hs

@@ -480,16 +480,17 @@ stageRangeOf cfg pl stage =
 -- in the first iteration (ie @'PipelineNo' 0@)
 pipelineOf :: forall p. IsPipeline p => LeiosConfig -> Stage p -> SlotNo -> PipelineNo
 pipelineOf cfg stage sl =
-    maybe err cnv $ stageStart cfg stage sl minBound
-  where
-    cnv = toEnum . (`div` cfg.sliceLength) . fromEnum
+  maybe err cnv $ stageStart cfg stage sl minBound
+ where
+  cnv = toEnum . (`div` cfg.sliceLength) . fromEnum
 
-    err = error $ show (cfg.sliceLength, x, stage, sl)
+  err = error $ show (cfg.sliceLength, x, stage, sl)
 
-    x :: String
-    x = case cfg of LeiosConfig{pipeline} -> case pipeline of
-                      SingSingleVote -> "SingleVote"
-                      SingSplitVote -> "SplitVote"
+  x :: String
+  x = case cfg of
+    LeiosConfig{pipeline} -> case pipeline of
+      SingSingleVote -> "SingleVote"
+      SingSplitVote -> "SplitVote"
 
 forEachPipeline :: (forall p. Stage p) -> (forall p. IsPipeline p => Stage p -> a) -> [a]
 forEachPipeline s k = [k @SingleVote s, k @SplitVote s]
@@ -687,20 +688,18 @@ data EndorseBlocksSnapshot = EndorseBlocksSnapshot
 --
 -- IBs that are delivered later than any of these options are discarded,
 -- ignored.
-data IbDeliveryStage =
-    IbDuringProposeOrDeliver1
-    -- ^ The node will not vote for an EB that excludes IBs that arrived during
+data IbDeliveryStage
+  = -- | The node will not vote for an EB that excludes IBs that arrived during
     -- Propose or Deliver1.
     --
     -- The node will include IBs that arrived during Propose or Deliver1 in an
     -- EB it makes.
-  |
+    IbDuringProposeOrDeliver1
+  | -- | The node will include IBs that arrived during Deliver2 in an EB it makes.
     IbDuringDeliver2
-    -- ^ The node will include IBs that arrived during Deliver2 in an EB it makes.
-  |
-    IbDuringEndorse
-    -- ^ The node will not vote for an EB that includes IBs that arrived later
+  | -- | The node will not vote for an EB that includes IBs that arrived later
     -- than Endorse.
+    IbDuringEndorse
   deriving (Bounded, Enum, Eq, Ord, Show)
 
 -- | Both constraints are inclusive.
@@ -718,16 +717,16 @@ ibWasDeliveredLate cfg slotCfg sl deliveryTime =
 
 ibDeliveryStage :: LeiosConfig -> SlotConfig -> SlotNo -> UTCTime -> Maybe IbDeliveryStage
 ibDeliveryStage
-    cfg@LeiosConfig {pipeline = _ :: SingPipeline p}
-    slotCfg
-    ibSlot
-    deliveryTime
-  | before loPropose = Nothing   -- TODO future blocks?
-  | before loDeliver2 = Just IbDuringProposeOrDeliver1
-  | before loEndorse = Just IbDuringDeliver2
-  | before (succ hiEndorse) = Just IbDuringEndorse
-  | otherwise = Nothing   -- TODO late blocks?
-  where
+  cfg@LeiosConfig{pipeline = _ :: SingPipeline p}
+  slotCfg
+  ibSlot
+  deliveryTime
+    | before loPropose = Nothing -- TODO future blocks?
+    | before loDeliver2 = Just IbDuringProposeOrDeliver1
+    | before loEndorse = Just IbDuringDeliver2
+    | before (succ hiEndorse) = Just IbDuringEndorse
+    | otherwise = Nothing -- TODO late blocks?
+   where
     p = pipelineOf @p cfg Propose ibSlot
 
     before sl = deliveryTime < slotTime slotCfg sl
@@ -743,14 +742,14 @@ inputBlocksToEndorse ::
   InputBlocksSnapshot ->
   [InputBlockId]
 inputBlocksToEndorse cfg@LeiosConfig{pipeline = _ :: SingPipeline p} current buffer =
-    buffer.validInputBlocks
-      InputBlocksQuery
-        { generatedBetween = (lo, hi)
-        , receivedBy = IbDuringDeliver2
-        }
-  where
-    hi = pipelineOf @p cfg Endorse current
-    lo = if cfg.lateIbInclusion then pipelineMonus hi 2 else hi
+  buffer.validInputBlocks
+    InputBlocksQuery
+      { generatedBetween = (lo, hi)
+      , receivedBy = IbDuringDeliver2
+      }
+ where
+  hi = pipelineOf @p cfg Endorse current
+  lo = if cfg.lateIbInclusion then pipelineMonus hi 2 else hi
 
 -- | Returns possible EBs to reference from current pipeline EB.
 endorseBlocksToReference ::
@@ -809,9 +808,9 @@ shouldVoteOnEB cfg@LeiosConfig{voteSendStage} _ slot _buffers _
 shouldVoteOnEB cfg@LeiosConfig{voteSendStage = voteSendStage :: Stage p} slotConfig slot buffers ebuffers = cond
  where
   generatedBetween = (lo, hi)
-    where
-      hi = pipelineOf @p cfg voteSendStage slot
-      lo = if cfg.lateIbInclusion then pipelineMonus hi 2 else hi
+   where
+    hi = pipelineOf @p cfg voteSendStage slot
+    lo = if cfg.lateIbInclusion then pipelineMonus hi 2 else hi
   receivedByEndorse =
     buffers.validInputBlocks
       InputBlocksQuery

simulation/src/LeiosProtocol/Short/Node.hs

@@ -122,23 +122,23 @@ data LeiosNodeConfig = LeiosNodeConfig
 data LeiosNodeState m = LeiosNodeState
   { praosState :: !(PraosNode.PraosNodeState RankingBlockBody m)
   , relayIBState :: !(RelayIBState m)
-    -- ^ validated IBs that are still young enough to be diffusing
+  -- ^ validated IBs that are still young enough to be diffusing
   , iBsForEBsAndVotesVar :: !(TVar m (Map PipelineNo (Map InputBlockId IbDeliveryStage)))
-    -- ^ IBs that are relevant to an EB or Vote this node might need to issue
-    --
-    -- Each of these IBs arrived during its contemporary Propose, Deliver1,
-    -- Deliver2, or Endorse stages, has been validated, and is not too old.
-    --
-    -- INVARIANT: In basic Short Leios, none of these IBs are older than
-    -- @4*'sliceLength'@. With the @leios-late-ib-inclusion@ extension enabled,
-    -- none of these IBs are older than @(4+2)*'sliceLength'@.
-    --
-    -- Note that some IBs that are too old to be included in this variable
-    -- might still be needed in order to apply some RB.
-    --
-    -- INVARIANT: @all (\_k v -> not $ null v)@.
-    --
-    -- INVARIANT: @all (\k v -> all ((k ==) . pipelineOf cfg Propose) v)@.
+  -- ^ IBs that are relevant to an EB or Vote this node might need to issue
+  --
+  -- Each of these IBs arrived during its contemporary Propose, Deliver1,
+  -- Deliver2, or Endorse stages, has been validated, and is not too old.
+  --
+  -- INVARIANT: In basic Short Leios, none of these IBs are older than
+  -- @4*'sliceLength'@. With the @leios-late-ib-inclusion@ extension enabled,
+  -- none of these IBs are older than @(4+2)*'sliceLength'@.
+  --
+  -- Note that some IBs that are too old to be included in this variable
+  -- might still be needed in order to apply some RB.
+  --
+  -- INVARIANT: @all (\_k v -> not $ null v)@.
+  --
+  -- INVARIANT: @all (\k v -> all ((k ==) . pipelineOf cfg Propose) v)@.
   , relayEBState :: !(RelayEBState m)
   , prunedUnadoptedEBStateToVar :: !(TVar m SlotNo)
   , prunedUncertifiedEBStateToVar :: !(TVar m SlotNo)
@@ -445,7 +445,7 @@ leiosNode tracer cfg followers peers = do
   let submitIB xs deliveryTime completion = do
         traceReceived xs $ EventIB . uncurry InputBlock
         let annotate x = (,) x <$> ibDeliveryStage cfg.leios cfg.slotConfig (fst x).slot deliveryTime
-        let xs' = mapMaybe annotate xs   -- TODO what to do with early/late arrivals?
+        let xs' = mapMaybe annotate xs -- TODO what to do with early/late arrivals?
         unless (null xs') $ dispatch $! ValidateIBs xs' completion
   let submitVote (map snd -> xs) deliveryTime completion = do
         traceReceived xs EventVote
@@ -816,7 +816,7 @@ adoptIB :: MonadSTM m => LeiosConfig -> LeiosNodeState m -> InputBlock -> IbDeli
 adoptIB cfg leiosState ib deliveryStage = do
   let !ibSlot = ib.header.slot
       !p = case cfg of
-        LeiosConfig {pipeline = _ :: SingPipeline p} ->
+        LeiosConfig{pipeline = _ :: SingPipeline p} ->
           pipelineOf @p cfg Short.Propose ibSlot
   modifyTVar'
     leiosState.iBsForEBsAndVotesVar
@@ -1025,23 +1025,21 @@ mkBuffersView cfg st = BuffersView{..}
   ibs = do
     let splitLE k m =
           let (lt, mbEq, _gt) = Map.splitLookup k m
-          in
-          case mbEq of
-              Nothing -> lt
-              Just eq -> Map.insert k eq lt
+           in case mbEq of
+                Nothing -> lt
+                Just eq -> Map.insert k eq lt
         splitGE k m =
           let (_lt, mbEq, gt) = Map.splitLookup k m
-          in
-          case mbEq of
-              Nothing -> gt
-              Just eq -> Map.insert k eq gt
+           in case mbEq of
+                Nothing -> gt
+                Just eq -> Map.insert k eq gt
         generatedCheck (lo, hi) =
-            Map.unions
-          . splitGE lo
-          . splitLE hi
+          Map.unions
+            . splitGE lo
+            . splitLE hi
         receivedByCheck hi =
-            mapMaybe (\(ibId, deliveryStage) -> do guard (deliveryStage <= hi); Just ibId)
-          . Map.toList
+          mapMaybe (\(ibId, deliveryStage) -> do guard (deliveryStage <= hi); Just ibId)
+            . Map.toList
     xs <- readTVar st.iBsForEBsAndVotesVar
     let validInputBlocks q = receivedByCheck q.receivedBy . generatedCheck q.generatedBetween $ xs
     return InputBlocksSnapshot{..}

simulation/test/Test/ShortToFull.hs

@@ -25,7 +25,7 @@ tests =
 data Test_leiosLateIbInclusion = Test_leiosLateIbInclusion
   { ibTable :: [(Int, Short.PipelineNo, Short.IbDeliveryStage)] -- the Int is @zip [0..]@, /before shrinking/
   , ebLo :: SlotNo
-    -- ^ this first slot in which an EB could actually exist
+  -- ^ this first slot in which an EB could actually exist
   , ebSlot :: SlotNo
   }
   deriving (Show)
@@ -41,7 +41,7 @@ instance Q.Arbitrary Test_leiosLateIbInclusion where
       n <- Q.choose (0, 1000)
       gens <- Q.vectorOf n $ fmap toEnum $ Q.choose (0, 20)
       delays <- Q.vectorOf n $ Q.elements [minBound .. maxBound]
-      pure $ [ (i, gen, delay) | i <- [0..] | gen <- sort gens | delay <- delays ]
+      pure $ [(i, gen, delay) | i <- [0 ..] | gen <- sort gens | delay <- delays]
     pure Test_leiosLateIbInclusion{..}
 
   shrink testSetup =