{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators       #-}

module Ouroboros.Consensus.Cardano (
    -- * The block type of the Cardano block chain
    CardanoBlock
    -- * Supported protocols
  , ProtocolByron
  , ProtocolShelley
  , ProtocolCardano
    -- * Abstract over the various protocols
  , ProtocolParamsByron(..)
  , ProtocolParamsShelley(..)
  , ProtocolParamsAllegra(..)
  , ProtocolParamsMary(..)
  , ProtocolParamsTransition(..)
  , Protocol(..)
  , verifyProtocol
    -- * Data required to run a protocol
  , protocolInfo
    -- * Evidence that we can run all the supported protocols
  , runProtocol
  , module X

    -- * Client support for nodes running a protocol
  , ProtocolClient(..)
  , protocolClientInfo
  , runProtocolClient
  , verifyProtocolClient
  ) where

import           Data.Kind (Type)
import           Data.Type.Equality

import           Cardano.Chain.Slotting (EpochSlots)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Node.ProtocolInfo
import           Ouroboros.Consensus.Node.Run
import           Ouroboros.Consensus.Protocol.Abstract as X
import           Ouroboros.Consensus.Protocol.PBFT as X
import           Ouroboros.Consensus.Util
import           Ouroboros.Consensus.Util.IOLike

import           Ouroboros.Consensus.HardFork.Combinator
import           Ouroboros.Consensus.HardFork.Combinator.Unary

import           Ouroboros.Consensus.Byron.Ledger
import           Ouroboros.Consensus.Byron.Node as X

import           Ouroboros.Consensus.Shelley.Ledger
import           Ouroboros.Consensus.Shelley.Node as X

import           Ouroboros.Consensus.Cardano.Block
import           Ouroboros.Consensus.Cardano.ByronHFC
import           Ouroboros.Consensus.Cardano.Node
import           Ouroboros.Consensus.Cardano.ShelleyHFC

{-------------------------------------------------------------------------------
  Supported protocols

  We list these as explicit definitions here (rather than derived through
  'BlockProtocol'), and then /verify/ in 'verifyProtocol' that these definitions
  match. This provides an additional sanity check that we are not accidentally
  breaking any assumptions made in @cardano-node@.
-------------------------------------------------------------------------------}

type ProtocolByron   = HardForkProtocol '[ ByronBlock ]
type ProtocolShelley = HardForkProtocol '[ ShelleyBlock StandardShelley ]
type ProtocolCardano = HardForkProtocol '[ ByronBlock
                                         , ShelleyBlock StandardShelley
                                         , ShelleyBlock StandardAllegra
                                         , ShelleyBlock StandardMary
                                         ]

{-------------------------------------------------------------------------------
  Abstract over the various protocols
-------------------------------------------------------------------------------}

-- | Consensus protocol to use
data Protocol (m :: Type -> Type) blk p where
  -- | Run PBFT against the real Byron ledger
  ProtocolByron
    :: ProtocolParamsByron
    -> Protocol m ByronBlockHFC ProtocolByron

  -- | Run TPraos against the real Shelley ledger
  ProtocolShelley
    :: ProtocolParamsShelley StandardCrypto []
    -> Protocol m (ShelleyBlockHFC StandardShelley) ProtocolShelley

  -- | Run the protocols of /the/ Cardano block
  ProtocolCardano
    :: ProtocolParamsByron
    -> ProtocolParamsShelley StandardCrypto Maybe
    -> ProtocolParamsAllegra StandardCrypto Maybe
    -> ProtocolParamsMary    StandardCrypto Maybe
    -> ProtocolParamsTransition
         ByronBlock
         (ShelleyBlock StandardShelley)
    -> ProtocolParamsTransition
         (ShelleyBlock StandardShelley)
         (ShelleyBlock StandardAllegra)
    -> ProtocolParamsTransition
         (ShelleyBlock StandardAllegra)
         (ShelleyBlock StandardMary)
    -> Protocol m (CardanoBlock StandardCrypto) ProtocolCardano

verifyProtocol :: Protocol m blk p -> (p :~: BlockProtocol blk)
verifyProtocol :: Protocol m blk p -> p :~: BlockProtocol blk
verifyProtocol ProtocolByron{}   = p :~: BlockProtocol blk
forall k (a :: k). a :~: a
Refl
verifyProtocol ProtocolShelley{} = p :~: BlockProtocol blk
forall k (a :: k). a :~: a
Refl
verifyProtocol ProtocolCardano{} = p :~: BlockProtocol blk
forall k (a :: k). a :~: a
Refl

{-------------------------------------------------------------------------------
  Data required to run a protocol
-------------------------------------------------------------------------------}

-- | Data required to run the selected protocol
protocolInfo :: forall m blk p. IOLike m
             => Protocol m blk p -> ProtocolInfo m blk
protocolInfo :: Protocol m blk p -> ProtocolInfo m blk
protocolInfo (ProtocolByron ProtocolParamsByron
params) =
    ProtocolInfo m ByronBlock
-> ProtocolInfo m (HardForkBlock '[ByronBlock])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject (ProtocolInfo m ByronBlock
 -> ProtocolInfo m (HardForkBlock '[ByronBlock]))
-> ProtocolInfo m ByronBlock
-> ProtocolInfo m (HardForkBlock '[ByronBlock])
forall a b. (a -> b) -> a -> b
$ ProtocolParamsByron -> ProtocolInfo m ByronBlock
forall (m :: * -> *).
Monad m =>
ProtocolParamsByron -> ProtocolInfo m ByronBlock
protocolInfoByron ProtocolParamsByron
params

protocolInfo (ProtocolShelley ProtocolParamsShelley StandardCrypto []
params) =
    ProtocolInfo m (ShelleyBlock (ShelleyEra StandardCrypto))
-> ProtocolInfo
     m (HardForkBlock '[ShelleyBlock (ShelleyEra StandardCrypto)])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject (ProtocolInfo m (ShelleyBlock (ShelleyEra StandardCrypto))
 -> ProtocolInfo
      m (HardForkBlock '[ShelleyBlock (ShelleyEra StandardCrypto)]))
-> ProtocolInfo m (ShelleyBlock (ShelleyEra StandardCrypto))
-> ProtocolInfo
     m (HardForkBlock '[ShelleyBlock (ShelleyEra StandardCrypto)])
forall a b. (a -> b) -> a -> b
$ ProtocolParamsShelley StandardCrypto []
-> ProtocolInfo m (ShelleyBlock (ShelleyEra StandardCrypto))
forall (m :: * -> *) c (f :: * -> *).
(IOLike m, ShelleyBasedEra (ShelleyEra c), Foldable f) =>
ProtocolParamsShelley c f
-> ProtocolInfo m (ShelleyBlock (ShelleyEra c))
protocolInfoShelley ProtocolParamsShelley StandardCrypto []
params

protocolInfo (ProtocolCardano
               ProtocolParamsByron
paramsByron
               ProtocolParamsShelley StandardCrypto Maybe
paramsShelley
               ProtocolParamsAllegra StandardCrypto Maybe
paramsAllegra
               ProtocolParamsMary StandardCrypto Maybe
paramsMary
               ProtocolParamsTransition
  ByronBlock (ShelleyBlock (ShelleyEra StandardCrypto))
paramsByronShelley
               ProtocolParamsTransition
  (ShelleyBlock (ShelleyEra StandardCrypto))
  (ShelleyBlock (ShelleyEra StandardCrypto))
paramsShelleyAllegra
               ProtocolParamsTransition
  (ShelleyBlock (ShelleyEra StandardCrypto))
  (ShelleyBlock (ShelleyEra StandardCrypto))
paramsAllegraMary) =
    ProtocolParamsByron
-> ProtocolParamsShelley StandardCrypto Maybe
-> ProtocolParamsAllegra StandardCrypto Maybe
-> ProtocolParamsMary StandardCrypto Maybe
-> ProtocolParamsTransition
     ByronBlock (ShelleyBlock (ShelleyEra StandardCrypto))
-> ProtocolParamsTransition
     (ShelleyBlock (ShelleyEra StandardCrypto))
     (ShelleyBlock (ShelleyEra StandardCrypto))
-> ProtocolParamsTransition
     (ShelleyBlock (ShelleyEra StandardCrypto))
     (ShelleyBlock (ShelleyEra StandardCrypto))
-> ProtocolInfo m (CardanoBlock StandardCrypto)
forall c (m :: * -> *).
(IOLike m, CardanoHardForkConstraints c) =>
ProtocolParamsByron
-> ProtocolParamsShelley c Maybe
-> ProtocolParamsAllegra c Maybe
-> ProtocolParamsMary c Maybe
-> ProtocolParamsTransition
     ByronBlock (ShelleyBlock (ShelleyEra c))
-> ProtocolParamsTransition
     (ShelleyBlock (ShelleyEra c)) (ShelleyBlock (ShelleyEra c))
-> ProtocolParamsTransition
     (ShelleyBlock (ShelleyEra c)) (ShelleyBlock (ShelleyEra c))
-> ProtocolInfo m (CardanoBlock c)
protocolInfoCardano
      ProtocolParamsByron
paramsByron
      ProtocolParamsShelley StandardCrypto Maybe
paramsShelley
      ProtocolParamsAllegra StandardCrypto Maybe
paramsAllegra
      ProtocolParamsMary StandardCrypto Maybe
paramsMary
      ProtocolParamsTransition
  ByronBlock (ShelleyBlock (ShelleyEra StandardCrypto))
paramsByronShelley
      ProtocolParamsTransition
  (ShelleyBlock (ShelleyEra StandardCrypto))
  (ShelleyBlock (ShelleyEra StandardCrypto))
paramsShelleyAllegra
      ProtocolParamsTransition
  (ShelleyBlock (ShelleyEra StandardCrypto))
  (ShelleyBlock (ShelleyEra StandardCrypto))
paramsAllegraMary

{-------------------------------------------------------------------------------
  Evidence that we can run all the supported protocols
-------------------------------------------------------------------------------}

runProtocol :: Protocol m blk p -> Dict (RunNode blk)
runProtocol :: Protocol m blk p -> Dict (RunNode blk)
runProtocol ProtocolByron{}   = Dict (RunNode blk)
forall (a :: Constraint). a => Dict a
Dict
runProtocol ProtocolShelley{} = Dict (RunNode blk)
forall (a :: Constraint). a => Dict a
Dict
runProtocol ProtocolCardano{} = Dict (RunNode blk)
forall (a :: Constraint). a => Dict a
Dict

{-------------------------------------------------------------------------------
  Client support for the protocols: what you need as a client of the node
-------------------------------------------------------------------------------}

-- | Node client support for each consensus protocol.
--
-- This is like 'Protocol' but for clients of the node, so with less onerous
-- requirements than to run a node.
--
data ProtocolClient blk p where
  ProtocolClientByron
    :: EpochSlots
    -> ProtocolClient
         ByronBlockHFC
         ProtocolByron

  ProtocolClientShelley
    :: ProtocolClient
         (ShelleyBlockHFC StandardShelley)
         ProtocolShelley

  ProtocolClientCardano
    :: EpochSlots
    -> ProtocolClient
         (CardanoBlock StandardCrypto)
         ProtocolCardano

-- | Sanity check that we have the right type combinations
verifyProtocolClient :: ProtocolClient blk p -> (p :~: BlockProtocol blk)
verifyProtocolClient :: ProtocolClient blk p -> p :~: BlockProtocol blk
verifyProtocolClient ProtocolClientByron{}   = p :~: BlockProtocol blk
forall k (a :: k). a :~: a
Refl
verifyProtocolClient ProtocolClientShelley{} = p :~: BlockProtocol blk
forall k (a :: k). a :~: a
Refl
verifyProtocolClient ProtocolClientCardano{} = p :~: BlockProtocol blk
forall k (a :: k). a :~: a
Refl

-- | Sanity check that we have the right class instances available
runProtocolClient :: ProtocolClient blk p -> Dict (RunNode blk)
runProtocolClient :: ProtocolClient blk p -> Dict (RunNode blk)
runProtocolClient ProtocolClientByron{}   = Dict (RunNode blk)
forall (a :: Constraint). a => Dict a
Dict
runProtocolClient ProtocolClientShelley{} = Dict (RunNode blk)
forall (a :: Constraint). a => Dict a
Dict
runProtocolClient ProtocolClientCardano{} = Dict (RunNode blk)
forall (a :: Constraint). a => Dict a
Dict

-- | Data required by clients of a node running the specified protocol.
protocolClientInfo :: ProtocolClient blk p -> ProtocolClientInfo blk
protocolClientInfo :: ProtocolClient blk p -> ProtocolClientInfo blk
protocolClientInfo (ProtocolClientByron EpochSlots
epochSlots) =
    ProtocolClientInfo ByronBlock
-> ProtocolClientInfo (HardForkBlock '[ByronBlock])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject (ProtocolClientInfo ByronBlock
 -> ProtocolClientInfo (HardForkBlock '[ByronBlock]))
-> ProtocolClientInfo ByronBlock
-> ProtocolClientInfo (HardForkBlock '[ByronBlock])
forall a b. (a -> b) -> a -> b
$ EpochSlots -> ProtocolClientInfo ByronBlock
protocolClientInfoByron EpochSlots
epochSlots

protocolClientInfo ProtocolClient blk p
ProtocolClientShelley =
    ProtocolClientInfo (ShelleyBlock (ShelleyEra StandardCrypto))
-> ProtocolClientInfo
     (HardForkBlock '[ShelleyBlock (ShelleyEra StandardCrypto)])
forall (f :: * -> *) blk.
(Isomorphic f, NoHardForks blk) =>
f blk -> f (HardForkBlock '[blk])
inject (ProtocolClientInfo (ShelleyBlock (ShelleyEra StandardCrypto))
 -> ProtocolClientInfo
      (HardForkBlock '[ShelleyBlock (ShelleyEra StandardCrypto)]))
-> ProtocolClientInfo (ShelleyBlock (ShelleyEra StandardCrypto))
-> ProtocolClientInfo
     (HardForkBlock '[ShelleyBlock (ShelleyEra StandardCrypto)])
forall a b. (a -> b) -> a -> b
$ ProtocolClientInfo (ShelleyBlock (ShelleyEra StandardCrypto))
forall era. ProtocolClientInfo (ShelleyBlock era)
protocolClientInfoShelley

protocolClientInfo (ProtocolClientCardano EpochSlots
epochSlots) =
    EpochSlots -> ProtocolClientInfo (CardanoBlock StandardCrypto)
forall c. EpochSlots -> ProtocolClientInfo (CardanoBlock c)
protocolClientInfoCardano EpochSlots
epochSlots