{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}

{-# OPTIONS_GHC -Wno-orphans #-}
-- | Instances required to support PBFT
module Ouroboros.Consensus.Byron.Ledger.PBFT (
    decodeByronChainDepState
  , encodeByronChainDepState
  , fromPBftLedgerView
  , mkByronContextDSIGN
  , toPBftLedgerView
  , toTickedPBftLedgerView
  ) where

import           Codec.CBOR.Decoding (Decoder)
import           Codec.CBOR.Encoding (Encoding)
import           Data.ByteString (ByteString)

import           Cardano.Binary (Annotated)
import           Cardano.Crypto.DSIGN

import qualified Cardano.Chain.Block as CC
import qualified Cardano.Chain.Delegation as Delegation

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Protocol.Abstract
import           Ouroboros.Consensus.Protocol.PBFT
import qualified Ouroboros.Consensus.Protocol.PBFT.State as S

import           Ouroboros.Consensus.Byron.Crypto.DSIGN
import           Ouroboros.Consensus.Byron.Ledger.Block
import           Ouroboros.Consensus.Byron.Ledger.Config
import           Ouroboros.Consensus.Byron.Ledger.Serialisation ()
import           Ouroboros.Consensus.Byron.Protocol

type instance BlockProtocol ByronBlock = PBft PBftByronCrypto

-- | Construct DSIGN required for Byron crypto
mkByronContextDSIGN :: BlockConfig  ByronBlock
                    -> VerKeyDSIGN  ByronDSIGN
                    -> ContextDSIGN ByronDSIGN
mkByronContextDSIGN :: BlockConfig ByronBlock
-> VerKeyDSIGN ByronDSIGN -> ContextDSIGN ByronDSIGN
mkByronContextDSIGN = (,) (ProtocolMagicId
 -> VerKeyDSIGN ByronDSIGN
 -> (ProtocolMagicId, VerKeyDSIGN ByronDSIGN))
-> (BlockConfig ByronBlock -> ProtocolMagicId)
-> BlockConfig ByronBlock
-> VerKeyDSIGN ByronDSIGN
-> (ProtocolMagicId, VerKeyDSIGN ByronDSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig ByronBlock -> ProtocolMagicId
byronProtocolMagicId

instance BlockSupportsProtocol ByronBlock where
  validateView :: BlockConfig ByronBlock
-> Header ByronBlock -> ValidateView (BlockProtocol ByronBlock)
validateView BlockConfig ByronBlock
cfg hdr :: Header ByronBlock
hdr@ByronHeader{..} =
      case ABlockOrBoundaryHdr ByteString
byronHeaderRaw of
        CC.ABOBBoundaryHdr ABoundaryHeader ByteString
_    -> Header ByronBlock -> PBftValidateView PBftByronCrypto
forall hdr c. hdr -> PBftValidateView c
pbftValidateBoundary Header ByronBlock
hdr
        CC.ABOBBlockHdr AHeader ByteString
regular ->
          let pbftFields :: PBftFields PBftByronCrypto
                                       (Annotated CC.ToSign ByteString)
              pbftFields :: PBftFields PBftByronCrypto (Annotated ToSign ByteString)
pbftFields = PBftFields :: forall c toSign.
VerKeyDSIGN (PBftDSIGN c)
-> VerKeyDSIGN (PBftDSIGN c)
-> SignedDSIGN (PBftDSIGN c) toSign
-> PBftFields c toSign
PBftFields {
                  pbftIssuer :: VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
pbftIssuer    = VerificationKey -> VerKeyDSIGN ByronDSIGN
VerKeyByronDSIGN
                                (VerificationKey -> VerKeyDSIGN ByronDSIGN)
-> (AHeader ByteString -> VerificationKey)
-> AHeader ByteString
-> VerKeyDSIGN ByronDSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ACertificate ByteString -> VerificationKey
forall a. ACertificate a -> VerificationKey
Delegation.delegateVK
                                (ACertificate ByteString -> VerificationKey)
-> (AHeader ByteString -> ACertificate ByteString)
-> AHeader ByteString
-> VerificationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABlockSignature ByteString -> ACertificate ByteString
forall a. ABlockSignature a -> ACertificate a
CC.delegationCertificate
                                (ABlockSignature ByteString -> ACertificate ByteString)
-> (AHeader ByteString -> ABlockSignature ByteString)
-> AHeader ByteString
-> ACertificate ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AHeader ByteString -> ABlockSignature ByteString
forall a. AHeader a -> ABlockSignature a
CC.headerSignature
                                (AHeader ByteString -> VerKeyDSIGN ByronDSIGN)
-> AHeader ByteString -> VerKeyDSIGN ByronDSIGN
forall a b. (a -> b) -> a -> b
$ AHeader ByteString
regular
                , pbftGenKey :: VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
pbftGenKey    = VerificationKey -> VerKeyDSIGN ByronDSIGN
VerKeyByronDSIGN
                                (VerificationKey -> VerKeyDSIGN ByronDSIGN)
-> (AHeader ByteString -> VerificationKey)
-> AHeader ByteString
-> VerKeyDSIGN ByronDSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AHeader ByteString -> VerificationKey
forall a. AHeader a -> VerificationKey
CC.headerGenesisKey
                                (AHeader ByteString -> VerKeyDSIGN ByronDSIGN)
-> AHeader ByteString -> VerKeyDSIGN ByronDSIGN
forall a b. (a -> b) -> a -> b
$ AHeader ByteString
regular
                , pbftSignature :: SignedDSIGN
  (PBftDSIGN PBftByronCrypto) (Annotated ToSign ByteString)
pbftSignature = SigDSIGN ByronDSIGN
-> SignedDSIGN ByronDSIGN (Annotated ToSign ByteString)
forall v a. SigDSIGN v -> SignedDSIGN v a
SignedDSIGN
                                (SigDSIGN ByronDSIGN
 -> SignedDSIGN ByronDSIGN (Annotated ToSign ByteString))
-> (AHeader ByteString -> SigDSIGN ByronDSIGN)
-> AHeader ByteString
-> SignedDSIGN ByronDSIGN (Annotated ToSign ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature ToSign -> SigDSIGN ByronDSIGN
SigByronDSIGN
                                (Signature ToSign -> SigDSIGN ByronDSIGN)
-> (AHeader ByteString -> Signature ToSign)
-> AHeader ByteString
-> SigDSIGN ByronDSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ABlockSignature ByteString -> Signature ToSign
forall a. ABlockSignature a -> Signature ToSign
CC.signature
                                (ABlockSignature ByteString -> Signature ToSign)
-> (AHeader ByteString -> ABlockSignature ByteString)
-> AHeader ByteString
-> Signature ToSign
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AHeader ByteString -> ABlockSignature ByteString
forall a. AHeader a -> ABlockSignature a
CC.headerSignature
                                (AHeader ByteString
 -> SignedDSIGN ByronDSIGN (Annotated ToSign ByteString))
-> AHeader ByteString
-> SignedDSIGN ByronDSIGN (Annotated ToSign ByteString)
forall a b. (a -> b) -> a -> b
$ AHeader ByteString
regular
                }

          in PBftFields PBftByronCrypto (Annotated ToSign ByteString)
-> Annotated ToSign ByteString
-> ContextDSIGN (PBftDSIGN PBftByronCrypto)
-> PBftValidateView PBftByronCrypto
forall c signed.
Signable (PBftDSIGN c) signed =>
PBftFields c signed
-> signed -> ContextDSIGN (PBftDSIGN c) -> PBftValidateView c
PBftValidateRegular
               PBftFields PBftByronCrypto (Annotated ToSign ByteString)
pbftFields
               (EpochSlots -> AHeader ByteString -> Annotated ToSign ByteString
CC.recoverSignedBytes EpochSlots
epochSlots AHeader ByteString
regular)
               (BlockConfig ByronBlock
-> VerKeyDSIGN ByronDSIGN -> ContextDSIGN ByronDSIGN
mkByronContextDSIGN BlockConfig ByronBlock
cfg (PBftFields PBftByronCrypto (Annotated ToSign ByteString)
-> VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
forall c toSign. PBftFields c toSign -> VerKeyDSIGN (PBftDSIGN c)
pbftGenKey PBftFields PBftByronCrypto (Annotated ToSign ByteString)
pbftFields))
    where
      epochSlots :: EpochSlots
epochSlots = BlockConfig ByronBlock -> EpochSlots
byronEpochSlots BlockConfig ByronBlock
cfg

  selectView :: BlockConfig ByronBlock
-> Header ByronBlock -> SelectView (BlockProtocol ByronBlock)
selectView BlockConfig ByronBlock
_ = Header ByronBlock -> SelectView (BlockProtocol ByronBlock)
forall blk. GetHeader blk => Header blk -> PBftSelectView
mkPBftSelectView

toPBftLedgerView :: Delegation.Map -> PBftLedgerView PBftByronCrypto
toPBftLedgerView :: Map -> PBftLedgerView PBftByronCrypto
toPBftLedgerView = Bimap KeyHash KeyHash -> PBftLedgerView PBftByronCrypto
forall c.
Bimap (PBftVerKeyHash c) (PBftVerKeyHash c) -> PBftLedgerView c
PBftLedgerView (Bimap KeyHash KeyHash -> PBftLedgerView PBftByronCrypto)
-> (Map -> Bimap KeyHash KeyHash)
-> Map
-> PBftLedgerView PBftByronCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map -> Bimap KeyHash KeyHash
Delegation.unMap

toTickedPBftLedgerView :: Delegation.Map -> Ticked (PBftLedgerView PBftByronCrypto)
toTickedPBftLedgerView :: Map -> Ticked (PBftLedgerView PBftByronCrypto)
toTickedPBftLedgerView = Bimap KeyHash KeyHash -> Ticked (PBftLedgerView PBftByronCrypto)
forall c.
Bimap (PBftVerKeyHash c) (PBftVerKeyHash c)
-> Ticked (PBftLedgerView c)
TickedPBftLedgerView (Bimap KeyHash KeyHash -> Ticked (PBftLedgerView PBftByronCrypto))
-> (Map -> Bimap KeyHash KeyHash)
-> Map
-> Ticked (PBftLedgerView PBftByronCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map -> Bimap KeyHash KeyHash
Delegation.unMap

fromPBftLedgerView :: PBftLedgerView PBftByronCrypto -> Delegation.Map
fromPBftLedgerView :: PBftLedgerView PBftByronCrypto -> Map
fromPBftLedgerView = Bimap KeyHash KeyHash -> Map
Delegation.Map (Bimap KeyHash KeyHash -> Map)
-> (PBftLedgerView PBftByronCrypto -> Bimap KeyHash KeyHash)
-> PBftLedgerView PBftByronCrypto
-> Map
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PBftLedgerView PBftByronCrypto -> Bimap KeyHash KeyHash
forall c.
PBftLedgerView c -> Bimap (PBftVerKeyHash c) (PBftVerKeyHash c)
pbftDelegates

encodeByronChainDepState
  :: ChainDepState (BlockProtocol ByronBlock)
  -> Encoding
encodeByronChainDepState :: ChainDepState (BlockProtocol ByronBlock) -> Encoding
encodeByronChainDepState = ChainDepState (BlockProtocol ByronBlock) -> Encoding
forall c.
(PBftCrypto c, Serialise (PBftVerKeyHash c)) =>
PBftState c -> Encoding
S.encodePBftState

decodeByronChainDepState
  :: Decoder s (ChainDepState (BlockProtocol ByronBlock))
decodeByronChainDepState :: Decoder s (ChainDepState (BlockProtocol ByronBlock))
decodeByronChainDepState = Decoder s (ChainDepState (BlockProtocol ByronBlock))
forall c s.
(PBftCrypto c, Serialise (PBftVerKeyHash c)) =>
Decoder s (PBftState c)
S.decodePBftState