{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Bcc.CLI.Cole.Query
  ( ColeQueryError(..)
  , renderColeQueryError
  , runGetLocalNodeTip
  ) where

import           Bcc.Prelude

import           Control.Monad.Trans.Except.Extra (firstExceptT)
import           Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text.Encoding as Text

import           Bcc.Api
import           Bcc.CLI.Environment (EnvSocketError, readEnvSocketPath, renderEnvSocketError)
import           Bcc.CLI.Types (SocketPath (..))

{- HLINT ignore "Reduce duplication" -}

newtype ColeQueryError = ColeQueryEnvVarSocketErr EnvSocketError
  deriving Int -> ColeQueryError -> ShowS
[ColeQueryError] -> ShowS
ColeQueryError -> String
(Int -> ColeQueryError -> ShowS)
-> (ColeQueryError -> String)
-> ([ColeQueryError] -> ShowS)
-> Show ColeQueryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColeQueryError] -> ShowS
$cshowList :: [ColeQueryError] -> ShowS
show :: ColeQueryError -> String
$cshow :: ColeQueryError -> String
showsPrec :: Int -> ColeQueryError -> ShowS
$cshowsPrec :: Int -> ColeQueryError -> ShowS
Show

renderColeQueryError :: ColeQueryError -> Text
renderColeQueryError :: ColeQueryError -> Text
renderColeQueryError ColeQueryError
err =
  case ColeQueryError
err of
    ColeQueryEnvVarSocketErr EnvSocketError
sockEnvErr -> EnvSocketError -> Text
renderEnvSocketError EnvSocketError
sockEnvErr

--------------------------------------------------------------------------------
-- Query local node's chain tip
--------------------------------------------------------------------------------

runGetLocalNodeTip :: NetworkId -> ExceptT ColeQueryError IO ()
runGetLocalNodeTip :: NetworkId -> ExceptT ColeQueryError IO ()
runGetLocalNodeTip NetworkId
networkId = do
    SocketPath String
sockPath <- (EnvSocketError -> ColeQueryError)
-> ExceptT EnvSocketError IO SocketPath
-> ExceptT ColeQueryError IO SocketPath
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT EnvSocketError -> ColeQueryError
ColeQueryEnvVarSocketErr
                           ExceptT EnvSocketError IO SocketPath
readEnvSocketPath
    let connctInfo :: LocalNodeConnectInfo ColeMode
connctInfo =
          LocalNodeConnectInfo :: forall mode.
ConsensusModeParams mode
-> NetworkId -> String -> LocalNodeConnectInfo mode
LocalNodeConnectInfo {
            localNodeSocketPath :: String
localNodeSocketPath    = String
sockPath,
            localNodeNetworkId :: NetworkId
localNodeNetworkId     = NetworkId
networkId,
            localConsensusModeParams :: ConsensusModeParams ColeMode
localConsensusModeParams = EpochSlots -> ConsensusModeParams ColeMode
ColeModeParams (Word64 -> EpochSlots
EpochSlots Word64
21600)
          }

    ChainTip
tip <- IO ChainTip -> ExceptT ColeQueryError IO ChainTip
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChainTip -> ExceptT ColeQueryError IO ChainTip)
-> IO ChainTip -> ExceptT ColeQueryError IO ChainTip
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo ColeMode -> IO ChainTip
forall mode. LocalNodeConnectInfo mode -> IO ChainTip
getLocalChainTip LocalNodeConnectInfo ColeMode
connctInfo
    IO () -> ExceptT ColeQueryError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ColeQueryError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT ColeQueryError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> IO ()
putTextLn (Text -> IO ()) -> (ByteString -> Text) -> ByteString -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
LB.toStrict (ByteString -> ExceptT ColeQueryError IO ())
-> ByteString -> ExceptT ColeQueryError IO ()
forall a b. (a -> b) -> a -> b
$ ChainTip -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty ChainTip
tip