{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

-- | PBFT chain state
--
-- Intended for qualified import.
module Ouroboros.Consensus.Protocol.PBFT.State (
    PBftSigner (..)
  , PBftState (..)
  , Ticked (..)
  , WindowSize (..)
    -- * Construction
  , append
  , empty
    -- * Queries
  , countSignatures
  , countSignedBy
  , lastSignedSlot
    -- * Conversion
  , fromList
  , toList
    -- * Serialization
  , decodePBftState
  , encodePBftState
  ) where

import           Codec.Serialise (Serialise (..))
import           Codec.Serialise.Decoding (Decoder)
import           Codec.Serialise.Encoding (Encoding)
import           Control.Monad.Except
import qualified Data.Foldable as Foldable
import           Data.List (sortOn)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Sequence.Strict (StrictSeq (Empty, (:<|), (:|>)), (|>))
import qualified Data.Sequence.Strict as Seq
import           Data.Word
import           GHC.Generics (Generic)
import           GHC.Stack
import           NoThunks.Class (NoThunks)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Protocol.PBFT.Crypto
import           Ouroboros.Consensus.Ticked
import           Ouroboros.Consensus.Util (repeatedly)
import           Ouroboros.Consensus.Util.Versioned

{-------------------------------------------------------------------------------
  Types
-------------------------------------------------------------------------------}

-- | PBFT state
--
-- For a window size of @n@, the PBFT chain state
-- is a sequence of signatures over the last @n@ slots
--
-- > +-------------------------------------------+
-- > |                signatures                 |
-- > +-------------------------------------------+
-- >
-- > ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-- >                  window of n
--
-- We need the last @n@ signatures to verify that no single key has signed more
-- than a certain threshold percentage of the slots.
--
-- When near genesis, we will have less than @n@ signatures in the history.
--
-- The window size itself is pretty much arbitrary and will be fixed by a
-- particular blockchain specification (e.g., Byron).
data PBftState c = PBftState {
      -- | Signatures in the window
      --
      -- We should have precisely @n@ signatures in the window, unless we are
      -- near genesis.
      --
      -- INVARIANT Empty if and only if we are exactly at genesis.
      PBftState c -> StrictSeq (PBftSigner c)
inWindow :: !(StrictSeq (PBftSigner c))

      -- | Cached counts of the signatures in the window
    , PBftState c -> Map (PBftVerKeyHash c) Word64
counts   :: !(Map (PBftVerKeyHash c) Word64)
    }
  deriving ((forall x. PBftState c -> Rep (PBftState c) x)
-> (forall x. Rep (PBftState c) x -> PBftState c)
-> Generic (PBftState c)
forall x. Rep (PBftState c) x -> PBftState c
forall x. PBftState c -> Rep (PBftState c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (PBftState c) x -> PBftState c
forall c x. PBftState c -> Rep (PBftState c) x
$cto :: forall c x. Rep (PBftState c) x -> PBftState c
$cfrom :: forall c x. PBftState c -> Rep (PBftState c) x
Generic)

{-------------------------------------------------------------------------------
  Invariant
-------------------------------------------------------------------------------}

size :: Num b => StrictSeq a -> b
size :: StrictSeq a -> b
size = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> (StrictSeq a -> Int) -> StrictSeq a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq a -> Int
forall a. StrictSeq a -> Int
Seq.length

-- | Re-compute cached counts
computeCounts :: PBftCrypto c
              => StrictSeq (PBftSigner c)  -> Map (PBftVerKeyHash c) Word64
computeCounts :: StrictSeq (PBftSigner c) -> Map (PBftVerKeyHash c) Word64
computeCounts StrictSeq (PBftSigner c)
inWindow =
    (PBftSigner c
 -> Map (PBftVerKeyHash c) Word64 -> Map (PBftVerKeyHash c) Word64)
-> [PBftSigner c]
-> Map (PBftVerKeyHash c) Word64
-> Map (PBftVerKeyHash c) Word64
forall a b. (a -> b -> b) -> [a] -> b -> b
repeatedly (PBftVerKeyHash c
-> Map (PBftVerKeyHash c) Word64 -> Map (PBftVerKeyHash c) Word64
forall gk. Ord gk => gk -> Map gk Word64 -> Map gk Word64
incrementKey (PBftVerKeyHash c
 -> Map (PBftVerKeyHash c) Word64 -> Map (PBftVerKeyHash c) Word64)
-> (PBftSigner c -> PBftVerKeyHash c)
-> PBftSigner c
-> Map (PBftVerKeyHash c) Word64
-> Map (PBftVerKeyHash c) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PBftSigner c -> PBftVerKeyHash c
forall c. PBftSigner c -> PBftVerKeyHash c
pbftSignerGenesisKey)
               (StrictSeq (PBftSigner c) -> [PBftSigner c]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList StrictSeq (PBftSigner c)
inWindow)
               Map (PBftVerKeyHash c) Word64
forall k a. Map k a
Map.empty

invariant :: PBftCrypto c
          => WindowSize -> PBftState c -> Either String ()
invariant :: WindowSize -> PBftState c -> Either String ()
invariant (WindowSize Word64
n) st :: PBftState c
st@PBftState{Map (PBftVerKeyHash c) Word64
StrictSeq (PBftSigner c)
counts :: Map (PBftVerKeyHash c) Word64
inWindow :: StrictSeq (PBftSigner c)
counts :: forall c. PBftState c -> Map (PBftVerKeyHash c) Word64
inWindow :: forall c. PBftState c -> StrictSeq (PBftSigner c)
..} = Except String () -> Either String ()
forall e a. Except e a -> Either e a
runExcept (Except String () -> Either String ())
-> Except String () -> Either String ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> Except String () -> Except String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (StrictSeq (PBftSigner c) -> Word64
forall b a. Num b => StrictSeq a -> b
size StrictSeq (PBftSigner c)
inWindow Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
n) (Except String () -> Except String ())
-> Except String () -> Except String ()
forall a b. (a -> b) -> a -> b
$
      String -> Except String ()
failure String
"Too many in-window signatures"

    Bool -> Except String () -> Except String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (StrictSeq (PBftSigner c) -> Map (PBftVerKeyHash c) Word64
forall c.
PBftCrypto c =>
StrictSeq (PBftSigner c) -> Map (PBftVerKeyHash c) Word64
computeCounts StrictSeq (PBftSigner c)
inWindow Map (PBftVerKeyHash c) Word64
-> Map (PBftVerKeyHash c) Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Map (PBftVerKeyHash c) Word64
counts) (Except String () -> Except String ())
-> Except String () -> Except String ()
forall a b. (a -> b) -> a -> b
$
      String -> Except String ()
failure String
"Cached counts incorrect"
  where
    failure :: String -> Except String ()
    failure :: String -> Except String ()
failure String
err = String -> Except String ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Except String ()) -> String -> Except String ()
forall a b. (a -> b) -> a -> b
$ String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PBftState c -> String
forall a. Show a => a -> String
show PBftState c
st

-- | The 'PBftState' tests don't rely on this flag but check the
-- invariant manually. This flag is here so that the invariant checks could be
-- enabled while running other consensus tests, just as a sanity check.
--
-- TODO: Make this a CPP flag, see #1248.
enableInvariant :: Bool
enableInvariant :: Bool
enableInvariant = Bool
False

assertInvariant ::
     (HasCallStack, PBftCrypto c)
  => WindowSize
  -> PBftState c -> PBftState c
assertInvariant :: WindowSize -> PBftState c -> PBftState c
assertInvariant WindowSize
n PBftState c
st
  | Bool
enableInvariant =
      case WindowSize -> PBftState c -> Either String ()
forall c.
PBftCrypto c =>
WindowSize -> PBftState c -> Either String ()
invariant WindowSize
n PBftState c
st of
        Right () -> PBftState c
st
        Left String
err -> String -> PBftState c
forall a. HasCallStack => String -> a
error (String -> PBftState c) -> String -> PBftState c
forall a b. (a -> b) -> a -> b
$ String
"Invariant violation: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
  | Bool
otherwise = PBftState c
st

-- | Slot and corresponding genesis key
data PBftSigner c = PBftSigner {
      PBftSigner c -> SlotNo
pbftSignerSlotNo     :: !SlotNo
    , PBftSigner c -> PBftVerKeyHash c
pbftSignerGenesisKey :: !(PBftVerKeyHash c)
    }
  deriving ((forall x. PBftSigner c -> Rep (PBftSigner c) x)
-> (forall x. Rep (PBftSigner c) x -> PBftSigner c)
-> Generic (PBftSigner c)
forall x. Rep (PBftSigner c) x -> PBftSigner c
forall x. PBftSigner c -> Rep (PBftSigner c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (PBftSigner c) x -> PBftSigner c
forall c x. PBftSigner c -> Rep (PBftSigner c) x
$cto :: forall c x. Rep (PBftSigner c) x -> PBftSigner c
$cfrom :: forall c x. PBftSigner c -> Rep (PBftSigner c) x
Generic)

-- | Window size
--
-- See 'PBftState' itself for a detailed discussion on the window size
-- versus the number of signatures.
newtype WindowSize = WindowSize { WindowSize -> Word64
getWindowSize :: Word64 }
  deriving newtype (Int -> WindowSize -> String -> String
[WindowSize] -> String -> String
WindowSize -> String
(Int -> WindowSize -> String -> String)
-> (WindowSize -> String)
-> ([WindowSize] -> String -> String)
-> Show WindowSize
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [WindowSize] -> String -> String
$cshowList :: [WindowSize] -> String -> String
show :: WindowSize -> String
$cshow :: WindowSize -> String
showsPrec :: Int -> WindowSize -> String -> String
$cshowsPrec :: Int -> WindowSize -> String -> String
Show, WindowSize -> WindowSize -> Bool
(WindowSize -> WindowSize -> Bool)
-> (WindowSize -> WindowSize -> Bool) -> Eq WindowSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowSize -> WindowSize -> Bool
$c/= :: WindowSize -> WindowSize -> Bool
== :: WindowSize -> WindowSize -> Bool
$c== :: WindowSize -> WindowSize -> Bool
Eq, Eq WindowSize
Eq WindowSize
-> (WindowSize -> WindowSize -> Ordering)
-> (WindowSize -> WindowSize -> Bool)
-> (WindowSize -> WindowSize -> Bool)
-> (WindowSize -> WindowSize -> Bool)
-> (WindowSize -> WindowSize -> Bool)
-> (WindowSize -> WindowSize -> WindowSize)
-> (WindowSize -> WindowSize -> WindowSize)
-> Ord WindowSize
WindowSize -> WindowSize -> Bool
WindowSize -> WindowSize -> Ordering
WindowSize -> WindowSize -> WindowSize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WindowSize -> WindowSize -> WindowSize
$cmin :: WindowSize -> WindowSize -> WindowSize
max :: WindowSize -> WindowSize -> WindowSize
$cmax :: WindowSize -> WindowSize -> WindowSize
>= :: WindowSize -> WindowSize -> Bool
$c>= :: WindowSize -> WindowSize -> Bool
> :: WindowSize -> WindowSize -> Bool
$c> :: WindowSize -> WindowSize -> Bool
<= :: WindowSize -> WindowSize -> Bool
$c<= :: WindowSize -> WindowSize -> Bool
< :: WindowSize -> WindowSize -> Bool
$c< :: WindowSize -> WindowSize -> Bool
compare :: WindowSize -> WindowSize -> Ordering
$ccompare :: WindowSize -> WindowSize -> Ordering
$cp1Ord :: Eq WindowSize
Ord, Int -> WindowSize
WindowSize -> Int
WindowSize -> [WindowSize]
WindowSize -> WindowSize
WindowSize -> WindowSize -> [WindowSize]
WindowSize -> WindowSize -> WindowSize -> [WindowSize]
(WindowSize -> WindowSize)
-> (WindowSize -> WindowSize)
-> (Int -> WindowSize)
-> (WindowSize -> Int)
-> (WindowSize -> [WindowSize])
-> (WindowSize -> WindowSize -> [WindowSize])
-> (WindowSize -> WindowSize -> [WindowSize])
-> (WindowSize -> WindowSize -> WindowSize -> [WindowSize])
-> Enum WindowSize
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: WindowSize -> WindowSize -> WindowSize -> [WindowSize]
$cenumFromThenTo :: WindowSize -> WindowSize -> WindowSize -> [WindowSize]
enumFromTo :: WindowSize -> WindowSize -> [WindowSize]
$cenumFromTo :: WindowSize -> WindowSize -> [WindowSize]
enumFromThen :: WindowSize -> WindowSize -> [WindowSize]
$cenumFromThen :: WindowSize -> WindowSize -> [WindowSize]
enumFrom :: WindowSize -> [WindowSize]
$cenumFrom :: WindowSize -> [WindowSize]
fromEnum :: WindowSize -> Int
$cfromEnum :: WindowSize -> Int
toEnum :: Int -> WindowSize
$ctoEnum :: Int -> WindowSize
pred :: WindowSize -> WindowSize
$cpred :: WindowSize -> WindowSize
succ :: WindowSize -> WindowSize
$csucc :: WindowSize -> WindowSize
Enum, Integer -> WindowSize
WindowSize -> WindowSize
WindowSize -> WindowSize -> WindowSize
(WindowSize -> WindowSize -> WindowSize)
-> (WindowSize -> WindowSize -> WindowSize)
-> (WindowSize -> WindowSize -> WindowSize)
-> (WindowSize -> WindowSize)
-> (WindowSize -> WindowSize)
-> (WindowSize -> WindowSize)
-> (Integer -> WindowSize)
-> Num WindowSize
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> WindowSize
$cfromInteger :: Integer -> WindowSize
signum :: WindowSize -> WindowSize
$csignum :: WindowSize -> WindowSize
abs :: WindowSize -> WindowSize
$cabs :: WindowSize -> WindowSize
negate :: WindowSize -> WindowSize
$cnegate :: WindowSize -> WindowSize
* :: WindowSize -> WindowSize -> WindowSize
$c* :: WindowSize -> WindowSize -> WindowSize
- :: WindowSize -> WindowSize -> WindowSize
$c- :: WindowSize -> WindowSize -> WindowSize
+ :: WindowSize -> WindowSize -> WindowSize
$c+ :: WindowSize -> WindowSize -> WindowSize
Num, Num WindowSize
Ord WindowSize
Num WindowSize
-> Ord WindowSize -> (WindowSize -> Rational) -> Real WindowSize
WindowSize -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: WindowSize -> Rational
$ctoRational :: WindowSize -> Rational
$cp2Real :: Ord WindowSize
$cp1Real :: Num WindowSize
Real, Enum WindowSize
Real WindowSize
Real WindowSize
-> Enum WindowSize
-> (WindowSize -> WindowSize -> WindowSize)
-> (WindowSize -> WindowSize -> WindowSize)
-> (WindowSize -> WindowSize -> WindowSize)
-> (WindowSize -> WindowSize -> WindowSize)
-> (WindowSize -> WindowSize -> (WindowSize, WindowSize))
-> (WindowSize -> WindowSize -> (WindowSize, WindowSize))
-> (WindowSize -> Integer)
-> Integral WindowSize
WindowSize -> Integer
WindowSize -> WindowSize -> (WindowSize, WindowSize)
WindowSize -> WindowSize -> WindowSize
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: WindowSize -> Integer
$ctoInteger :: WindowSize -> Integer
divMod :: WindowSize -> WindowSize -> (WindowSize, WindowSize)
$cdivMod :: WindowSize -> WindowSize -> (WindowSize, WindowSize)
quotRem :: WindowSize -> WindowSize -> (WindowSize, WindowSize)
$cquotRem :: WindowSize -> WindowSize -> (WindowSize, WindowSize)
mod :: WindowSize -> WindowSize -> WindowSize
$cmod :: WindowSize -> WindowSize -> WindowSize
div :: WindowSize -> WindowSize -> WindowSize
$cdiv :: WindowSize -> WindowSize -> WindowSize
rem :: WindowSize -> WindowSize -> WindowSize
$crem :: WindowSize -> WindowSize -> WindowSize
quot :: WindowSize -> WindowSize -> WindowSize
$cquot :: WindowSize -> WindowSize -> WindowSize
$cp2Integral :: Enum WindowSize
$cp1Integral :: Real WindowSize
Integral)

deriving instance PBftCrypto c => Show     (PBftState c)
deriving instance PBftCrypto c => Eq       (PBftState c)
deriving instance PBftCrypto c => NoThunks (PBftState c)

deriving instance PBftCrypto c => Show     (PBftSigner c)
deriving instance PBftCrypto c => Eq       (PBftSigner c)
deriving instance PBftCrypto c => NoThunks (PBftSigner c)

{-------------------------------------------------------------------------------
  Queries
-------------------------------------------------------------------------------}

-- | Number of signatures in the window
--
-- This will be equal to the specified window size, unless near genesis
countSignatures :: PBftState c -> Word64
countSignatures :: PBftState c -> Word64
countSignatures PBftState{Map (PBftVerKeyHash c) Word64
StrictSeq (PBftSigner c)
counts :: Map (PBftVerKeyHash c) Word64
inWindow :: StrictSeq (PBftSigner c)
counts :: forall c. PBftState c -> Map (PBftVerKeyHash c) Word64
inWindow :: forall c. PBftState c -> StrictSeq (PBftSigner c)
..} = StrictSeq (PBftSigner c) -> Word64
forall b a. Num b => StrictSeq a -> b
size StrictSeq (PBftSigner c)
inWindow

-- | The number of blocks signed by the specified genesis key
--
-- This only considers the signatures within the window, not in the pre-window;
-- see 'PBftState' for detailed discussion.
countSignedBy :: PBftCrypto c => PBftState c -> PBftVerKeyHash c -> Word64
countSignedBy :: PBftState c -> PBftVerKeyHash c -> Word64
countSignedBy PBftState{Map (PBftVerKeyHash c) Word64
StrictSeq (PBftSigner c)
counts :: Map (PBftVerKeyHash c) Word64
inWindow :: StrictSeq (PBftSigner c)
counts :: forall c. PBftState c -> Map (PBftVerKeyHash c) Word64
inWindow :: forall c. PBftState c -> StrictSeq (PBftSigner c)
..} PBftVerKeyHash c
gk = Word64
-> PBftVerKeyHash c -> Map (PBftVerKeyHash c) Word64 -> Word64
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Word64
0 PBftVerKeyHash c
gk Map (PBftVerKeyHash c) Word64
counts

-- | The last (most recent) signed slot in the window
--
-- Returns 'Origin' if there are no signatures in the window (this will happen
-- exactly at genesis only).
--
-- Unaffected by EBBs, since they're not signed.
lastSignedSlot :: PBftState c -> WithOrigin SlotNo
lastSignedSlot :: PBftState c -> WithOrigin SlotNo
lastSignedSlot PBftState{Map (PBftVerKeyHash c) Word64
StrictSeq (PBftSigner c)
counts :: Map (PBftVerKeyHash c) Word64
inWindow :: StrictSeq (PBftSigner c)
counts :: forall c. PBftState c -> Map (PBftVerKeyHash c) Word64
inWindow :: forall c. PBftState c -> StrictSeq (PBftSigner c)
..} =
    case StrictSeq (PBftSigner c)
inWindow of
      StrictSeq (PBftSigner c)
_ :|> PBftSigner c
signer -> SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin (PBftSigner c -> SlotNo
forall c. PBftSigner c -> SlotNo
pbftSignerSlotNo PBftSigner c
signer)
      StrictSeq (PBftSigner c)
_otherwise   -> WithOrigin SlotNo
forall t. WithOrigin t
Origin

{-------------------------------------------------------------------------------
  Construction
-------------------------------------------------------------------------------}

-- | Empty PBFT chain state
--
-- In other words, the PBFT chain state corresponding to genesis.
empty :: PBftState c
empty :: PBftState c
empty = PBftState :: forall c.
StrictSeq (PBftSigner c)
-> Map (PBftVerKeyHash c) Word64 -> PBftState c
PBftState {
      inWindow :: StrictSeq (PBftSigner c)
inWindow   = StrictSeq (PBftSigner c)
forall a. StrictSeq a
Empty
    , counts :: Map (PBftVerKeyHash c) Word64
counts     = Map (PBftVerKeyHash c) Word64
forall k a. Map k a
Map.empty
    }

-- | Append new signature
--
-- Drops the oldest signature, provided we have reached the required number.
append ::
     forall c. PBftCrypto c
  => WindowSize
  -> PBftSigner c
  -> PBftState c -> PBftState c
append :: WindowSize -> PBftSigner c -> PBftState c -> PBftState c
append WindowSize
n signer :: PBftSigner c
signer@(PBftSigner SlotNo
_ PBftVerKeyHash c
gk) PBftState{Map (PBftVerKeyHash c) Word64
StrictSeq (PBftSigner c)
counts :: Map (PBftVerKeyHash c) Word64
inWindow :: StrictSeq (PBftSigner c)
counts :: forall c. PBftState c -> Map (PBftVerKeyHash c) Word64
inWindow :: forall c. PBftState c -> StrictSeq (PBftSigner c)
..} =
    WindowSize -> PBftState c -> PBftState c
forall c.
(HasCallStack, PBftCrypto c) =>
WindowSize -> PBftState c -> PBftState c
assertInvariant WindowSize
n (PBftState c -> PBftState c) -> PBftState c -> PBftState c
forall a b. (a -> b) -> a -> b
$ PBftState :: forall c.
StrictSeq (PBftSigner c)
-> Map (PBftVerKeyHash c) Word64 -> PBftState c
PBftState {
        inWindow :: StrictSeq (PBftSigner c)
inWindow = StrictSeq (PBftSigner c)
trimmedWindow
      , counts :: Map (PBftVerKeyHash c) Word64
counts   = Map (PBftVerKeyHash c) Word64
trimmedCounts
      }
  where
    -- First append the signature to the right,
    (StrictSeq (PBftSigner c)
appendedWindow, Map (PBftVerKeyHash c) Word64
appendedCounts) =
        (StrictSeq (PBftSigner c)
inWindow StrictSeq (PBftSigner c)
-> PBftSigner c -> StrictSeq (PBftSigner c)
forall a. StrictSeq a -> a -> StrictSeq a
|> PBftSigner c
signer, PBftVerKeyHash c
-> Map (PBftVerKeyHash c) Word64 -> Map (PBftVerKeyHash c) Word64
forall gk. Ord gk => gk -> Map gk Word64 -> Map gk Word64
incrementKey PBftVerKeyHash c
gk Map (PBftVerKeyHash c) Word64
counts)
    -- then trim the oldest from the left, if needed.
    (StrictSeq (PBftSigner c)
trimmedWindow, Map (PBftVerKeyHash c) Word64
trimmedCounts) = case StrictSeq (PBftSigner c)
appendedWindow of
        PBftSigner c
x :<| StrictSeq (PBftSigner c)
xs | StrictSeq (PBftSigner c) -> Word64
forall b a. Num b => StrictSeq a -> b
size StrictSeq (PBftSigner c)
inWindow Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== WindowSize -> Word64
getWindowSize WindowSize
n ->
          (StrictSeq (PBftSigner c)
xs, PBftVerKeyHash c
-> Map (PBftVerKeyHash c) Word64 -> Map (PBftVerKeyHash c) Word64
forall gk. Ord gk => gk -> Map gk Word64 -> Map gk Word64
decrementKey (PBftSigner c -> PBftVerKeyHash c
forall c. PBftSigner c -> PBftVerKeyHash c
pbftSignerGenesisKey PBftSigner c
x) Map (PBftVerKeyHash c) Word64
appendedCounts)
        StrictSeq (PBftSigner c)
_otherwise ->
          (StrictSeq (PBftSigner c)
appendedWindow, Map (PBftVerKeyHash c) Word64
appendedCounts)

{-------------------------------------------------------------------------------
  Internal
-------------------------------------------------------------------------------}

incrementKey :: Ord gk => gk -> Map gk Word64 -> Map gk Word64
incrementKey :: gk -> Map gk Word64 -> Map gk Word64
incrementKey = (Maybe Word64 -> Maybe Word64)
-> gk -> Map gk Word64 -> Map gk Word64
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe Word64 -> Maybe Word64
inc
  where
    inc :: Maybe Word64 -> Maybe Word64
    inc :: Maybe Word64 -> Maybe Word64
inc Maybe Word64
Nothing  = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
1
    inc (Just Word64
n) = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)

decrementKey :: Ord gk => gk -> Map gk Word64 -> Map gk Word64
decrementKey :: gk -> Map gk Word64 -> Map gk Word64
decrementKey = (Maybe Word64 -> Maybe Word64)
-> gk -> Map gk Word64 -> Map gk Word64
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe Word64 -> Maybe Word64
dec
  where
    dec :: Maybe Word64 -> Maybe Word64
    dec :: Maybe Word64 -> Maybe Word64
dec Maybe Word64
Nothing  = String -> Maybe Word64
forall a. HasCallStack => String -> a
error String
"decrementKey: key does not exist"
    dec (Just Word64
1) = Maybe Word64
forall a. Maybe a
Nothing
    dec (Just Word64
n) = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)

{-------------------------------------------------------------------------------
  Conversion
-------------------------------------------------------------------------------}

toList :: PBftState c -> [PBftSigner c]
toList :: PBftState c -> [PBftSigner c]
toList = StrictSeq (PBftSigner c) -> [PBftSigner c]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (StrictSeq (PBftSigner c) -> [PBftSigner c])
-> (PBftState c -> StrictSeq (PBftSigner c))
-> PBftState c
-> [PBftSigner c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PBftState c -> StrictSeq (PBftSigner c)
forall c. PBftState c -> StrictSeq (PBftSigner c)
inWindow

-- | Note: we are not checking the invariants because we don't want to require
-- the 'WindowSize' to be in the context, see #2383. When assertions are
-- enabled, we would notice the invariant violation as soon as we 'append'.
--
-- PRECONDITION: the slots of the signers are in ascending order.
fromList :: PBftCrypto c => [PBftSigner c] -> PBftState c
fromList :: [PBftSigner c] -> PBftState c
fromList [PBftSigner c]
signers = PBftState :: forall c.
StrictSeq (PBftSigner c)
-> Map (PBftVerKeyHash c) Word64 -> PBftState c
PBftState {
      inWindow :: StrictSeq (PBftSigner c)
inWindow = StrictSeq (PBftSigner c)
inWindow
    , counts :: Map (PBftVerKeyHash c) Word64
counts   = StrictSeq (PBftSigner c) -> Map (PBftVerKeyHash c) Word64
forall c.
PBftCrypto c =>
StrictSeq (PBftSigner c) -> Map (PBftVerKeyHash c) Word64
computeCounts StrictSeq (PBftSigner c)
inWindow
    }
  where
    inWindow :: StrictSeq (PBftSigner c)
inWindow = [PBftSigner c] -> StrictSeq (PBftSigner c)
forall a. [a] -> StrictSeq a
Seq.fromList [PBftSigner c]
signers

{-------------------------------------------------------------------------------
  Serialization
-------------------------------------------------------------------------------}

-- | Version 0 supported rollback, removed in #2575.
serializationFormatVersion1 :: VersionNumber
serializationFormatVersion1 :: VersionNumber
serializationFormatVersion1 = VersionNumber
1

invert :: PBftCrypto c => PBftState c -> Map (PBftVerKeyHash c) [SlotNo]
invert :: PBftState c -> Map (PBftVerKeyHash c) [SlotNo]
invert =
      (Map (PBftVerKeyHash c) [SlotNo]
 -> PBftSigner c -> Map (PBftVerKeyHash c) [SlotNo])
-> Map (PBftVerKeyHash c) [SlotNo]
-> StrictSeq (PBftSigner c)
-> Map (PBftVerKeyHash c) [SlotNo]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl'
        (\Map (PBftVerKeyHash c) [SlotNo]
acc (PBftSigner SlotNo
slot PBftVerKeyHash c
key) -> ([SlotNo] -> [SlotNo] -> [SlotNo])
-> PBftVerKeyHash c
-> [SlotNo]
-> Map (PBftVerKeyHash c) [SlotNo]
-> Map (PBftVerKeyHash c) [SlotNo]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [SlotNo] -> [SlotNo] -> [SlotNo]
forall a. Semigroup a => a -> a -> a
(<>) PBftVerKeyHash c
key [SlotNo
slot] Map (PBftVerKeyHash c) [SlotNo]
acc)
        Map (PBftVerKeyHash c) [SlotNo]
forall k a. Map k a
Map.empty
    (StrictSeq (PBftSigner c) -> Map (PBftVerKeyHash c) [SlotNo])
-> (PBftState c -> StrictSeq (PBftSigner c))
-> PBftState c
-> Map (PBftVerKeyHash c) [SlotNo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PBftState c -> StrictSeq (PBftSigner c)
forall c. PBftState c -> StrictSeq (PBftSigner c)
inWindow

uninvert :: PBftCrypto c => Map (PBftVerKeyHash c) [SlotNo] -> PBftState c
uninvert :: Map (PBftVerKeyHash c) [SlotNo] -> PBftState c
uninvert =
      [PBftSigner c] -> PBftState c
forall c. PBftCrypto c => [PBftSigner c] -> PBftState c
fromList
    ([PBftSigner c] -> PBftState c)
-> (Map (PBftVerKeyHash c) [SlotNo] -> [PBftSigner c])
-> Map (PBftVerKeyHash c) [SlotNo]
-> PBftState c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PBftSigner c -> SlotNo) -> [PBftSigner c] -> [PBftSigner c]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn PBftSigner c -> SlotNo
forall c. PBftSigner c -> SlotNo
pbftSignerSlotNo
    ([PBftSigner c] -> [PBftSigner c])
-> (Map (PBftVerKeyHash c) [SlotNo] -> [PBftSigner c])
-> Map (PBftVerKeyHash c) [SlotNo]
-> [PBftSigner c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PBftVerKeyHash c, [SlotNo]) -> [PBftSigner c])
-> [(PBftVerKeyHash c, [SlotNo])] -> [PBftSigner c]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(PBftVerKeyHash c
key, [SlotNo]
slots) -> (SlotNo -> PBftSigner c) -> [SlotNo] -> [PBftSigner c]
forall a b. (a -> b) -> [a] -> [b]
map (SlotNo -> PBftVerKeyHash c -> PBftSigner c
forall c. SlotNo -> PBftVerKeyHash c -> PBftSigner c
`PBftSigner` PBftVerKeyHash c
key) [SlotNo]
slots)
    ([(PBftVerKeyHash c, [SlotNo])] -> [PBftSigner c])
-> (Map (PBftVerKeyHash c) [SlotNo]
    -> [(PBftVerKeyHash c, [SlotNo])])
-> Map (PBftVerKeyHash c) [SlotNo]
-> [PBftSigner c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (PBftVerKeyHash c) [SlotNo] -> [(PBftVerKeyHash c, [SlotNo])]
forall k a. Map k a -> [(k, a)]
Map.toList

encodePBftState ::
     (PBftCrypto c, Serialise (PBftVerKeyHash c))
  => PBftState c -> Encoding
encodePBftState :: PBftState c -> Encoding
encodePBftState PBftState c
st =
    VersionNumber -> Encoding -> Encoding
encodeVersion VersionNumber
serializationFormatVersion1 (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$
      Map (PBftVerKeyHash c) [SlotNo] -> Encoding
forall a. Serialise a => a -> Encoding
encode (PBftState c -> Map (PBftVerKeyHash c) [SlotNo]
forall c.
PBftCrypto c =>
PBftState c -> Map (PBftVerKeyHash c) [SlotNo]
invert PBftState c
st)

decodePBftState ::
     forall c. (PBftCrypto c, Serialise (PBftVerKeyHash c))
  => forall s. Decoder s (PBftState c)
decodePBftState :: forall s. Decoder s (PBftState c)
decodePBftState = [(VersionNumber, VersionDecoder (PBftState c))]
-> forall s. Decoder s (PBftState c)
forall a.
[(VersionNumber, VersionDecoder a)] -> forall s. Decoder s a
decodeVersion
    [(VersionNumber
serializationFormatVersion1, (forall s. Decoder s (PBftState c)) -> VersionDecoder (PBftState c)
forall a. (forall s. Decoder s a) -> VersionDecoder a
Decode forall s. Decoder s (PBftState c)
decodePBftState1)]
  where
    decodePBftState1 :: forall s. Decoder s (PBftState c)
    decodePBftState1 :: Decoder s (PBftState c)
decodePBftState1 = Map (PBftVerKeyHash c) [SlotNo] -> PBftState c
forall c.
PBftCrypto c =>
Map (PBftVerKeyHash c) [SlotNo] -> PBftState c
uninvert (Map (PBftVerKeyHash c) [SlotNo] -> PBftState c)
-> Decoder s (Map (PBftVerKeyHash c) [SlotNo])
-> Decoder s (PBftState c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map (PBftVerKeyHash c) [SlotNo])
forall a s. Serialise a => Decoder s a
decode

instance Serialise (PBftVerKeyHash c) => Serialise (PBftSigner c) where
  encode :: PBftSigner c -> Encoding
encode = (SlotNo, PBftVerKeyHash c) -> Encoding
forall a. Serialise a => a -> Encoding
encode ((SlotNo, PBftVerKeyHash c) -> Encoding)
-> (PBftSigner c -> (SlotNo, PBftVerKeyHash c))
-> PBftSigner c
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PBftSigner c -> (SlotNo, PBftVerKeyHash c)
forall c. PBftSigner c -> (SlotNo, PBftVerKeyHash c)
toPair
    where
      toPair :: PBftSigner c -> (SlotNo, PBftVerKeyHash c)
toPair (PBftSigner{SlotNo
PBftVerKeyHash c
pbftSignerGenesisKey :: PBftVerKeyHash c
pbftSignerSlotNo :: SlotNo
pbftSignerSlotNo :: forall c. PBftSigner c -> SlotNo
pbftSignerGenesisKey :: forall c. PBftSigner c -> PBftVerKeyHash c
..}) = (SlotNo
pbftSignerSlotNo, PBftVerKeyHash c
pbftSignerGenesisKey)

  decode :: Decoder s (PBftSigner c)
decode = (SlotNo, PBftVerKeyHash c) -> PBftSigner c
forall c. (SlotNo, PBftVerKeyHash c) -> PBftSigner c
fromPair ((SlotNo, PBftVerKeyHash c) -> PBftSigner c)
-> Decoder s (SlotNo, PBftVerKeyHash c) -> Decoder s (PBftSigner c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (SlotNo, PBftVerKeyHash c)
forall a s. Serialise a => Decoder s a
decode
    where
      fromPair :: (SlotNo, PBftVerKeyHash c) -> PBftSigner c
fromPair (SlotNo
slotNo, PBftVerKeyHash c
genesisKey) = SlotNo -> PBftVerKeyHash c -> PBftSigner c
forall c. SlotNo -> PBftVerKeyHash c -> PBftSigner c
PBftSigner SlotNo
slotNo PBftVerKeyHash c
genesisKey