{-# 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 (..))
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
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