{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies               #-}

-- | Various things common to iterations of the Praos protocol.
module Ouroboros.Consensus.Protocol.Praos.Common (
    MaxMajorProtVer (..)
  , PraosCanBeLeader (..)
  , PraosChainSelectView (..)
    -- * node support
  , PraosNonces (..)
  , PraosProtocolSupportsNode (..)
  ) where

import qualified Cardano.Crypto.VRF as VRF
import           Cardano.Ledger.BaseTypes (Nonce)
import           Cardano.Ledger.Crypto (Crypto, VRF)
import           Cardano.Ledger.Keys (KeyHash, KeyRole (BlockIssuer))
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Protocol.TPraos.OCert as OCert
import           Cardano.Slotting.Block (BlockNo)
import           Cardano.Slotting.Slot (SlotNo)
import           Data.Function (on)
import           Data.Map.Strict (Map)
import           Data.Ord (Down (Down))
import           Data.Word (Word64)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)
import           Numeric.Natural (Natural)
import           Ouroboros.Consensus.Protocol.Abstract

-- | The maximum major protocol version.
--
-- Must be at least the current major protocol version. For Cardano mainnet, the
-- Shelley era has major protocol verison __2__.
newtype MaxMajorProtVer = MaxMajorProtVer
  { MaxMajorProtVer -> Natural
getMaxMajorProtVer :: Natural
  }
  deriving (MaxMajorProtVer -> MaxMajorProtVer -> Bool
(MaxMajorProtVer -> MaxMajorProtVer -> Bool)
-> (MaxMajorProtVer -> MaxMajorProtVer -> Bool)
-> Eq MaxMajorProtVer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaxMajorProtVer -> MaxMajorProtVer -> Bool
$c/= :: MaxMajorProtVer -> MaxMajorProtVer -> Bool
== :: MaxMajorProtVer -> MaxMajorProtVer -> Bool
$c== :: MaxMajorProtVer -> MaxMajorProtVer -> Bool
Eq, Int -> MaxMajorProtVer -> ShowS
[MaxMajorProtVer] -> ShowS
MaxMajorProtVer -> String
(Int -> MaxMajorProtVer -> ShowS)
-> (MaxMajorProtVer -> String)
-> ([MaxMajorProtVer] -> ShowS)
-> Show MaxMajorProtVer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaxMajorProtVer] -> ShowS
$cshowList :: [MaxMajorProtVer] -> ShowS
show :: MaxMajorProtVer -> String
$cshow :: MaxMajorProtVer -> String
showsPrec :: Int -> MaxMajorProtVer -> ShowS
$cshowsPrec :: Int -> MaxMajorProtVer -> ShowS
Show, (forall x. MaxMajorProtVer -> Rep MaxMajorProtVer x)
-> (forall x. Rep MaxMajorProtVer x -> MaxMajorProtVer)
-> Generic MaxMajorProtVer
forall x. Rep MaxMajorProtVer x -> MaxMajorProtVer
forall x. MaxMajorProtVer -> Rep MaxMajorProtVer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MaxMajorProtVer x -> MaxMajorProtVer
$cfrom :: forall x. MaxMajorProtVer -> Rep MaxMajorProtVer x
Generic)
  deriving newtype Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
Proxy MaxMajorProtVer -> String
(Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo))
-> (Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo))
-> (Proxy MaxMajorProtVer -> String)
-> NoThunks MaxMajorProtVer
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy MaxMajorProtVer -> String
$cshowTypeOf :: Proxy MaxMajorProtVer -> String
wNoThunks :: Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
noThunks :: Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
NoThunks

-- | View of the ledger tip for chain selection.
--
-- We order between chains as follows:
--
-- 1. By chain length, with longer chains always preferred.
-- 2. If the tip of each chain was issued by the same agent, then we prefer
--    the chain whose tip has the highest ocert issue number.
-- 3. By the leader value of the chain tip, with lower values preferred.
data PraosChainSelectView c = PraosChainSelectView
  { PraosChainSelectView c -> BlockNo
csvChainLength :: BlockNo,
    PraosChainSelectView c -> SlotNo
csvSlotNo      :: SlotNo,
    PraosChainSelectView c -> VKey 'BlockIssuer c
csvIssuer      :: SL.VKey 'SL.BlockIssuer c,
    PraosChainSelectView c -> Word64
csvIssueNo     :: Word64,
    PraosChainSelectView c -> OutputVRF (VRF c)
csvLeaderVRF   :: VRF.OutputVRF (VRF c)
  }
  deriving (Int -> PraosChainSelectView c -> ShowS
[PraosChainSelectView c] -> ShowS
PraosChainSelectView c -> String
(Int -> PraosChainSelectView c -> ShowS)
-> (PraosChainSelectView c -> String)
-> ([PraosChainSelectView c] -> ShowS)
-> Show (PraosChainSelectView c)
forall c. Crypto c => Int -> PraosChainSelectView c -> ShowS
forall c. Crypto c => [PraosChainSelectView c] -> ShowS
forall c. Crypto c => PraosChainSelectView c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PraosChainSelectView c] -> ShowS
$cshowList :: forall c. Crypto c => [PraosChainSelectView c] -> ShowS
show :: PraosChainSelectView c -> String
$cshow :: forall c. Crypto c => PraosChainSelectView c -> String
showsPrec :: Int -> PraosChainSelectView c -> ShowS
$cshowsPrec :: forall c. Crypto c => Int -> PraosChainSelectView c -> ShowS
Show, PraosChainSelectView c -> PraosChainSelectView c -> Bool
(PraosChainSelectView c -> PraosChainSelectView c -> Bool)
-> (PraosChainSelectView c -> PraosChainSelectView c -> Bool)
-> Eq (PraosChainSelectView c)
forall c.
Crypto c =>
PraosChainSelectView c -> PraosChainSelectView c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PraosChainSelectView c -> PraosChainSelectView c -> Bool
$c/= :: forall c.
Crypto c =>
PraosChainSelectView c -> PraosChainSelectView c -> Bool
== :: PraosChainSelectView c -> PraosChainSelectView c -> Bool
$c== :: forall c.
Crypto c =>
PraosChainSelectView c -> PraosChainSelectView c -> Bool
Eq, (forall x.
 PraosChainSelectView c -> Rep (PraosChainSelectView c) x)
-> (forall x.
    Rep (PraosChainSelectView c) x -> PraosChainSelectView c)
-> Generic (PraosChainSelectView c)
forall x. Rep (PraosChainSelectView c) x -> PraosChainSelectView c
forall x. PraosChainSelectView c -> Rep (PraosChainSelectView c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x.
Rep (PraosChainSelectView c) x -> PraosChainSelectView c
forall c x.
PraosChainSelectView c -> Rep (PraosChainSelectView c) x
$cto :: forall c x.
Rep (PraosChainSelectView c) x -> PraosChainSelectView c
$cfrom :: forall c x.
PraosChainSelectView c -> Rep (PraosChainSelectView c) x
Generic, Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo)
Proxy (PraosChainSelectView c) -> String
(Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo))
-> (Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo))
-> (Proxy (PraosChainSelectView c) -> String)
-> NoThunks (PraosChainSelectView c)
forall c.
Crypto c =>
Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo)
forall c. Crypto c => Proxy (PraosChainSelectView c) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (PraosChainSelectView c) -> String
$cshowTypeOf :: forall c. Crypto c => Proxy (PraosChainSelectView c) -> String
wNoThunks :: Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c.
Crypto c =>
Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo)
noThunks :: Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo)
$cnoThunks :: forall c.
Crypto c =>
Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo)
NoThunks)

instance Crypto c => Ord (PraosChainSelectView c) where
  compare :: PraosChainSelectView c -> PraosChainSelectView c -> Ordering
compare =
    [PraosChainSelectView c -> PraosChainSelectView c -> Ordering]
-> PraosChainSelectView c -> PraosChainSelectView c -> Ordering
forall a. Monoid a => [a] -> a
mconcat
      [ BlockNo -> BlockNo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (BlockNo -> BlockNo -> Ordering)
-> (PraosChainSelectView c -> BlockNo)
-> PraosChainSelectView c
-> PraosChainSelectView c
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` PraosChainSelectView c -> BlockNo
forall c. PraosChainSelectView c -> BlockNo
csvChainLength,
        (PraosChainSelectView c -> VKey 'BlockIssuer c)
-> (PraosChainSelectView c -> PraosChainSelectView c -> Ordering)
-> PraosChainSelectView c
-> PraosChainSelectView c
-> Ordering
forall a view.
Eq a =>
(view -> a)
-> (view -> view -> Ordering) -> view -> view -> Ordering
whenSame PraosChainSelectView c -> VKey 'BlockIssuer c
forall c. PraosChainSelectView c -> VKey 'BlockIssuer c
csvIssuer (Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word64 -> Word64 -> Ordering)
-> (PraosChainSelectView c -> Word64)
-> PraosChainSelectView c
-> PraosChainSelectView c
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` PraosChainSelectView c -> Word64
forall c. PraosChainSelectView c -> Word64
csvIssueNo),
        Down (OutputVRF (VRF c)) -> Down (OutputVRF (VRF c)) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Down (OutputVRF (VRF c)) -> Down (OutputVRF (VRF c)) -> Ordering)
-> (PraosChainSelectView c -> Down (OutputVRF (VRF c)))
-> PraosChainSelectView c
-> PraosChainSelectView c
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` OutputVRF (VRF c) -> Down (OutputVRF (VRF c))
forall a. a -> Down a
Down (OutputVRF (VRF c) -> Down (OutputVRF (VRF c)))
-> (PraosChainSelectView c -> OutputVRF (VRF c))
-> PraosChainSelectView c
-> Down (OutputVRF (VRF c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PraosChainSelectView c -> OutputVRF (VRF c)
forall c. PraosChainSelectView c -> OutputVRF (VRF c)
csvLeaderVRF
      ]
    where
      -- When the @a@s are equal, use the given comparison function,
      -- otherwise, no preference.
      whenSame ::
        Eq a =>
        (view -> a) ->
        (view -> view -> Ordering) ->
        (view -> view -> Ordering)
      whenSame :: (view -> a)
-> (view -> view -> Ordering) -> view -> view -> Ordering
whenSame view -> a
f view -> view -> Ordering
comp view
v1 view
v2
        | view -> a
f view
v1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== view -> a
f view
v2 =
            view -> view -> Ordering
comp view
v1 view
v2
        | Bool
otherwise =
            Ordering
EQ

data PraosCanBeLeader c = PraosCanBeLeader
  { -- | Certificate delegating rights from the stake pool cold key (or
    -- genesis stakeholder delegate cold key) to the online KES key.
    PraosCanBeLeader c -> OCert c
praosCanBeLeaderOpCert     :: !(OCert.OCert c),
    -- | Stake pool cold key or genesis stakeholder delegate cold key.
    PraosCanBeLeader c -> VKey 'BlockIssuer c
praosCanBeLeaderColdVerKey :: !(SL.VKey 'SL.BlockIssuer c),
    PraosCanBeLeader c -> SignKeyVRF c
praosCanBeLeaderSignKeyVRF :: !(SL.SignKeyVRF c)
  }
  deriving ((forall x. PraosCanBeLeader c -> Rep (PraosCanBeLeader c) x)
-> (forall x. Rep (PraosCanBeLeader c) x -> PraosCanBeLeader c)
-> Generic (PraosCanBeLeader c)
forall x. Rep (PraosCanBeLeader c) x -> PraosCanBeLeader c
forall x. PraosCanBeLeader c -> Rep (PraosCanBeLeader c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (PraosCanBeLeader c) x -> PraosCanBeLeader c
forall c x. PraosCanBeLeader c -> Rep (PraosCanBeLeader c) x
$cto :: forall c x. Rep (PraosCanBeLeader c) x -> PraosCanBeLeader c
$cfrom :: forall c x. PraosCanBeLeader c -> Rep (PraosCanBeLeader c) x
Generic)

instance Crypto c => NoThunks (PraosCanBeLeader c)

-- | See 'PraosProtocolSupportsNode'
data PraosNonces = PraosNonces {
    PraosNonces -> Nonce
candidateNonce   :: !Nonce
  , PraosNonces -> Nonce
epochNonce       :: !Nonce
  , PraosNonces -> Nonce
evolvingNonce    :: !Nonce
    -- | Nonce constructed from the hash of the Last Applied Block
  , PraosNonces -> Nonce
labNonce         :: !Nonce
    -- | Nonce corresponding to the LAB nonce of the last block of the previous
    -- epoch
  , PraosNonces -> Nonce
previousLabNonce :: !Nonce
  }

-- | The node has Praos-aware code that inspects nonces in order to support
-- some Cardano API queries that are crucial to the user exprience
--
-- The interface being used for that has grown and needs review, but we're
-- adding to it here under time pressure. See
-- <https://github.com/input-output-hk/cardano-node/issues/3864>
class ConsensusProtocol p => PraosProtocolSupportsNode p where
  type PraosProtocolSupportsNodeCrypto p

  getPraosNonces :: proxy p -> ChainDepState p -> PraosNonces

  getOpCertCounters :: proxy p -> ChainDepState p -> Map (KeyHash 'BlockIssuer (PraosProtocolSupportsNodeCrypto p)) Word64