{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE NoFieldSelectors #-}

module Cardano.Rpc.Server.Config
  ( RpcConfig
  , PartialRpcConfig
  , RpcConfigF (..)
  , makeRpcConfig
  , nodeSocketPathToRpcSocketPath
  )
where

import Cardano.Api

import RIO

import Data.Monoid
import System.FilePath (takeDirectory, (</>))

import Generic.Data (gmappend, gmempty)

type PartialRpcConfig = RpcConfigF Last

type RpcConfig = RpcConfigF Identity

-- | RPC server configuration, which is a part of cardano-node configuration.
data RpcConfigF m = RpcConfig
  { forall (m :: * -> *). RpcConfigF m -> m Bool
isEnabled :: !(m Bool)
  -- ^ whether the RPC server is enabled
  , forall (m :: * -> *). RpcConfigF m -> m SocketPath
rpcSocketPath :: !(m SocketPath)
  -- ^ path to the socket file where the RPC server listens
  , forall (m :: * -> *). RpcConfigF m -> m SocketPath
nodeSocketPath :: !(m SocketPath)
  -- ^ cardano-node socket path. Only valid if RPC endpoint is enabled.
  }

deriving instance Show (RpcConfigF Identity)

deriving instance Eq (RpcConfigF Identity)

deriving instance Show (RpcConfigF Last)

deriving instance Eq (RpcConfigF Last)

deriving instance Generic (RpcConfigF Last)

instance Semigroup (RpcConfigF Last) where
  <> :: RpcConfigF Last -> RpcConfigF Last -> RpcConfigF Last
(<>) = RpcConfigF Last -> RpcConfigF Last -> RpcConfigF Last
forall a. (Generic a, Semigroup (Rep a ())) => a -> a -> a
gmappend

instance Monoid (RpcConfigF Last) where
  mempty :: RpcConfigF Last
mempty = RpcConfigF Last
forall a. (Generic a, Monoid (Rep a ())) => a
gmempty

-- | Build RPC Config
--
-- Uses the following defaults if the values are not provided
-- * RPC is disabled
-- * @rpc.sock@ is placed in the same path as the node socket
--
-- Validates if the node socket is enabled if RPC is enabled.
makeRpcConfig
  :: MonadError String m
  => PartialRpcConfig
  -> m RpcConfig
makeRpcConfig :: forall (m :: * -> *).
MonadError String m =>
RpcConfigF Last -> m (RpcConfigF Identity)
makeRpcConfig
  RpcConfig
    { isEnabled :: forall (m :: * -> *). RpcConfigF m -> m Bool
isEnabled = Last Maybe Bool
mIsEnabled
    , rpcSocketPath :: forall (m :: * -> *). RpcConfigF m -> m SocketPath
rpcSocketPath = Last Maybe SocketPath
mRpcSocketPath
    , nodeSocketPath :: forall (m :: * -> *). RpcConfigF m -> m SocketPath
nodeSocketPath = Last Maybe SocketPath
mNodeSocketPath
    } = do
    let isEnabled :: Bool
isEnabled = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
mIsEnabled
        -- default to a some non-existing path. Does not matter if the gRPC endpoint is disabled
        nodeSocketPath :: SocketPath
nodeSocketPath = SocketPath -> Maybe SocketPath -> SocketPath
forall a. a -> Maybe a -> a
fromMaybe SocketPath
"./node.socket" Maybe SocketPath
mNodeSocketPath
        rpcSocketPath :: SocketPath
rpcSocketPath = SocketPath -> Maybe SocketPath -> SocketPath
forall a. a -> Maybe a -> a
fromMaybe (SocketPath -> SocketPath
nodeSocketPathToRpcSocketPath SocketPath
nodeSocketPath) Maybe SocketPath
mRpcSocketPath
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isEnabled Bool -> Bool -> Bool
&& Maybe SocketPath -> Bool
forall a. Maybe a -> Bool
isNothing Maybe SocketPath
mNodeSocketPath) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
        String
"Configuration error: gRPC endpoint was enabled but node socket file was not specified. Cannot run gRPC server without node socket."
    RpcConfigF Identity -> m (RpcConfigF Identity)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RpcConfigF Identity -> m (RpcConfigF Identity))
-> RpcConfigF Identity -> m (RpcConfigF Identity)
forall a b. (a -> b) -> a -> b
$
      Identity Bool
-> Identity SocketPath
-> Identity SocketPath
-> RpcConfigF Identity
forall (m :: * -> *).
m Bool -> m SocketPath -> m SocketPath -> RpcConfigF m
RpcConfig
        (Bool -> Identity Bool
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
isEnabled)
        (SocketPath -> Identity SocketPath
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SocketPath
rpcSocketPath)
        (SocketPath -> Identity SocketPath
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SocketPath
nodeSocketPath)

-- | Convert node socket path to a default rpc socket path.
-- By default it's @rpc.sock@ in the same directory as node socket path.
nodeSocketPathToRpcSocketPath :: SocketPath -> SocketPath
nodeSocketPathToRpcSocketPath :: SocketPath -> SocketPath
nodeSocketPathToRpcSocketPath SocketPath
nodeSocketPath = do
  let socketDir :: String
socketDir = ShowS
takeDirectory ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ SocketPath -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile SocketPath
nodeSocketPath
  String -> SocketPath
forall content (direction :: FileDirection).
String -> File content direction
File (String -> SocketPath) -> String -> SocketPath
forall a b. (a -> b) -> a -> b
$ String
socketDir String -> ShowS
</> String
"rpc.sock"