{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeApplications #-}

-- | Conversion between concrete Peras types and abstract committee types
module Ouroboros.Consensus.Peras.Voting.Adapter
  ( PerasVoteCompatibleWithVotingCommittee (..)
  , PerasCertCompatibleWithVotingCommittee (..)
  , PerasConversionError (..)
  , fromPerasSeatIndex
  , toPerasSeatIndex
  ) where

import Data.Containers.NonEmpty (HasNonEmpty (..))
import GHC.Generics (Generic)
import GHC.Word (Word16, Word64)
import NoThunks.Class (NoThunks)
import qualified Ouroboros.Consensus.Committee.Class as Committee
import Ouroboros.Consensus.Committee.WFA (SeatIndex (..))
import Ouroboros.Consensus.Peras.Types (PerasSeatIndex (..))

-- | Conversion between (concrete) Peras votes and (abstract) committee votes.
--
-- NOTE: the functional dependency @vote -> crypto@ explicitly ties each
-- concrete Peras vote type to a specific crypto scheme.
class
  PerasVoteCompatibleWithVotingCommittee vote crypto committee
    | vote -> crypto
  where
  toPerasVote ::
    Committee.Vote crypto committee ->
    Either PerasConversionError vote
  fromPerasVote ::
    vote ->
    Either PerasConversionError (Committee.Vote crypto committee)

-- | Conversion between (concrete) Peras certificates and (abstract) committee
-- certificates.
--
-- NOTE: the functional dependency @cert -> crypto@ explicitly ties each
-- concrete Peras certificate type to a specific crypto scheme.
class
  PerasCertCompatibleWithVotingCommittee cert crypto committee
    | cert -> crypto
  where
  toPerasCert ::
    Committee.Cert crypto committee ->
    Either PerasConversionError cert
  fromPerasCert ::
    cert ->
    Either PerasConversionError (Committee.Cert crypto committee)

-- | Errors that can occur when converting between Peras and committee types
data PerasConversionError
  = EveryoneVotesButFoundNonPersistentVoterInVote SeatIndex
  | EveryoneVotesButFoundNonPersistentVotersInCert (NE [SeatIndex])
  | SeatIndexOverflowError Word64
  | CryptoError String
  deriving stock (PerasConversionError -> PerasConversionError -> Bool
(PerasConversionError -> PerasConversionError -> Bool)
-> (PerasConversionError -> PerasConversionError -> Bool)
-> Eq PerasConversionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PerasConversionError -> PerasConversionError -> Bool
== :: PerasConversionError -> PerasConversionError -> Bool
$c/= :: PerasConversionError -> PerasConversionError -> Bool
/= :: PerasConversionError -> PerasConversionError -> Bool
Eq, Int -> PerasConversionError -> ShowS
[PerasConversionError] -> ShowS
PerasConversionError -> [Char]
(Int -> PerasConversionError -> ShowS)
-> (PerasConversionError -> [Char])
-> ([PerasConversionError] -> ShowS)
-> Show PerasConversionError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PerasConversionError -> ShowS
showsPrec :: Int -> PerasConversionError -> ShowS
$cshow :: PerasConversionError -> [Char]
show :: PerasConversionError -> [Char]
$cshowList :: [PerasConversionError] -> ShowS
showList :: [PerasConversionError] -> ShowS
Show, (forall x. PerasConversionError -> Rep PerasConversionError x)
-> (forall x. Rep PerasConversionError x -> PerasConversionError)
-> Generic PerasConversionError
forall x. Rep PerasConversionError x -> PerasConversionError
forall x. PerasConversionError -> Rep PerasConversionError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PerasConversionError -> Rep PerasConversionError x
from :: forall x. PerasConversionError -> Rep PerasConversionError x
$cto :: forall x. Rep PerasConversionError x -> PerasConversionError
to :: forall x. Rep PerasConversionError x -> PerasConversionError
Generic)
  deriving anyclass Context -> PerasConversionError -> IO (Maybe ThunkInfo)
Proxy PerasConversionError -> [Char]
(Context -> PerasConversionError -> IO (Maybe ThunkInfo))
-> (Context -> PerasConversionError -> IO (Maybe ThunkInfo))
-> (Proxy PerasConversionError -> [Char])
-> NoThunks PerasConversionError
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> [Char])
-> NoThunks a
$cnoThunks :: Context -> PerasConversionError -> IO (Maybe ThunkInfo)
noThunks :: Context -> PerasConversionError -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PerasConversionError -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PerasConversionError -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy PerasConversionError -> [Char]
showTypeOf :: Proxy PerasConversionError -> [Char]
NoThunks

-- | Convert a Peras seat index to a committee seat index.
fromPerasSeatIndex ::
  PerasSeatIndex ->
  SeatIndex
fromPerasSeatIndex :: PerasSeatIndex -> SeatIndex
fromPerasSeatIndex (PerasSeatIndex Word16
seatIndex) =
  Word64 -> SeatIndex
SeatIndex (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Word64 Word16
seatIndex)

-- | Convert a committee seat index to a Peras seat index
--
-- NOTE: this can fail if the seat index in the committee vote or certificate
-- overflows the smaller 'Word16' type used by Peras votes and certificates.
-- In practice, this should never happen unless there is a bug in the voting
-- committee logic.
toPerasSeatIndex ::
  SeatIndex ->
  Either PerasConversionError PerasSeatIndex
toPerasSeatIndex :: SeatIndex -> Either PerasConversionError PerasSeatIndex
toPerasSeatIndex (SeatIndex Word64
seatIndex)
  | Word64
seatIndex Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Word64 Word16
forall a. Bounded a => a
maxBound =
      PerasSeatIndex -> Either PerasConversionError PerasSeatIndex
forall a b. b -> Either a b
Right (Word16 -> PerasSeatIndex
PerasSeatIndex (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word16 Word64
seatIndex))
  | Bool
otherwise =
      PerasConversionError -> Either PerasConversionError PerasSeatIndex
forall a b. a -> Either a b
Left (Word64 -> PerasConversionError
SeatIndexOverflowError Word64
seatIndex)