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

module Cardano.Node.Client where

import Cardano.Node.Emulator.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.Api.NetworkId.Extra (NetworkIdWrapper (..))
import Cardano.Node.API (API)
import Cardano.Node.Types (ChainSyncHandle, NodeMode (..), PABServerConfig (..), PABServerLogMsg)
import Cardano.Protocol.Socket.Client qualified as Client
import Cardano.Protocol.Socket.Mock.Client qualified as MockClient
import Control.Monad.Freer.Extras.Log (LogMessage)
import Plutus.PAB.Types (PABError (..))
import Wallet.Effects (NodeClientEffect (..))

healthcheck :: ClientM NoContent
consumeEventHistory :: ClientM [LogMessage PABServerLogMsg]
(ClientM NoContent
healthcheck, ClientM [LogMessage PABServerLogMsg]
consumeEventHistory) =
    ( ClientM NoContent
healthcheck_
    , ClientM [LogMessage PABServerLogMsg]
consumeEventHistory_
    )
  where
    ClientM NoContent
healthcheck_ :<|> ClientM [LogMessage PABServerLogMsg]
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 { FilePath
pscSocketPath :: PABServerConfig -> FilePath
pscSocketPath :: FilePath
pscSocketPath
                                    , NodeMode
pscNodeMode :: PABServerConfig -> NodeMode
pscNodeMode :: NodeMode
pscNodeMode
                                    , NetworkIdWrapper
pscNetworkId :: PABServerConfig -> NetworkIdWrapper
pscNetworkId :: NetworkIdWrapper
pscNetworkId
                                    , SlotConfig
pscSlotConfig :: PABServerConfig -> SlotConfig
pscSlotConfig :: SlotConfig
pscSlotConfig } =
    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
pscSocketPath SlotConfig
pscSlotConfig
      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
pscSocketPath
                                         SlotConfig
pscSlotConfig
                                         (NetworkIdWrapper -> NetworkId
unNetworkIdWrapper NetworkIdWrapper
pscNetworkId)
                                         []