{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData        #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeApplications  #-}

{-# OPTIONS_GHC -Wno-orphans #-}

{-| This module exports data types for logging, events and configuration
-}
module Cardano.Node.Types
    (
     -- * Effects
    ChainSyncHandle

    -- * Config types
    , PABServerConfig (..)
    , NodeMode (..)
    , _MockNode
    , _AlonzoNode
    )
        where

import Cardano.Node.Socket.Emulator.Types (NodeServerConfig)
import Cardano.Protocol.Socket.Client qualified as Client
import Control.Lens (makePrisms)
import Data.Aeson (FromJSON, ToJSON)
import Data.Default (Default, def)
import Data.Text (Text)
import Data.Time.Units.Extra ()
import GHC.Generics (Generic)
import Ledger (Block)
import Prettyprinter (Pretty, pretty)

-- Configuration ------------------------------------------------------------------------------------------------------

{- Note [Slot numbers in mock node]

The mock node has an internal clock that generates new slots in a regular
interval. Slots are identified by consecutive integers. What should the
initial slot number be? We can either set it to 0, so that the slot number
is the number of intervals that have passed since the process was started.
Or we can define an initial timestamp, so that the slot number is the number
of intervals since that timestamp.

The first option of counting from 0 is useful for integration tests where we
want the test outcome to be independent of when the test was run. This approach
is used in the PAB simulator.
The second option, counting from a timestamp, is more realistic and it is
useful for frontends that need to convert the slot number back to a timestamp.
We use this approach for the "proper" pab executable.

-}

-- | Which node we're connecting to
data NodeMode =
    MockNode -- ^ Connect to the PAB mock node.
    | AlonzoNode -- ^ Connect to an Alonzo node
    | NoChainSyncEvents -- ^ Do not connect to any node for chain sync events. Connect to Alonzo node for slot notifications.
    deriving stock (Int -> NodeMode -> ShowS
[NodeMode] -> ShowS
NodeMode -> String
(Int -> NodeMode -> ShowS)
-> (NodeMode -> String) -> ([NodeMode] -> ShowS) -> Show NodeMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeMode] -> ShowS
$cshowList :: [NodeMode] -> ShowS
show :: NodeMode -> String
$cshow :: NodeMode -> String
showsPrec :: Int -> NodeMode -> ShowS
$cshowsPrec :: Int -> NodeMode -> ShowS
Show, NodeMode -> NodeMode -> Bool
(NodeMode -> NodeMode -> Bool)
-> (NodeMode -> NodeMode -> Bool) -> Eq NodeMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeMode -> NodeMode -> Bool
$c/= :: NodeMode -> NodeMode -> Bool
== :: NodeMode -> NodeMode -> Bool
$c== :: NodeMode -> NodeMode -> Bool
Eq, (forall x. NodeMode -> Rep NodeMode x)
-> (forall x. Rep NodeMode x -> NodeMode) -> Generic NodeMode
forall x. Rep NodeMode x -> NodeMode
forall x. NodeMode -> Rep NodeMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NodeMode x -> NodeMode
$cfrom :: forall x. NodeMode -> Rep NodeMode x
Generic)
    deriving anyclass (Value -> Parser [NodeMode]
Value -> Parser NodeMode
(Value -> Parser NodeMode)
-> (Value -> Parser [NodeMode]) -> FromJSON NodeMode
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NodeMode]
$cparseJSONList :: Value -> Parser [NodeMode]
parseJSON :: Value -> Parser NodeMode
$cparseJSON :: Value -> Parser NodeMode
FromJSON, [NodeMode] -> Value
[NodeMode] -> Encoding
NodeMode -> Value
NodeMode -> Encoding
(NodeMode -> Value)
-> (NodeMode -> Encoding)
-> ([NodeMode] -> Value)
-> ([NodeMode] -> Encoding)
-> ToJSON NodeMode
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NodeMode] -> Encoding
$ctoEncodingList :: [NodeMode] -> Encoding
toJSONList :: [NodeMode] -> Value
$ctoJSONList :: [NodeMode] -> Value
toEncoding :: NodeMode -> Encoding
$ctoEncoding :: NodeMode -> Encoding
toJSON :: NodeMode -> Value
$ctoJSON :: NodeMode -> Value
ToJSON)

makePrisms ''NodeMode

-- | Node server configuration
data PABServerConfig =
    PABServerConfig
        { PABServerConfig -> NodeServerConfig
pscNodeServerConfig :: NodeServerConfig
        -- ^ Path to a JSON file containing the protocol parameters
        , PABServerConfig -> Maybe Text
pscPassphrase       :: Maybe Text
        -- ^ Wallet passphrase
        , PABServerConfig -> NodeMode
pscNodeMode         :: NodeMode
        -- ^ Whether to connect to an Alonzo node or a mock node
        }
    deriving stock (Int -> PABServerConfig -> ShowS
[PABServerConfig] -> ShowS
PABServerConfig -> String
(Int -> PABServerConfig -> ShowS)
-> (PABServerConfig -> String)
-> ([PABServerConfig] -> ShowS)
-> Show PABServerConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PABServerConfig] -> ShowS
$cshowList :: [PABServerConfig] -> ShowS
show :: PABServerConfig -> String
$cshow :: PABServerConfig -> String
showsPrec :: Int -> PABServerConfig -> ShowS
$cshowsPrec :: Int -> PABServerConfig -> ShowS
Show, PABServerConfig -> PABServerConfig -> Bool
(PABServerConfig -> PABServerConfig -> Bool)
-> (PABServerConfig -> PABServerConfig -> Bool)
-> Eq PABServerConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PABServerConfig -> PABServerConfig -> Bool
$c/= :: PABServerConfig -> PABServerConfig -> Bool
== :: PABServerConfig -> PABServerConfig -> Bool
$c== :: PABServerConfig -> PABServerConfig -> Bool
Eq, (forall x. PABServerConfig -> Rep PABServerConfig x)
-> (forall x. Rep PABServerConfig x -> PABServerConfig)
-> Generic PABServerConfig
forall x. Rep PABServerConfig x -> PABServerConfig
forall x. PABServerConfig -> Rep PABServerConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PABServerConfig x -> PABServerConfig
$cfrom :: forall x. PABServerConfig -> Rep PABServerConfig x
Generic)
    deriving anyclass (Value -> Parser [PABServerConfig]
Value -> Parser PABServerConfig
(Value -> Parser PABServerConfig)
-> (Value -> Parser [PABServerConfig]) -> FromJSON PABServerConfig
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PABServerConfig]
$cparseJSONList :: Value -> Parser [PABServerConfig]
parseJSON :: Value -> Parser PABServerConfig
$cparseJSON :: Value -> Parser PABServerConfig
FromJSON, [PABServerConfig] -> Value
[PABServerConfig] -> Encoding
PABServerConfig -> Value
PABServerConfig -> Encoding
(PABServerConfig -> Value)
-> (PABServerConfig -> Encoding)
-> ([PABServerConfig] -> Value)
-> ([PABServerConfig] -> Encoding)
-> ToJSON PABServerConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PABServerConfig] -> Encoding
$ctoEncodingList :: [PABServerConfig] -> Encoding
toJSONList :: [PABServerConfig] -> Value
$ctoJSONList :: [PABServerConfig] -> Value
toEncoding :: PABServerConfig -> Encoding
$ctoEncoding :: PABServerConfig -> Encoding
toJSON :: PABServerConfig -> Value
$ctoJSON :: PABServerConfig -> Value
ToJSON)

defaultPABServerConfig :: PABServerConfig
defaultPABServerConfig :: PABServerConfig
defaultPABServerConfig =
    PABServerConfig :: NodeServerConfig -> Maybe Text -> NodeMode -> PABServerConfig
PABServerConfig
      { pscNodeServerConfig :: NodeServerConfig
pscNodeServerConfig = NodeServerConfig
forall a. Default a => a
def
      , pscPassphrase :: Maybe Text
pscPassphrase = Maybe Text
forall a. Maybe a
Nothing
      , pscNodeMode :: NodeMode
pscNodeMode  = NodeMode
MockNode
      }

instance Default PABServerConfig where
  def :: PABServerConfig
def = PABServerConfig
defaultPABServerConfig

instance Pretty PABServerConfig where
  pretty :: PABServerConfig -> Doc ann
pretty PABServerConfig{ NodeServerConfig
pscNodeServerConfig :: NodeServerConfig
pscNodeServerConfig :: PABServerConfig -> NodeServerConfig
pscNodeServerConfig } = NodeServerConfig -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty NodeServerConfig
pscNodeServerConfig

-- | The types of handles varies based on the type of clients (mocked or
-- real nodes) and we need a generic way of handling either type of response.
type ChainSyncHandle = Either (Client.ChainSyncHandle Block) (Client.ChainSyncHandle Client.ChainSyncEvent)