{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}

-- DUPLICATE -- adapted from: cardano-node/src/Cardano/Node/Protocol/Types.hs

module Cardano.Node.Protocol.Types (
    Protocol (..)
  , SomeConsensusProtocol (..)
  ) where

import qualified Cardano.Api.Protocol.Types as Cardano
import           Cardano.Prelude (Generic, NFData)
import           Data.Aeson
import           NoThunks.Class (NoThunks)


data Protocol = ByronProtocol
              | ShelleyProtocol
              | CardanoProtocol
  deriving (Protocol -> Protocol -> Bool
(Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool) -> Eq Protocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Protocol -> Protocol -> Bool
== :: Protocol -> Protocol -> Bool
$c/= :: Protocol -> Protocol -> Bool
/= :: Protocol -> Protocol -> Bool
Eq, (forall x. Protocol -> Rep Protocol x)
-> (forall x. Rep Protocol x -> Protocol) -> Generic Protocol
forall x. Rep Protocol x -> Protocol
forall x. Protocol -> Rep Protocol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Protocol -> Rep Protocol x
from :: forall x. Protocol -> Rep Protocol x
$cto :: forall x. Rep Protocol x -> Protocol
to :: forall x. Rep Protocol x -> Protocol
Generic)

instance Show Protocol where
  show :: Protocol -> String
show Protocol
ByronProtocol   = String
"Byron"
  show Protocol
ShelleyProtocol = String
"Shelley"
  show Protocol
CardanoProtocol = String
"Byron; Shelley"

deriving instance NFData Protocol
deriving instance NoThunks Protocol

instance FromJSON Protocol where
  parseJSON :: Value -> Parser Protocol
parseJSON =
    String -> (Text -> Parser Protocol) -> Value -> Parser Protocol
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Protocol" ((Text -> Parser Protocol) -> Value -> Parser Protocol)
-> (Text -> Parser Protocol) -> Value -> Parser Protocol
forall a b. (a -> b) -> a -> b
$ \Text
str -> case Text
str of

      -- The new names
      Text
"Byron" -> Protocol -> Parser Protocol
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Protocol
ByronProtocol
      Text
"Shelley" -> Protocol -> Parser Protocol
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Protocol
ShelleyProtocol
      Text
"Cardano" -> Protocol -> Parser Protocol
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Protocol
CardanoProtocol

      -- The old names
      Text
"RealPBFT" -> Protocol -> Parser Protocol
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Protocol
ByronProtocol
      Text
"TPraos" -> Protocol -> Parser Protocol
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Protocol
ShelleyProtocol

      Text
_ -> String -> Parser Protocol
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Protocol) -> String -> Parser Protocol
forall a b. (a -> b) -> a -> b
$ String
"Parsing of Protocol failed. "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
str String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a valid protocol"

data SomeConsensusProtocol where

     SomeConsensusProtocol :: forall blk. ( Cardano.Protocol IO blk
                                          )
                           => Cardano.BlockType blk
                           -> Cardano.ProtocolInfoArgs IO blk
                           -> SomeConsensusProtocol