{-# LANGUAGE DeriveAnyClass         #-}
{-# LANGUAGE DeriveGeneric          #-}
{-# LANGUAGE DerivingVia            #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE KindSignatures         #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE StandaloneDeriving     #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}

{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Protocol.PBFT.Crypto (
    PBftCrypto (..)
  , PBftMockCrypto
  , PBftMockVerKeyHash (..)
  ) where

import           Codec.Serialise (Serialise)
import           Data.Kind (Type)
import           Data.Typeable
import           Data.Word (Word64)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)

import           Cardano.Crypto.DSIGN.Class
import           Cardano.Crypto.DSIGN.Mock (MockDSIGN, VerKeyDSIGN (..))

import           Ouroboros.Consensus.Util.Condense

-- | Crypto primitives required by BFT
--
-- Cardano stores a map of stakeholder IDs rather than the verification key
-- directly. We make this family injective for convenience - whilst it's
-- _possible_ that there could be non-injective instances, the chances of there
-- being more than the two instances here are basically non-existent.
class ( Typeable c
      , DSIGNAlgorithm (PBftDSIGN c)
      , Condense (SigDSIGN (PBftDSIGN c))
      , Show (PBftVerKeyHash c)
      , Ord  (PBftVerKeyHash c)
      , Eq   (PBftVerKeyHash c)
      , Show (PBftVerKeyHash c)
      , NoThunks (PBftVerKeyHash c)
      , NoThunks (PBftDelegationCert c)
      ) => PBftCrypto c where
  type family PBftDSIGN          c :: Type
  type family PBftDelegationCert c = (d :: Type) | d -> c
  type family PBftVerKeyHash     c = (d :: Type) | d -> c

  dlgCertGenVerKey :: PBftDelegationCert c -> VerKeyDSIGN (PBftDSIGN c)
  dlgCertDlgVerKey :: PBftDelegationCert c -> VerKeyDSIGN (PBftDSIGN c)
  hashVerKey       :: VerKeyDSIGN (PBftDSIGN c) -> PBftVerKeyHash c


data PBftMockCrypto

instance PBftCrypto PBftMockCrypto where
  type PBftDSIGN          PBftMockCrypto = MockDSIGN
  type PBftDelegationCert PBftMockCrypto = (VerKeyDSIGN MockDSIGN, VerKeyDSIGN MockDSIGN)
  type PBftVerKeyHash     PBftMockCrypto = PBftMockVerKeyHash

  dlgCertGenVerKey :: PBftDelegationCert PBftMockCrypto
-> VerKeyDSIGN (PBftDSIGN PBftMockCrypto)
dlgCertGenVerKey = PBftDelegationCert PBftMockCrypto
-> VerKeyDSIGN (PBftDSIGN PBftMockCrypto)
forall a b. (a, b) -> a
fst
  dlgCertDlgVerKey :: PBftDelegationCert PBftMockCrypto
-> VerKeyDSIGN (PBftDSIGN PBftMockCrypto)
dlgCertDlgVerKey = PBftDelegationCert PBftMockCrypto
-> VerKeyDSIGN (PBftDSIGN PBftMockCrypto)
forall a b. (a, b) -> b
snd
  hashVerKey :: VerKeyDSIGN (PBftDSIGN PBftMockCrypto)
-> PBftVerKeyHash PBftMockCrypto
hashVerKey       = VerKeyDSIGN MockDSIGN -> PBftMockVerKeyHash
VerKeyDSIGN (PBftDSIGN PBftMockCrypto)
-> PBftVerKeyHash PBftMockCrypto
PBftMockVerKeyHash

-- | We don't hash and just use the underlying 'Word64'.
newtype PBftMockVerKeyHash = PBftMockVerKeyHash {
      PBftMockVerKeyHash -> VerKeyDSIGN MockDSIGN
getPBftMockVerKeyHash :: VerKeyDSIGN MockDSIGN
    }
  deriving (PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool
(PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool)
-> (PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool)
-> Eq PBftMockVerKeyHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool
$c/= :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool
== :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool
$c== :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool
Eq, Int -> PBftMockVerKeyHash -> ShowS
[PBftMockVerKeyHash] -> ShowS
PBftMockVerKeyHash -> String
(Int -> PBftMockVerKeyHash -> ShowS)
-> (PBftMockVerKeyHash -> String)
-> ([PBftMockVerKeyHash] -> ShowS)
-> Show PBftMockVerKeyHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBftMockVerKeyHash] -> ShowS
$cshowList :: [PBftMockVerKeyHash] -> ShowS
show :: PBftMockVerKeyHash -> String
$cshow :: PBftMockVerKeyHash -> String
showsPrec :: Int -> PBftMockVerKeyHash -> ShowS
$cshowsPrec :: Int -> PBftMockVerKeyHash -> ShowS
Show, (forall x. PBftMockVerKeyHash -> Rep PBftMockVerKeyHash x)
-> (forall x. Rep PBftMockVerKeyHash x -> PBftMockVerKeyHash)
-> Generic PBftMockVerKeyHash
forall x. Rep PBftMockVerKeyHash x -> PBftMockVerKeyHash
forall x. PBftMockVerKeyHash -> Rep PBftMockVerKeyHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PBftMockVerKeyHash x -> PBftMockVerKeyHash
$cfrom :: forall x. PBftMockVerKeyHash -> Rep PBftMockVerKeyHash x
Generic, Context -> PBftMockVerKeyHash -> IO (Maybe ThunkInfo)
Proxy PBftMockVerKeyHash -> String
(Context -> PBftMockVerKeyHash -> IO (Maybe ThunkInfo))
-> (Context -> PBftMockVerKeyHash -> IO (Maybe ThunkInfo))
-> (Proxy PBftMockVerKeyHash -> String)
-> NoThunks PBftMockVerKeyHash
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy PBftMockVerKeyHash -> String
$cshowTypeOf :: Proxy PBftMockVerKeyHash -> String
wNoThunks :: Context -> PBftMockVerKeyHash -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PBftMockVerKeyHash -> IO (Maybe ThunkInfo)
noThunks :: Context -> PBftMockVerKeyHash -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> PBftMockVerKeyHash -> IO (Maybe ThunkInfo)
NoThunks)
  deriving (Decoder s PBftMockVerKeyHash
Decoder s [PBftMockVerKeyHash]
[PBftMockVerKeyHash] -> Encoding
PBftMockVerKeyHash -> Encoding
(PBftMockVerKeyHash -> Encoding)
-> (forall s. Decoder s PBftMockVerKeyHash)
-> ([PBftMockVerKeyHash] -> Encoding)
-> (forall s. Decoder s [PBftMockVerKeyHash])
-> Serialise PBftMockVerKeyHash
forall s. Decoder s [PBftMockVerKeyHash]
forall s. Decoder s PBftMockVerKeyHash
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [PBftMockVerKeyHash]
$cdecodeList :: forall s. Decoder s [PBftMockVerKeyHash]
encodeList :: [PBftMockVerKeyHash] -> Encoding
$cencodeList :: [PBftMockVerKeyHash] -> Encoding
decode :: Decoder s PBftMockVerKeyHash
$cdecode :: forall s. Decoder s PBftMockVerKeyHash
encode :: PBftMockVerKeyHash -> Encoding
$cencode :: PBftMockVerKeyHash -> Encoding
Serialise, Eq PBftMockVerKeyHash
Eq PBftMockVerKeyHash
-> (PBftMockVerKeyHash -> PBftMockVerKeyHash -> Ordering)
-> (PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool)
-> (PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool)
-> (PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool)
-> (PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool)
-> (PBftMockVerKeyHash -> PBftMockVerKeyHash -> PBftMockVerKeyHash)
-> (PBftMockVerKeyHash -> PBftMockVerKeyHash -> PBftMockVerKeyHash)
-> Ord PBftMockVerKeyHash
PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool
PBftMockVerKeyHash -> PBftMockVerKeyHash -> Ordering
PBftMockVerKeyHash -> PBftMockVerKeyHash -> PBftMockVerKeyHash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> PBftMockVerKeyHash
$cmin :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> PBftMockVerKeyHash
max :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> PBftMockVerKeyHash
$cmax :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> PBftMockVerKeyHash
>= :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool
$c>= :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool
> :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool
$c> :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool
<= :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool
$c<= :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool
< :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool
$c< :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> Bool
compare :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> Ordering
$ccompare :: PBftMockVerKeyHash -> PBftMockVerKeyHash -> Ordering
$cp1Ord :: Eq PBftMockVerKeyHash
Ord) via Word64