{-# LANGUAGE DataKinds        #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs            #-}
{-# LANGUAGE NamedFieldPuns   #-}
{-# LANGUAGE RankNTypes       #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators    #-}

module Cardano.Node.Client where

import Cardano.Node.Emulator.Internal.Node.Params (Params)
import Control.Monad.Freer
import Control.Monad.Freer.Error (Error, throwError)
import Control.Monad.Freer.Reader (Reader, ask)
import Control.Monad.IO.Class
import Data.Proxy (Proxy (Proxy))
import Ledger (CardanoTx (CardanoEmulatorEraTx))
import Servant (NoContent, (:<|>) (..))
import Servant.Client (ClientM, client)

import Cardano.Node.Emulator (EmulatorLogs)
import Cardano.Node.Socket.Emulator.API (API)
import Cardano.Node.Socket.Emulator.Types (NodeServerConfig (..))
import Cardano.Node.Types (ChainSyncHandle, NodeMode (..), PABServerConfig (..))
import Cardano.Protocol.Socket.Client qualified as Client
import Cardano.Protocol.Socket.Mock.Client qualified as MockClient
import Plutus.PAB.Types (PABError (..))
import Wallet.Effects (NodeClientEffect (..))

healthcheck :: ClientM NoContent
consumeEventHistory :: ClientM EmulatorLogs
(ClientM NoContent
healthcheck, ClientM EmulatorLogs
consumeEventHistory) =
    ( ClientM NoContent
healthcheck_
    , ClientM EmulatorLogs
consumeEventHistory_
    )
  where
    ClientM NoContent
healthcheck_ :<|> ClientM EmulatorLogs
consumeEventHistory_ =
        Proxy API -> Client ClientM API
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy API
forall k (t :: k). Proxy t
Proxy @API)

handleNodeClientClient ::
    forall m effs.
    ( LastMember m effs
    , MonadIO m
    , Member (Error PABError) effs
    , Member (Reader (Maybe MockClient.TxSendHandle)) effs
    , Member (Reader ChainSyncHandle) effs
    )
    => Params
    -> NodeClientEffect
    ~> Eff effs
handleNodeClientClient :: Params -> NodeClientEffect ~> Eff effs
handleNodeClientClient Params
params NodeClientEffect x
e = do
    Maybe TxSendHandle
txSendHandle <- forall (effs :: [* -> *]).
Member (Reader (Maybe TxSendHandle)) effs =>
Eff effs (Maybe TxSendHandle)
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @(Maybe MockClient.TxSendHandle)
    ChainSyncHandle
chainSyncHandle <- forall (effs :: [* -> *]).
Member (Reader ChainSyncHandle) effs =>
Eff effs ChainSyncHandle
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @ChainSyncHandle
    case NodeClientEffect x
e of
        PublishTx CardanoTx
tx  ->
            case Maybe TxSendHandle
txSendHandle of
              Maybe TxSendHandle
Nothing ->
                  -- If the PAB is started with the real node working transactions
                  -- need to be sent via the wallet, not the mocked server node
                  -- (which is not actually running).
                  PABError -> Eff effs x
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError PABError
TxSenderNotAvailable
              Just TxSendHandle
handle -> IO () -> Eff effs ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff effs ()) -> IO () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ (TxSendHandle -> Tx BabbageEra -> IO ()
MockClient.queueTx TxSendHandle
handle (Tx BabbageEra -> IO ())
-> (CardanoTx -> Tx BabbageEra) -> CardanoTx -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(CardanoEmulatorEraTx Tx BabbageEra
c) -> Tx BabbageEra
c)) CardanoTx
tx
        NodeClientEffect x
GetClientSlot ->
            (ChainSyncHandle Block -> Eff effs Slot)
-> (ChainSyncHandle ChainSyncEvent -> Eff effs Slot)
-> ChainSyncHandle
-> Eff effs Slot
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO Slot -> Eff effs Slot
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Slot -> Eff effs Slot)
-> (ChainSyncHandle Block -> IO Slot)
-> ChainSyncHandle Block
-> Eff effs Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainSyncHandle Block -> IO Slot
MockClient.getCurrentSlot)
                   (IO Slot -> Eff effs Slot
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Slot -> Eff effs Slot)
-> (ChainSyncHandle ChainSyncEvent -> IO Slot)
-> ChainSyncHandle ChainSyncEvent
-> Eff effs Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainSyncHandle ChainSyncEvent -> IO Slot
forall block. ChainSyncHandle block -> IO Slot
Client.getCurrentSlot)
                   ChainSyncHandle
chainSyncHandle
        NodeClientEffect x
GetClientParams -> Params -> Eff effs Params
forall (f :: * -> *) a. Applicative f => a -> f a
pure Params
params

-- | This does not seem to support resuming so it means that the slot tick will
-- be behind everything else. This is due to having 2 connections to the node
-- one for chainSync/block transfer and one for chainSync/currentSlot information.
-- TODO: Think about merging the two functionalities, or keep them in sync.
runChainSyncWithCfg ::
     PABServerConfig
  -> IO ChainSyncHandle
runChainSyncWithCfg :: PABServerConfig -> IO ChainSyncHandle
runChainSyncWithCfg PABServerConfig
                        { NodeMode
pscNodeMode :: PABServerConfig -> NodeMode
pscNodeMode :: NodeMode
pscNodeMode
                        , pscNodeServerConfig :: PABServerConfig -> NodeServerConfig
pscNodeServerConfig = NodeServerConfig
                            { FilePath
nscSocketPath :: NodeServerConfig -> FilePath
nscSocketPath :: FilePath
nscSocketPath
                            , NetworkId
nscNetworkId :: NodeServerConfig -> NetworkId
nscNetworkId :: NetworkId
nscNetworkId
                            , SlotConfig
nscSlotConfig :: NodeServerConfig -> SlotConfig
nscSlotConfig :: SlotConfig
nscSlotConfig
                            }
                        } =
    case NodeMode
pscNodeMode of
      NodeMode
MockNode   ->
          ChainSyncHandle Block -> ChainSyncHandle
forall a b. a -> Either a b
Left (ChainSyncHandle Block -> ChainSyncHandle)
-> IO (ChainSyncHandle Block) -> IO ChainSyncHandle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> SlotConfig -> IO (ChainSyncHandle Block)
MockClient.runChainSync' FilePath
nscSocketPath SlotConfig
nscSlotConfig
      NodeMode
_ ->
          ChainSyncHandle ChainSyncEvent -> ChainSyncHandle
forall a b. b -> Either a b
Right (ChainSyncHandle ChainSyncEvent -> ChainSyncHandle)
-> IO (ChainSyncHandle ChainSyncEvent) -> IO ChainSyncHandle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> SlotConfig
-> NetworkId
-> [ChainPoint]
-> IO (ChainSyncHandle ChainSyncEvent)
Client.runChainSync' FilePath
nscSocketPath
                                         SlotConfig
nscSlotConfig
                                         NetworkId
nscNetworkId
                                         []