{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Rpc.Server.Internal.Node
  ( getEraMethod
  , getProtocolParamsJsonMethod
  )
where

import Cardano.Api
import Cardano.Api.Experimental.Era
import Cardano.Rpc.Proto.Api.Node qualified as Rpc
import Cardano.Rpc.Server.Internal.Error
import Cardano.Rpc.Server.Internal.Monad
import Cardano.Rpc.Server.Internal.Orphans ()

import RIO hiding (toList)

import Data.Aeson qualified as A
import Data.ByteString.Lazy qualified as BL
import Data.Default
import Data.ProtoLens (defMessage)
import Network.GRPC.Spec

import Proto.Google.Protobuf.Empty

getEraMethod :: MonadRpc e m => Proto Empty -> m (Proto Rpc.CurrentEra)
getEraMethod :: forall e (m :: * -> *).
MonadRpc e m =>
Proto Empty -> m (Proto CurrentEra)
getEraMethod Proto Empty
_ = Proto CurrentEra -> m (Proto CurrentEra)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proto CurrentEra -> m (Proto CurrentEra))
-> (CurrentEra -> Proto CurrentEra)
-> CurrentEra
-> m (Proto CurrentEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurrentEra -> Proto CurrentEra
forall msg. msg -> Proto msg
Proto (CurrentEra -> m (Proto CurrentEra))
-> CurrentEra -> m (Proto CurrentEra)
forall a b. (a -> b) -> a -> b
$ CurrentEra
forall msg. Message msg => msg
defMessage CurrentEra -> (CurrentEra -> CurrentEra) -> CurrentEra
forall a b. a -> (a -> b) -> b
& ASetter CurrentEra CurrentEra Era Era
#era ASetter CurrentEra CurrentEra Era Era
-> Era -> CurrentEra -> CurrentEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Era
Rpc.Conway

getProtocolParamsJsonMethod :: MonadRpc e m => Proto Empty -> m (Proto Rpc.ProtocolParamsJson)
getProtocolParamsJsonMethod :: forall e (m :: * -> *).
MonadRpc e m =>
Proto Empty -> m (Proto ProtocolParamsJson)
getProtocolParamsJsonMethod Proto Empty
_ = do
  nodeConnInfo <- m LocalNodeConnectInfo
forall field env (m :: * -> *).
(Has field env, MonadReader env m) =>
m field
grab
  AnyCardanoEra era <- liftIO . throwExceptT $ determineEra nodeConnInfo
  eon <- forEraInEon @Era era (error "getProtocolParamsJsonMethod: Minimum Conway era required") pure
  let sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
eon

  let target = Target point
forall point. Target point
VolatileTip
  pparams <-
    liftIO . (throwEither =<<) $
      executeLocalStateQueryExpr nodeConnInfo target $
        throwEither =<< throwEither =<< queryProtocolParameters sbe

  let pparamsJson = Era era
-> (EraCommonConstraints era => LazyByteString) -> LazyByteString
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
eon ((EraCommonConstraints era => LazyByteString) -> LazyByteString)
-> (EraCommonConstraints era => LazyByteString) -> LazyByteString
forall a b. (a -> b) -> a -> b
$ PParams (ShelleyLedgerEra era) -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
A.encode PParams (ShelleyLedgerEra era)
pparams

  pure $
    def
      & #json .~ BL.toStrict pparamsJson