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

{- 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 (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
        ]