{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

module Ouroboros.Consensus.Byron.Protocol (
    PBftByronCrypto
  , genesisKeyCoreNodeId
  , nodeIdToGenesisKey
  ) where

import qualified Cardano.Chain.Common as CC.Common
import qualified Cardano.Chain.Delegation as CC.Delegation
import qualified Cardano.Chain.Genesis as CC.Genesis
import           Control.Monad (guard)
import           Data.Set (Set)
import qualified Data.Set as Set
import           Ouroboros.Consensus.Byron.Crypto.DSIGN
import           Ouroboros.Consensus.NodeId (CoreNodeId (..))
import           Ouroboros.Consensus.Protocol.PBFT

{-------------------------------------------------------------------------------
  Crypto
-------------------------------------------------------------------------------}

data PBftByronCrypto

instance PBftCrypto PBftByronCrypto where
  type PBftDSIGN          PBftByronCrypto = ByronDSIGN
  type PBftDelegationCert PBftByronCrypto = CC.Delegation.Certificate
  type PBftVerKeyHash     PBftByronCrypto = CC.Common.KeyHash

  dlgCertGenVerKey :: PBftDelegationCert PBftByronCrypto
-> VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
dlgCertGenVerKey = VerificationKey -> VerKeyDSIGN ByronDSIGN
VerKeyByronDSIGN (VerificationKey -> VerKeyDSIGN ByronDSIGN)
-> (Certificate -> VerificationKey)
-> Certificate
-> VerKeyDSIGN ByronDSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
CC.Delegation.issuerVK
  dlgCertDlgVerKey :: PBftDelegationCert PBftByronCrypto
-> VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
dlgCertDlgVerKey = VerificationKey -> VerKeyDSIGN ByronDSIGN
VerKeyByronDSIGN (VerificationKey -> VerKeyDSIGN ByronDSIGN)
-> (Certificate -> VerificationKey)
-> Certificate
-> VerKeyDSIGN ByronDSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
CC.Delegation.delegateVK
  hashVerKey :: VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
-> PBftVerKeyHash PBftByronCrypto
hashVerKey (VerKeyByronDSIGN VerificationKey
pk) = VerificationKey -> KeyHash
CC.Common.hashKey VerificationKey
pk

{-------------------------------------------------------------------------------
  PBFT node order
-------------------------------------------------------------------------------}

-- | Determine the 'CoreNodeId' for a code node, based on the genesis key it
-- will sign blocks on behalf of.
--
-- In PBFT, the 'CoreNodeId' index is determined by the 0-based position in
-- the sort order of the genesis key hashes.
genesisKeyCoreNodeId :: CC.Genesis.Config
                     -> VerKeyDSIGN ByronDSIGN
                        -- ^ The genesis verification key
                     -> Maybe CoreNodeId
genesisKeyCoreNodeId :: Config -> VerKeyDSIGN ByronDSIGN -> Maybe CoreNodeId
genesisKeyCoreNodeId Config
gc VerKeyDSIGN ByronDSIGN
vkey =
    Word64 -> CoreNodeId
CoreNodeId (Word64 -> CoreNodeId) -> (Int -> Word64) -> Int -> CoreNodeId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CoreNodeId) -> Maybe Int -> Maybe CoreNodeId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      KeyHash -> Set KeyHash -> Maybe Int
forall a. Ord a => a -> Set a -> Maybe Int
Set.lookupIndex (VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
-> PBftVerKeyHash PBftByronCrypto
forall c.
PBftCrypto c =>
VerKeyDSIGN (PBftDSIGN c) -> PBftVerKeyHash c
hashVerKey VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
VerKeyDSIGN ByronDSIGN
vkey) (Config -> Set KeyHash
genesisKeyHashes Config
gc)

-- | Inverse of 'genesisKeyCoreNodeId'
nodeIdToGenesisKey :: CC.Genesis.Config
                   -> CoreNodeId
                   -> Maybe CC.Common.KeyHash
nodeIdToGenesisKey :: Config -> CoreNodeId -> Maybe KeyHash
nodeIdToGenesisKey Config
gc (CoreNodeId Word64
nid) = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Word64
nid Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Set KeyHash -> Int
forall a. Set a -> Int
Set.size (Config -> Set KeyHash
genesisKeyHashes Config
gc))
    KeyHash -> Maybe KeyHash
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyHash -> Maybe KeyHash) -> KeyHash -> Maybe KeyHash
forall a b. (a -> b) -> a -> b
$ Int -> Set KeyHash -> KeyHash
forall a. Int -> Set a -> a
Set.elemAt (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
nid) (Config -> Set KeyHash
genesisKeyHashes Config
gc)

genesisKeyHashes :: CC.Genesis.Config -> Set CC.Common.KeyHash
genesisKeyHashes :: Config -> Set KeyHash
genesisKeyHashes = GenesisKeyHashes -> Set KeyHash
CC.Genesis.unGenesisKeyHashes
                 (GenesisKeyHashes -> Set KeyHash)
-> (Config -> GenesisKeyHashes) -> Config -> Set KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> GenesisKeyHashes
CC.Genesis.configGenesisKeyHashes