{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}

-- | What a consensus protocol says about the Leios announcement a header may
-- carry.
module Ouroboros.Consensus.Leios.Protocol
  ( LeiosAnnouncement (..)
  , decodeLeiosAnnouncement
  , encodeLeiosAnnouncement
  , LeiosLedgerView (..)
  , LeiosProtocol (..)
  , OCINStaleness (..)
  , defaultGetLeiosLedgerView
  , defaultValidateLeiosAnnouncement
  , defaultGetLeiosAnnouncement
  ) where

import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import Cardano.Ledger.BaseTypes (Milliseconds32, UnitInterval)
import Cardano.Ledger.Binary.Plain (decodeRecordNamed)
import Cardano.Ledger.Keys (KeyHash, KeyRole (BlockIssuer))
import Cardano.Ledger.State (LeiosCommittee)
import qualified Codec.CBOR.Decoding as CBOR
import qualified Codec.CBOR.Encoding as CBOR
import Control.Monad.Except (Except)
import qualified Data.Text as T
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block.Abstract (SlotNo)
import Ouroboros.Consensus.Leios.Types (BytesSize, EbHash, decodeEbHash, encodeEbHash)
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.Ticked (Ticked)

-- | The announcement a header carries, as its protocol view gives it.
data LeiosAnnouncement = MkLeiosAnnouncement
  { LeiosAnnouncement -> KeyHash BlockIssuer
announcementElectee :: !(KeyHash BlockIssuer)
  -- ^ the hash of the elected pool's cold verification key; with the header's
  -- slot, this identifies the election
  , LeiosAnnouncement -> EbHash
announcementEbHash :: !EbHash
  , LeiosAnnouncement -> BytesSize
announcementEbSize :: !BytesSize
  -- ^ the announced endorser block's size
  --
  -- TODO Nothing reads it yet. A certifying ranking block's ChainSync
  -- @MsgRollForward@ will be interpreted as an offer of the endorser block it
  -- certifies, of this size, and Leios voting will confirm that the size is
  -- accurate.
  }
  deriving stock (LeiosAnnouncement -> LeiosAnnouncement -> Bool
(LeiosAnnouncement -> LeiosAnnouncement -> Bool)
-> (LeiosAnnouncement -> LeiosAnnouncement -> Bool)
-> Eq LeiosAnnouncement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeiosAnnouncement -> LeiosAnnouncement -> Bool
== :: LeiosAnnouncement -> LeiosAnnouncement -> Bool
$c/= :: LeiosAnnouncement -> LeiosAnnouncement -> Bool
/= :: LeiosAnnouncement -> LeiosAnnouncement -> Bool
Eq, Int -> LeiosAnnouncement -> ShowS
[LeiosAnnouncement] -> ShowS
LeiosAnnouncement -> String
(Int -> LeiosAnnouncement -> ShowS)
-> (LeiosAnnouncement -> String)
-> ([LeiosAnnouncement] -> ShowS)
-> Show LeiosAnnouncement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeiosAnnouncement -> ShowS
showsPrec :: Int -> LeiosAnnouncement -> ShowS
$cshow :: LeiosAnnouncement -> String
show :: LeiosAnnouncement -> String
$cshowList :: [LeiosAnnouncement] -> ShowS
showList :: [LeiosAnnouncement] -> ShowS
Show, (forall x. LeiosAnnouncement -> Rep LeiosAnnouncement x)
-> (forall x. Rep LeiosAnnouncement x -> LeiosAnnouncement)
-> Generic LeiosAnnouncement
forall x. Rep LeiosAnnouncement x -> LeiosAnnouncement
forall x. LeiosAnnouncement -> Rep LeiosAnnouncement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LeiosAnnouncement -> Rep LeiosAnnouncement x
from :: forall x. LeiosAnnouncement -> Rep LeiosAnnouncement x
$cto :: forall x. Rep LeiosAnnouncement x -> LeiosAnnouncement
to :: forall x. Rep LeiosAnnouncement x -> LeiosAnnouncement
Generic)
  deriving anyclass Context -> LeiosAnnouncement -> IO (Maybe ThunkInfo)
Proxy LeiosAnnouncement -> String
(Context -> LeiosAnnouncement -> IO (Maybe ThunkInfo))
-> (Context -> LeiosAnnouncement -> IO (Maybe ThunkInfo))
-> (Proxy LeiosAnnouncement -> String)
-> NoThunks LeiosAnnouncement
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> LeiosAnnouncement -> IO (Maybe ThunkInfo)
noThunks :: Context -> LeiosAnnouncement -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LeiosAnnouncement -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LeiosAnnouncement -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy LeiosAnnouncement -> String
showTypeOf :: Proxy LeiosAnnouncement -> String
NoThunks

encodeLeiosAnnouncement :: LeiosAnnouncement -> CBOR.Encoding
encodeLeiosAnnouncement :: LeiosAnnouncement -> Encoding
encodeLeiosAnnouncement (MkLeiosAnnouncement KeyHash BlockIssuer
electee EbHash
ebHash BytesSize
ebSize) =
  Word -> Encoding
CBOR.encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash BlockIssuer -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash BlockIssuer
electee Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EbHash -> Encoding
encodeEbHash EbHash
ebHash Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> BytesSize -> Encoding
CBOR.encodeWord32 BytesSize
ebSize

decodeLeiosAnnouncement :: CBOR.Decoder s LeiosAnnouncement
decodeLeiosAnnouncement :: forall s. Decoder s LeiosAnnouncement
decodeLeiosAnnouncement =
  Text
-> (LeiosAnnouncement -> Int)
-> Decoder s LeiosAnnouncement
-> Decoder s LeiosAnnouncement
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed (String -> Text
T.pack String
"LeiosAnnouncement") (Int -> LeiosAnnouncement -> Int
forall a b. a -> b -> a
const Int
3) (Decoder s LeiosAnnouncement -> Decoder s LeiosAnnouncement)
-> Decoder s LeiosAnnouncement -> Decoder s LeiosAnnouncement
forall a b. (a -> b) -> a -> b
$
    KeyHash BlockIssuer -> EbHash -> BytesSize -> LeiosAnnouncement
MkLeiosAnnouncement (KeyHash BlockIssuer -> EbHash -> BytesSize -> LeiosAnnouncement)
-> Decoder s (KeyHash BlockIssuer)
-> Decoder s (EbHash -> BytesSize -> LeiosAnnouncement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (KeyHash BlockIssuer)
forall s. Decoder s (KeyHash BlockIssuer)
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (EbHash -> BytesSize -> LeiosAnnouncement)
-> Decoder s EbHash -> Decoder s (BytesSize -> LeiosAnnouncement)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s EbHash
forall s. Decoder s EbHash
decodeEbHash Decoder s (BytesSize -> LeiosAnnouncement)
-> Decoder s BytesSize -> Decoder s LeiosAnnouncement
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s BytesSize
forall s. Decoder s BytesSize
CBOR.decodeWord32

-- | The Leios parameters a ledger view carries.
--
-- The periods are durations, as the protocol parameters define them; they need
-- not be whole numbers of slots.
data LeiosLedgerView = MkLeiosLedgerView
  { LeiosLedgerView -> LeiosCommittee
llvCommittee :: !LeiosCommittee
  -- ^ who may vote this epoch, and with what weight
  , LeiosLedgerView -> UnitInterval
llvQuorumStakeThreshold :: !UnitInterval
  -- ^ the weight a certificate must accumulate
  , LeiosLedgerView -> Milliseconds32
llvAnnouncementPeriod :: !Milliseconds32
  -- ^ L_hdr, the announcement period
  , LeiosLedgerView -> Milliseconds32
llvVotePeriod :: !Milliseconds32
  -- ^ L_vote, the voting period
  , LeiosLedgerView -> Milliseconds32
llvDiffusionPeriod :: !Milliseconds32
  -- ^ L_diff, the diffusion period
  , LeiosLedgerView -> BytesSize
llvMaxEbBodySize :: !BytesSize
  -- ^ the largest endorser block the ledger admits, not counting its
  -- transactions
  , LeiosLedgerView -> BytesSize
llvMaxEbTxsSize :: !BytesSize
  -- ^ the largest total size of the transactions an endorser block references
  }
  deriving stock (LeiosLedgerView -> LeiosLedgerView -> Bool
(LeiosLedgerView -> LeiosLedgerView -> Bool)
-> (LeiosLedgerView -> LeiosLedgerView -> Bool)
-> Eq LeiosLedgerView
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LeiosLedgerView -> LeiosLedgerView -> Bool
== :: LeiosLedgerView -> LeiosLedgerView -> Bool
$c/= :: LeiosLedgerView -> LeiosLedgerView -> Bool
/= :: LeiosLedgerView -> LeiosLedgerView -> Bool
Eq, Int -> LeiosLedgerView -> ShowS
[LeiosLedgerView] -> ShowS
LeiosLedgerView -> String
(Int -> LeiosLedgerView -> ShowS)
-> (LeiosLedgerView -> String)
-> ([LeiosLedgerView] -> ShowS)
-> Show LeiosLedgerView
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeiosLedgerView -> ShowS
showsPrec :: Int -> LeiosLedgerView -> ShowS
$cshow :: LeiosLedgerView -> String
show :: LeiosLedgerView -> String
$cshowList :: [LeiosLedgerView] -> ShowS
showList :: [LeiosLedgerView] -> ShowS
Show, (forall x. LeiosLedgerView -> Rep LeiosLedgerView x)
-> (forall x. Rep LeiosLedgerView x -> LeiosLedgerView)
-> Generic LeiosLedgerView
forall x. Rep LeiosLedgerView x -> LeiosLedgerView
forall x. LeiosLedgerView -> Rep LeiosLedgerView x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LeiosLedgerView -> Rep LeiosLedgerView x
from :: forall x. LeiosLedgerView -> Rep LeiosLedgerView x
$cto :: forall x. Rep LeiosLedgerView x -> LeiosLedgerView
to :: forall x. Rep LeiosLedgerView x -> LeiosLedgerView
Generic)
  deriving anyclass Context -> LeiosLedgerView -> IO (Maybe ThunkInfo)
Proxy LeiosLedgerView -> String
(Context -> LeiosLedgerView -> IO (Maybe ThunkInfo))
-> (Context -> LeiosLedgerView -> IO (Maybe ThunkInfo))
-> (Proxy LeiosLedgerView -> String)
-> NoThunks LeiosLedgerView
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> LeiosLedgerView -> IO (Maybe ThunkInfo)
noThunks :: Context -> LeiosLedgerView -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LeiosLedgerView -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LeiosLedgerView -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy LeiosLedgerView -> String
showTypeOf :: Proxy LeiosLedgerView -> String
NoThunks

-- | Whether an announcement's operational certificate issue number (OCIN) is
-- at least the one our immutable tip records for its issuer.
--
-- A stale one is accepted from the peer but neither processed nor relayed; see
-- 'validateLeiosAnnouncement'.
data OCINStaleness = FreshOCIN | StaleOCIN
  deriving stock (OCINStaleness -> OCINStaleness -> Bool
(OCINStaleness -> OCINStaleness -> Bool)
-> (OCINStaleness -> OCINStaleness -> Bool) -> Eq OCINStaleness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OCINStaleness -> OCINStaleness -> Bool
== :: OCINStaleness -> OCINStaleness -> Bool
$c/= :: OCINStaleness -> OCINStaleness -> Bool
/= :: OCINStaleness -> OCINStaleness -> Bool
Eq, Int -> OCINStaleness -> ShowS
[OCINStaleness] -> ShowS
OCINStaleness -> String
(Int -> OCINStaleness -> ShowS)
-> (OCINStaleness -> String)
-> ([OCINStaleness] -> ShowS)
-> Show OCINStaleness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OCINStaleness -> ShowS
showsPrec :: Int -> OCINStaleness -> ShowS
$cshow :: OCINStaleness -> String
show :: OCINStaleness -> String
$cshowList :: [OCINStaleness] -> ShowS
showList :: [OCINStaleness] -> ShowS
Show)

class ConsensusProtocol p => LeiosProtocol p where
  -- | The announcement carried by the header with this view, if any.
  getLeiosAnnouncement :: proxy p -> ValidateView p -> Maybe LeiosAnnouncement

  -- | The protocol-level validation of a relayed announcement's header, done
  -- out of context: against the immutable tip's chain-dependent state ticked to
  -- the header's slot, rather than against the header's predecessor.
  --
  -- Since that state may lag, a check our lag could spuriously fail must not
  -- reject; a counter that is merely behind instead yields 'StaleOCIN'.
  --
  -- Only called for a view that carries an announcement.
  validateLeiosAnnouncement ::
    ConsensusConfig p ->
    ValidateView p ->
    SlotNo ->
    Ticked (ChainDepState p) ->
    Except (ValidationErr p) OCINStaleness

  -- | The Leios parameters this ledger view carries, or 'Nothing' if the
  -- protocol has no Leios.
  getLeiosLedgerView :: proxy p -> LedgerView p -> Maybe LeiosLedgerView

-- | 'getLeiosAnnouncement' for a protocol whose headers never carry an
-- announcement.
defaultGetLeiosAnnouncement :: proxy p -> ValidateView p -> Maybe LeiosAnnouncement
defaultGetLeiosAnnouncement :: forall (proxy :: * -> *) p.
proxy p -> ValidateView p -> Maybe LeiosAnnouncement
defaultGetLeiosAnnouncement proxy p
_proxy ValidateView p
_view = Maybe LeiosAnnouncement
forall a. Maybe a
Nothing

-- | 'validateLeiosAnnouncement' for a protocol whose headers never carry an
-- announcement, which is therefore never called.
defaultValidateLeiosAnnouncement ::
  ConsensusConfig p ->
  ValidateView p ->
  SlotNo ->
  Ticked (ChainDepState p) ->
  Except (ValidationErr p) OCINStaleness
defaultValidateLeiosAnnouncement :: forall p.
ConsensusConfig p
-> ValidateView p
-> SlotNo
-> Ticked (ChainDepState p)
-> Except (ValidationErr p) OCINStaleness
defaultValidateLeiosAnnouncement ConsensusConfig p
_cfg ValidateView p
_view SlotNo
_slot Ticked (ChainDepState p)
_st = OCINStaleness -> ExceptT (ValidationErr p) Identity OCINStaleness
forall a. a -> ExceptT (ValidationErr p) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OCINStaleness
FreshOCIN

-- | 'getLeiosLedgerView' for a protocol that has no Leios.
defaultGetLeiosLedgerView :: proxy p -> LedgerView p -> Maybe LeiosLedgerView
defaultGetLeiosLedgerView :: forall (proxy :: * -> *) p.
proxy p -> LedgerView p -> Maybe LeiosLedgerView
defaultGetLeiosLedgerView proxy p
_proxy LedgerView p
_view = Maybe LeiosLedgerView
forall a. Maybe a
Nothing