{-# LANGUAGE GADTs      #-}
{-# LANGUAGE LambdaCase #-}
{-| Conveniences for working with a local @cardano-node@
-}
module Convex.NodeQueries(
  loadConnectInfo,
  queryEraHistory,
  querySystemStart,
  queryLocalState,
  queryTip,
  queryProtocolParameters
) where

import           Cardano.Api                                        (BabbageEra,
                                                                     BundledProtocolParameters,
                                                                     CardanoMode,
                                                                     ChainPoint,
                                                                     ConsensusModeParams (..),
                                                                     Env (..),
                                                                     EpochSlots (..),
                                                                     EraHistory,
                                                                     InitialLedgerStateError,
                                                                     LocalNodeConnectInfo (..),
                                                                     NetworkId (Mainnet, Testnet),
                                                                     NetworkMagic (..),
                                                                     SystemStart,
                                                                     envSecurityParam)
import qualified Cardano.Api                                        as CAPI
import qualified Cardano.Chain.Genesis
import           Cardano.Crypto                                     (RequiresNetworkMagic (..),
                                                                     getProtocolMagic)
import           Control.Monad.Except                               (MonadError,
                                                                     throwError)
import           Control.Monad.IO.Class                             (MonadIO (..))
import           Control.Monad.Trans.Except                         (runExceptT)
import           Data.SOP.Strict                                    (NP ((:*)))
import qualified Ouroboros.Consensus.Cardano.CanHardFork            as Consensus
import qualified Ouroboros.Consensus.HardFork.Combinator            as Consensus
import qualified Ouroboros.Consensus.HardFork.Combinator.AcrossEras as HFC
import qualified Ouroboros.Consensus.HardFork.Combinator.Basics     as HFC

{-| Load the node config file and create 'LocalNodeConnectInfo' and 'Env' values that can be used to talk to the node.
-}
loadConnectInfo ::
  (MonadError InitialLedgerStateError m, MonadIO m)
  => FilePath
  -- ^ Node config file (JSON)
  -> FilePath
  -- ^ Node socket
  -> m (LocalNodeConnectInfo CardanoMode, Env)
loadConnectInfo :: forall (m :: * -> *).
(MonadError InitialLedgerStateError m, MonadIO m) =>
String -> String -> m (LocalNodeConnectInfo CardanoMode, Env)
loadConnectInfo String
nodeConfigFilePath String
socketPath = do
  (Env
env, LedgerState
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (NodeConfigFile 'In
-> ExceptT InitialLedgerStateError IO (Env, LedgerState)
CAPI.initialLedgerState (forall content (direction :: FileDirection).
String -> File content direction
CAPI.File String
nodeConfigFilePath))) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall (f :: * -> *) a. Applicative f => a -> f a
pure

  -- Derive the NetworkId as described in network-magic.md from the
  -- cardano-ledger-specs repo.
  let byronConfig :: Config
byronConfig
        = (\(Consensus.WrapPartialLedgerConfig (Consensus.ByronPartialLedgerConfig LedgerConfig ByronBlock
bc TriggerHardFork
_) :* NP WrapPartialLedgerConfig xs
_) -> LedgerConfig ByronBlock
bc)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
HFC.getPerEraLedgerConfig
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
HFC.hardForkLedgerConfigPerEra
        forall a b. (a -> b) -> a -> b
$ Env -> HardForkLedgerConfig (CardanoEras StandardCrypto)
envLedgerConfig Env
env

      networkMagic :: Word32
networkMagic
        = forall a. AProtocolMagic a -> Word32
getProtocolMagic
        forall a b. (a -> b) -> a -> b
$ Config -> ProtocolMagic
Cardano.Chain.Genesis.configProtocolMagic Config
byronConfig

      networkId :: NetworkId
networkId = case Config -> RequiresNetworkMagic
Cardano.Chain.Genesis.configReqNetMagic Config
byronConfig of
        RequiresNetworkMagic
RequiresNoMagic -> NetworkId
Mainnet
        RequiresNetworkMagic
RequiresMagic   -> NetworkMagic -> NetworkId
Testnet (Word32 -> NetworkMagic
NetworkMagic Word32
networkMagic)

      cardanoModeParams :: ConsensusModeParams CardanoMode
cardanoModeParams = EpochSlots -> ConsensusModeParams CardanoMode
CardanoModeParams forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EpochSlots
EpochSlots forall a b. (a -> b) -> a -> b
$ Word64
10 forall a. Num a => a -> a -> a
* Env -> Word64
envSecurityParam Env
env

  -- Connect to the node.
  let connectInfo :: LocalNodeConnectInfo CardanoMode
      connectInfo :: LocalNodeConnectInfo CardanoMode
connectInfo =
          LocalNodeConnectInfo {
            localConsensusModeParams :: ConsensusModeParams CardanoMode
localConsensusModeParams = ConsensusModeParams CardanoMode
cardanoModeParams,
            localNodeNetworkId :: NetworkId
localNodeNetworkId       = NetworkId
networkId,
            localNodeSocketPath :: SocketPath
localNodeSocketPath      = forall content (direction :: FileDirection).
String -> File content direction
CAPI.File String
socketPath
          }
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalNodeConnectInfo CardanoMode
connectInfo, Env
env)

querySystemStart :: LocalNodeConnectInfo CardanoMode -> IO SystemStart
querySystemStart :: LocalNodeConnectInfo CardanoMode -> IO SystemStart
querySystemStart = forall b.
QueryInMode CardanoMode b
-> LocalNodeConnectInfo CardanoMode -> IO b
queryLocalState forall mode. QueryInMode mode SystemStart
CAPI.QuerySystemStart

queryEraHistory :: LocalNodeConnectInfo CardanoMode -> IO (EraHistory CardanoMode)
queryEraHistory :: LocalNodeConnectInfo CardanoMode -> IO (EraHistory CardanoMode)
queryEraHistory = forall b.
QueryInMode CardanoMode b
-> LocalNodeConnectInfo CardanoMode -> IO b
queryLocalState (forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode (EraHistory mode)
CAPI.QueryEraHistory ConsensusModeIsMultiEra CardanoMode
CAPI.CardanoModeIsMultiEra)

queryTip :: LocalNodeConnectInfo CardanoMode -> IO ChainPoint
queryTip :: LocalNodeConnectInfo CardanoMode -> IO ChainPoint
queryTip = forall b.
QueryInMode CardanoMode b
-> LocalNodeConnectInfo CardanoMode -> IO b
queryLocalState (forall mode. ConsensusMode mode -> QueryInMode mode ChainPoint
CAPI.QueryChainPoint ConsensusMode CardanoMode
CAPI.CardanoMode)

queryLocalState :: CAPI.QueryInMode CardanoMode b -> LocalNodeConnectInfo CardanoMode -> IO b
queryLocalState :: forall b.
QueryInMode CardanoMode b
-> LocalNodeConnectInfo CardanoMode -> IO b
queryLocalState QueryInMode CardanoMode b
query LocalNodeConnectInfo CardanoMode
connectInfo = do
  forall mode result.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode result
-> IO (Either AcquiringFailure result)
CAPI.queryNodeLocalState LocalNodeConnectInfo CardanoMode
connectInfo forall a. Maybe a
Nothing QueryInMode CardanoMode b
query forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left AcquiringFailure
err -> do
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"queryLocalState: Failed with " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show AcquiringFailure
err)
    Right b
result -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
result

queryProtocolParameters :: LocalNodeConnectInfo CardanoMode -> IO (BundledProtocolParameters BabbageEra)
queryProtocolParameters :: LocalNodeConnectInfo CardanoMode
-> IO (BundledProtocolParameters BabbageEra)
queryProtocolParameters LocalNodeConnectInfo CardanoMode
connectInfo = do
  Either EraMismatch ProtocolParameters
result <- forall b.
QueryInMode CardanoMode b
-> LocalNodeConnectInfo CardanoMode -> IO b
queryLocalState (forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
CAPI.QueryInEra EraInMode BabbageEra CardanoMode
CAPI.BabbageEraInCardanoMode (forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
CAPI.QueryInShelleyBasedEra ShelleyBasedEra BabbageEra
CAPI.ShelleyBasedEraBabbage forall era. QueryInShelleyBasedEra era ProtocolParameters
CAPI.QueryProtocolParameters)) LocalNodeConnectInfo CardanoMode
connectInfo
  case Either EraMismatch ProtocolParameters
result of
    Left EraMismatch
err -> do
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"queryProtocolParameters: failed with: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show EraMismatch
err)
    -- Right k -> pure (CAPI.bundleProtocolParams k)
    Right ProtocolParameters
x -> case forall era.
CardanoEra era
-> ProtocolParameters
-> Either
     ProtocolParametersConversionError (BundledProtocolParameters era)
CAPI.bundleProtocolParams CardanoEra BabbageEra
CAPI.BabbageEra ProtocolParameters
x of
      Left ProtocolParametersConversionError
err -> do
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"queryProtocolParameters: bundleProtocolParams failed with: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ProtocolParametersConversionError
err)
      Right BundledProtocolParameters BabbageEra
k -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BundledProtocolParameters BabbageEra
k