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

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Instances required to support PBFT
module Ouroboros.Consensus.Byron.Ledger.PBFT (
    decodeByronChainDepState
  , encodeByronChainDepState
  , fromPBftLedgerView
  , mkByronContextDSIGN
  , toPBftLedgerView
  ) where

import qualified Cardano.Chain.Block as CC
import qualified Cardano.Chain.Delegation as Delegation
import           Cardano.Crypto.DSIGN
import           Cardano.Ledger.Binary (Annotated)
import           Codec.CBOR.Decoding (Decoder)
import           Codec.CBOR.Encoding (Encoding)
import           Data.ByteString (ByteString)
import           Ouroboros.Consensus.Block
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
import           Ouroboros.Consensus.Protocol.Abstract
import           Ouroboros.Consensus.Protocol.PBFT
import qualified Ouroboros.Consensus.Protocol.PBFT.State as S

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{ABlockOrBoundaryHdr ByteString
SlotNo
SizeInBytes
ByronHash
byronHeaderRaw :: ABlockOrBoundaryHdr ByteString
byronHeaderSlotNo :: SlotNo
byronHeaderHash :: ByronHash
byronHeaderBlockSizeHint :: SizeInBytes
byronHeaderRaw :: Header ByronBlock -> ABlockOrBoundaryHdr ByteString
byronHeaderSlotNo :: Header ByronBlock -> SlotNo
byronHeaderHash :: Header ByronBlock -> ByronHash
byronHeaderBlockSizeHint :: Header ByronBlock -> SizeInBytes
..} =
      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 {
                  pbftIssuer :: VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
pbftIssuer    = VerificationKey -> VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
VerificationKey -> VerKeyDSIGN ByronDSIGN
VerKeyByronDSIGN
                                (VerificationKey -> VerKeyDSIGN (PBftDSIGN PBftByronCrypto))
-> (AHeader ByteString -> VerificationKey)
-> AHeader ByteString
-> VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
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 (PBftDSIGN PBftByronCrypto))
-> AHeader ByteString -> VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
forall a b. (a -> b) -> a -> b
$ AHeader ByteString
regular
                , pbftGenKey :: VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
pbftGenKey    = VerificationKey -> VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
VerificationKey -> VerKeyDSIGN ByronDSIGN
VerKeyByronDSIGN
                                (VerificationKey -> VerKeyDSIGN (PBftDSIGN PBftByronCrypto))
-> (AHeader ByteString -> VerificationKey)
-> AHeader ByteString
-> VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AHeader ByteString -> VerificationKey
forall a. AHeader a -> VerificationKey
CC.headerGenesisKey
                                (AHeader ByteString -> VerKeyDSIGN (PBftDSIGN PBftByronCrypto))
-> AHeader ByteString -> VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
forall a b. (a -> b) -> a -> b
$ AHeader ByteString
regular
                , pbftSignature :: SignedDSIGN
  (PBftDSIGN PBftByronCrypto) (Annotated ToSign ByteString)
pbftSignature = SigDSIGN ByronDSIGN
-> SignedDSIGN
     (PBftDSIGN PBftByronCrypto) (Annotated ToSign ByteString)
SigDSIGN ByronDSIGN
-> SignedDSIGN ByronDSIGN (Annotated ToSign ByteString)
forall v a. SigDSIGN v -> SignedDSIGN v a
SignedDSIGN
                                (SigDSIGN ByronDSIGN
 -> SignedDSIGN
      (PBftDSIGN PBftByronCrypto) (Annotated ToSign ByteString))
-> (AHeader ByteString -> SigDSIGN ByronDSIGN)
-> AHeader ByteString
-> SignedDSIGN
     (PBftDSIGN PBftByronCrypto) (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
      (PBftDSIGN PBftByronCrypto) (Annotated ToSign ByteString))
-> AHeader ByteString
-> SignedDSIGN
     (PBftDSIGN PBftByronCrypto) (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)
Header ByronBlock -> PBftSelectView
forall blk. GetHeader blk => Header blk -> PBftSelectView
mkPBftSelectView

toPBftLedgerView :: Delegation.Map -> PBftLedgerView PBftByronCrypto
toPBftLedgerView :: Map -> PBftLedgerView PBftByronCrypto
toPBftLedgerView = Bimap KeyHash KeyHash -> PBftLedgerView PBftByronCrypto
Bimap
  (PBftVerKeyHash PBftByronCrypto) (PBftVerKeyHash PBftByronCrypto)
-> 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

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
PBftLedgerView PBftByronCrypto
-> Bimap
     (PBftVerKeyHash PBftByronCrypto) (PBftVerKeyHash PBftByronCrypto)
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
PBftState PBftByronCrypto -> Encoding
forall c.
(PBftCrypto c, Serialise (PBftVerKeyHash c)) =>
PBftState c -> Encoding
S.encodePBftState

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