{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Mocked Peras votes without crypto.
module Ouroboros.Consensus.Peras.Vote.Mock
  ( MockPerasVote (..)
  ) where

import Cardano.Binary (FromCBOR (..), ToCBOR (..), decodeListLenOf, encodeListLen)
import Control.DeepSeq (NFData)
import Data.Data (Proxy (..))
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block.Abstract
  ( ConvertRawHash
  , Point
  , StandardHash
  )
import Ouroboros.Consensus.Node.Serialisation (SerialiseNodeToNode (..))
import Ouroboros.Consensus.Peras.Types
  ( BoostedBlock
  , PerasRoundNo
  , PerasSeatIndex (..)
  )
import Ouroboros.Consensus.Peras.Vote.Class (IsPerasVote (..))
import Ouroboros.Consensus.Util (ShowProxy)
import Ouroboros.Network.Util (ShowProxy (..))

-- | Mocked Peras votes without crypto.
--
-- NOTE: this is parameterized around the concrete block type being voted for.
data MockPerasVote blk
  = MockPerasVote
  { forall blk. MockPerasVote blk -> PerasRoundNo
mockVoteRound :: PerasRoundNo
  , forall blk. MockPerasVote blk -> Point blk
mockVoteBlock :: Point blk
  , forall blk. MockPerasVote blk -> PerasSeatIndex
mockVoteSeatIndex :: PerasSeatIndex
  }

deriving instance StandardHash blk => Show (MockPerasVote blk)
deriving instance StandardHash blk => Eq (MockPerasVote blk)
deriving instance StandardHash blk => Ord (MockPerasVote blk)
deriving instance StandardHash blk => NoThunks (MockPerasVote blk)
deriving instance StandardHash blk => NFData (MockPerasVote blk)
deriving instance Generic (MockPerasVote blk)

type instance BoostedBlock (MockPerasVote blk) = Point blk

instance IsPerasVote (MockPerasVote blk) blk where
  getPerasVoteRound :: MockPerasVote blk -> PerasRoundNo
getPerasVoteRound = MockPerasVote blk -> PerasRoundNo
forall blk. MockPerasVote blk -> PerasRoundNo
mockVoteRound
  getPerasVoteBlock :: MockPerasVote blk -> BoostedBlock (MockPerasVote blk)
getPerasVoteBlock = MockPerasVote blk -> Point blk
MockPerasVote blk -> BoostedBlock (MockPerasVote blk)
forall blk. MockPerasVote blk -> Point blk
mockVoteBlock
  getPerasVoteSeatIndex :: MockPerasVote blk -> PerasSeatIndex
getPerasVoteSeatIndex = MockPerasVote blk -> PerasSeatIndex
forall blk. MockPerasVote blk -> PerasSeatIndex
mockVoteSeatIndex

instance ShowProxy blk => ShowProxy (MockPerasVote blk) where
  showProxy :: Proxy (MockPerasVote blk) -> String
showProxy Proxy (MockPerasVote blk)
_ = String
"MockPerasVote(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy blk -> String
forall {k} (p :: k). ShowProxy p => Proxy p -> String
showProxy (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"

instance
  ( Typeable blk
  , FromCBOR (Point blk)
  ) =>
  FromCBOR (MockPerasVote blk)
  where
  fromCBOR :: forall s. Decoder s (MockPerasVote blk)
fromCBOR = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
3
    mockVoteRound <- Decoder s PerasRoundNo
forall s. Decoder s PerasRoundNo
forall a s. FromCBOR a => Decoder s a
fromCBOR
    mockVoteBlock <- fromCBOR
    mockVoteSeatIndex <- fromCBOR
    pure
      MockPerasVote
        { mockVoteRound
        , mockVoteBlock
        , mockVoteSeatIndex
        }

instance
  ( Typeable blk
  , ToCBOR (Point blk)
  ) =>
  ToCBOR (MockPerasVote blk)
  where
  toCBOR :: MockPerasVote blk -> Encoding
toCBOR
    MockPerasVote
      { PerasRoundNo
mockVoteRound :: forall blk. MockPerasVote blk -> PerasRoundNo
mockVoteRound :: PerasRoundNo
mockVoteRound
      , Point blk
mockVoteBlock :: forall blk. MockPerasVote blk -> Point blk
mockVoteBlock :: Point blk
mockVoteBlock
      , PerasSeatIndex
mockVoteSeatIndex :: forall blk. MockPerasVote blk -> PerasSeatIndex
mockVoteSeatIndex :: PerasSeatIndex
mockVoteSeatIndex
      } =
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PerasRoundNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PerasRoundNo
mockVoteRound
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Point blk -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Point blk
mockVoteBlock
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PerasSeatIndex -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PerasSeatIndex
mockVoteSeatIndex

instance
  ConvertRawHash blk =>
  SerialiseNodeToNode blk (MockPerasVote blk)
  where
  encodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk -> MockPerasVote blk -> Encoding
encodeNodeToNode
    CodecConfig blk
ccfg
    BlockNodeToNodeVersion blk
version
    MockPerasVote
      { PerasRoundNo
mockVoteRound :: forall blk. MockPerasVote blk -> PerasRoundNo
mockVoteRound :: PerasRoundNo
mockVoteRound
      , Point blk
mockVoteBlock :: forall blk. MockPerasVote blk -> Point blk
mockVoteBlock :: Point blk
mockVoteBlock
      , PerasSeatIndex
mockVoteSeatIndex :: forall blk. MockPerasVote blk -> PerasSeatIndex
mockVoteSeatIndex :: PerasSeatIndex
mockVoteSeatIndex
      } =
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CodecConfig blk
-> BlockNodeToNodeVersion blk -> PerasRoundNo -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version PerasRoundNo
mockVoteRound
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CodecConfig blk
-> BlockNodeToNodeVersion blk -> Point blk -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version Point blk
mockVoteBlock
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CodecConfig blk
-> BlockNodeToNodeVersion blk -> PerasSeatIndex -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version PerasSeatIndex
mockVoteSeatIndex
  decodeNodeToNode :: CodecConfig blk
-> BlockNodeToNodeVersion blk
-> forall s. Decoder s (MockPerasVote blk)
decodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
3
    mockVoteRound <- CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s PerasRoundNo
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s a
decodeNodeToNode CodecConfig blk
ccfg BlockNodeToNodeVersion blk
version
    mockVoteBlock <- decodeNodeToNode ccfg version
    mockVoteSeatIndex <- decodeNodeToNode ccfg version
    pure
      MockPerasVote
        { mockVoteRound
        , mockVoteBlock
        , mockVoteSeatIndex
        }