{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Cardano.CLI.Byron.Query
( ByronQueryError(..)
, renderByronQueryError
, runGetLocalNodeTip
) where
import Cardano.Prelude
import Control.Monad.Trans.Except.Extra (firstExceptT)
import qualified Data.Text as Text
import Cardano.Api.Typed
import Cardano.Chain.Slotting (EpochSlots (..))
import Ouroboros.Consensus.Block (ConvertRawHash (..))
import Ouroboros.Network.Block
import Cardano.Api.LocalChainSync (getLocalTip)
import Cardano.CLI.Environment (EnvSocketError, readEnvSocketPath, renderEnvSocketError)
import Cardano.CLI.Types (SocketPath (..))
import Cardano.Tracing.Render (renderHeaderHash, renderSlotNo)
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 (HardForkBlock '[ByronBlock])
connctInfo =
LocalNodeConnectInfo :: forall mode block.
String
-> NetworkId
-> NodeConsensusMode mode block
-> LocalNodeConnectInfo mode block
LocalNodeConnectInfo {
localNodeSocketPath :: String
localNodeSocketPath = String
sockPath,
localNodeNetworkId :: NetworkId
localNodeNetworkId = NetworkId
networkId,
localNodeConsensusMode :: NodeConsensusMode ByronMode (HardForkBlock '[ByronBlock])
localNodeConsensusMode = EpochSlots
-> NodeConsensusMode ByronMode (HardForkBlock '[ByronBlock])
ByronMode (Word64 -> EpochSlots
EpochSlots Word64
21600)
}
IO () -> ExceptT ByronQueryError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ByronQueryError IO ())
-> IO () -> ExceptT ByronQueryError IO ()
forall a b. (a -> b) -> a -> b
$ do
Tip (HardForkBlock '[ByronBlock])
tip <- LocalNodeConnectInfo ByronMode (HardForkBlock '[ByronBlock])
-> IO (Tip (HardForkBlock '[ByronBlock]))
forall block mode.
(ShowProxy block, ShowProxy (ApplyTxErr block),
ShowProxy (Query block), ShowProxy (GenTx block),
ShowQuery (Query block)) =>
LocalNodeConnectInfo mode block -> IO (Tip block)
getLocalTip LocalNodeConnectInfo ByronMode (HardForkBlock '[ByronBlock])
connctInfo
Text -> IO ()
putTextLn (Tip (HardForkBlock '[ByronBlock]) -> Text
forall blk. ConvertRawHash blk => Tip blk -> Text
getTipOutput Tip (HardForkBlock '[ByronBlock])
tip)
where
getTipOutput :: forall blk. ConvertRawHash blk => Tip blk -> Text
getTipOutput :: Tip blk -> Text
getTipOutput Tip blk
TipGenesis = Text
"Current tip: genesis (origin)"
getTipOutput (Tip SlotNo
slotNo HeaderHash blk
headerHash (BlockNo Word64
blkNo)) =
[Text] -> Text
Text.unlines
[ Text
"\n"
, Text
"Current tip: "
, Text
"Block hash: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Proxy blk -> HeaderHash blk -> Text
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> Text
renderHeaderHash (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) HeaderHash blk
headerHash
, Text
"Slot: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Text
renderSlotNo SlotNo
slotNo
, Text
"Block number: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Word64
blkNo
]