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

module Cardano.CLI.Byron.Query
  ( ByronQueryError(..)
  , renderByronQueryError
  , runGetLocalNodeTip
  ) where

import           Cardano.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           Cardano.Api
import           Cardano.CLI.Environment (EnvSocketError, readEnvSocketPath, renderEnvSocketError)
import           Cardano.CLI.Types (SocketPath (..))

{- HLINT ignore "Reduce duplication" -}

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

renderByronQueryError :: ByronQueryError -> Text
renderByronQueryError :: ByronQueryError -> Text
renderByronQueryError ByronQueryError
err =
  case ByronQueryError
err of
    ByronQueryEnvVarSocketErr EnvSocketError
sockEnvErr -> EnvSocketError -> Text
renderEnvSocketError EnvSocketError
sockEnvErr

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

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

    ChainTip
tip <- IO ChainTip -> ExceptT ByronQueryError IO ChainTip
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChainTip -> ExceptT ByronQueryError IO ChainTip)
-> IO ChainTip -> ExceptT ByronQueryError IO ChainTip
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo ByronMode -> IO ChainTip
forall mode. LocalNodeConnectInfo mode -> IO ChainTip
getLocalChainTip LocalNodeConnectInfo ByronMode
connctInfo
    IO () -> ExceptT ByronQueryError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ByronQueryError IO ())
-> (ByteString -> IO ())
-> ByteString
-> ExceptT ByronQueryError 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 ByronQueryError IO ())
-> ByteString -> ExceptT ByronQueryError IO ()
forall a b. (a -> b) -> a -> b
$ ChainTip -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty ChainTip
tip