{-# LANGUAGE GADTs          #-}
{-# LANGUAGE LambdaCase     #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns   #-}
{-| Helper functions for querying a local @cardano-node@ using the socket interface
-}
module Convex.Devnet.NodeQueries(
  querySystemStart,
  queryEraHistory,
  queryTip,
  queryTipBlock,
  queryTipSlotNo,
  queryUTxO,
  queryUTxOWhole,
  waitForTxn,
  waitForTxIn,
  waitForTxInSpend,
  localNodeConnectInfo,
  loadConnectInfo
) where

import           Cardano.Api                                        (Address,
                                                                     BabbageEra,
                                                                     BlockNo,
                                                                     CardanoMode,
                                                                     EraHistory (..),
                                                                     LocalNodeConnectInfo (..),
                                                                     NetworkId,
                                                                     QueryInMode,
                                                                     QueryUTxOFilter,
                                                                     ShelleyAddr,
                                                                     SlotNo, Tx,
                                                                     TxIn, UTxO)
import qualified Cardano.Api                                        as C
import           Cardano.Slotting.Slot                              (WithOrigin)
import           Cardano.Slotting.Time                              (SlotLength,
                                                                     SystemStart)
import           Control.Concurrent                                 (threadDelay)
import           Control.Exception                                  (Exception,
                                                                     throwIO)
import           Control.Monad                                      (unless,
                                                                     when)
import           Control.Monad.Catch                                (MonadThrow)
import           Control.Monad.IO.Class                             (MonadIO (..))
import           Convex.Devnet.Utils                                (failure)
import           Convex.NodeQueries                                 (loadConnectInfo)
import           Convex.Utils                                       (txnUtxos)
import qualified Convex.Utxos                                       as Utxos
import qualified Data.Set                                           as Set
import           Data.Word                                          (Word64)
import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch)
import           Ouroboros.Consensus.HardFork.History               (interpretQuery,
                                                                     slotToSlotLength)
import           Prelude

data QueryException
  = QueryAcquireException String
  | QueryEraMismatchException EraMismatch
  deriving (QueryException -> QueryException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryException -> QueryException -> Bool
$c/= :: QueryException -> QueryException -> Bool
== :: QueryException -> QueryException -> Bool
$c== :: QueryException -> QueryException -> Bool
Eq, Int -> QueryException -> ShowS
[QueryException] -> ShowS
QueryException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryException] -> ShowS
$cshowList :: [QueryException] -> ShowS
show :: QueryException -> String
$cshow :: QueryException -> String
showsPrec :: Int -> QueryException -> ShowS
$cshowsPrec :: Int -> QueryException -> ShowS
Show)

instance Exception QueryException

-- | Get the 'SystemStart' from the node
querySystemStart ::
  NetworkId ->
    -- ^ network Id to use for node query
  FilePath ->
    -- ^ Node socket
  IO SystemStart
querySystemStart :: NetworkId -> String -> IO SystemStart
querySystemStart = forall b. QueryInMode CardanoMode b -> NetworkId -> String -> IO b
queryLocalState forall mode. QueryInMode mode SystemStart
C.QuerySystemStart

-- | Get the 'EraHistory' from the node
queryEraHistory ::
  NetworkId ->
    -- ^ network Id to use for node query
  FilePath ->
    -- ^ Node socket
  IO (EraHistory CardanoMode)
queryEraHistory :: NetworkId -> String -> IO (EraHistory CardanoMode)
queryEraHistory = forall b. QueryInMode CardanoMode b -> NetworkId -> String -> IO b
queryLocalState (forall mode.
ConsensusModeIsMultiEra mode -> QueryInMode mode (EraHistory mode)
C.QueryEraHistory ConsensusModeIsMultiEra CardanoMode
C.CardanoModeIsMultiEra)

queryLocalState :: QueryInMode CardanoMode b -> NetworkId -> FilePath -> IO b
queryLocalState :: forall b. QueryInMode CardanoMode b -> NetworkId -> String -> IO b
queryLocalState QueryInMode CardanoMode b
query NetworkId
networkId String
socket = do
  forall mode result.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode result
-> IO (Either AcquiringFailure result)
C.queryNodeLocalState (NetworkId -> String -> LocalNodeConnectInfo CardanoMode
localNodeConnectInfo NetworkId
networkId String
socket) forall a. Maybe a
Nothing QueryInMode CardanoMode b
query forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left AcquiringFailure
err -> do
      forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure forall a b. (a -> b) -> a -> b
$ String
"querySystemStart: Failed with " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show AcquiringFailure
err
    Right b
result -> forall (f :: * -> *) a. Applicative f => a -> f a
pure b
result


localNodeConnectInfo :: NetworkId -> FilePath -> C.LocalNodeConnectInfo C.CardanoMode
localNodeConnectInfo :: NetworkId -> String -> LocalNodeConnectInfo CardanoMode
localNodeConnectInfo NetworkId
localNodeNetworkId (forall content (direction :: FileDirection).
String -> File content direction
C.File -> File Socket 'InOut
localNodeSocketPath) =
  C.LocalNodeConnectInfo
    { localConsensusModeParams :: ConsensusModeParams CardanoMode
localConsensusModeParams = ConsensusModeParams CardanoMode
cardanoModeParams
    , NetworkId
localNodeNetworkId :: NetworkId
localNodeNetworkId :: NetworkId
localNodeNetworkId
    , File Socket 'InOut
localNodeSocketPath :: File Socket 'InOut
localNodeSocketPath :: File Socket 'InOut
localNodeSocketPath
    }

cardanoModeParams :: C.ConsensusModeParams C.CardanoMode
cardanoModeParams :: ConsensusModeParams CardanoMode
cardanoModeParams = EpochSlots -> ConsensusModeParams CardanoMode
C.CardanoModeParams forall a b. (a -> b) -> a -> b
$ Word64 -> EpochSlots
C.EpochSlots Word64
defaultByronEpochSlots
 where
  -- NOTE(AB): extracted from Parsers in cardano-cli, this is needed to run in 'cardanoMode' which
  -- is the default for cardano-cli
  defaultByronEpochSlots :: Word64
defaultByronEpochSlots = Word64
21600 :: Word64

queryTipBlock :: NetworkId -> FilePath -> IO (WithOrigin BlockNo)
queryTipBlock :: NetworkId -> String -> IO (WithOrigin BlockNo)
queryTipBlock = forall b. QueryInMode CardanoMode b -> NetworkId -> String -> IO b
queryLocalState forall mode. QueryInMode mode (WithOrigin BlockNo)
C.QueryChainBlockNo

-- | Get the tip (slot no. and block hash) from the node
queryTip ::
  NetworkId ->
    -- ^ network Id to use for node query
  FilePath ->
    -- ^ Node socket
  IO (SlotNo, SlotLength, C.Hash C.BlockHeader)
queryTip :: NetworkId -> String -> IO (SlotNo, SlotLength, Hash BlockHeader)
queryTip NetworkId
networkId String
socket = forall b. QueryInMode CardanoMode b -> NetworkId -> String -> IO b
queryLocalState (forall mode. ConsensusMode mode -> QueryInMode mode ChainPoint
C.QueryChainPoint ConsensusMode CardanoMode
C.CardanoMode) NetworkId
networkId String
socket forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  ChainPoint
C.ChainPointAtGenesis -> forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure String
"queryTip: chain point at genesis"
  C.ChainPoint SlotNo
slot Hash BlockHeader
hsh -> SlotNo -> IO SlotLength
getSlotLength SlotNo
slot forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\SlotLength
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
slot, SlotLength
i, Hash BlockHeader
hsh))

  where
    getSlotLength :: SlotNo -> IO SlotLength
    getSlotLength :: SlotNo -> IO SlotLength
getSlotLength SlotNo
slotNo = do
      (EraHistory ConsensusMode CardanoMode
_ Interpreter xs
interpreter) <- NetworkId -> String -> IO (EraHistory CardanoMode)
queryEraHistory NetworkId
networkId String
socket
      case forall (xs :: [*]) a.
HasCallStack =>
Interpreter xs -> Qry a -> Either PastHorizonException a
interpretQuery Interpreter xs
interpreter (SlotNo -> Qry SlotLength
slotToSlotLength SlotNo
slotNo) of
        Left PastHorizonException
err      -> forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure forall a b. (a -> b) -> a -> b
$ String
"queryTip: Failed with " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show PastHorizonException
err
        Right SlotLength
slength -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SlotLength
slength

-- | Get the slot no of the current tip from the node
queryTipSlotNo ::
  NetworkId ->
    -- ^ network Id to use for node query
  FilePath ->
    -- ^ Node socket
  IO (SlotNo, SlotLength)
queryTipSlotNo :: NetworkId -> String -> IO (SlotNo, SlotLength)
queryTipSlotNo NetworkId
networkId String
socket = NetworkId -> String -> IO (SlotNo, SlotLength, Hash BlockHeader)
queryTip NetworkId
networkId String
socket forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(SlotNo
s, SlotLength
l, Hash BlockHeader
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
s, SlotLength
l))

-- | Query UTxO for all given addresses at given point.
--
-- Throws at least 'QueryException' if query fails.
queryUTxOFilter :: NetworkId -> FilePath -> QueryUTxOFilter -> IO (UTxO C.BabbageEra)
queryUTxOFilter :: NetworkId -> String -> QueryUTxOFilter -> IO (UTxO BabbageEra)
queryUTxOFilter NetworkId
networkId String
socket QueryUTxOFilter
flt =
  let query :: QueryInMode CardanoMode (Either EraMismatch (UTxO BabbageEra))
query =
        forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
C.QueryInEra
          EraInMode BabbageEra CardanoMode
C.BabbageEraInCardanoMode
          ( forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
C.QueryInShelleyBasedEra
              ShelleyBasedEra BabbageEra
C.ShelleyBasedEraBabbage
              ( forall era.
QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
C.QueryUTxO QueryUTxOFilter
flt)
          )
   in forall b. QueryInMode CardanoMode b -> NetworkId -> String -> IO b
queryLocalState QueryInMode CardanoMode (Either EraMismatch (UTxO BabbageEra))
query NetworkId
networkId String
socket forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
(MonadThrow m, MonadIO m) =>
Either EraMismatch a -> m a
throwOnEraMismatch

-- | Query UTxO for all given addresses at given point.
--
-- Throws at least 'QueryException' if query fails.
queryUTxO :: NetworkId -> FilePath -> [Address ShelleyAddr] -> IO (UTxO C.BabbageEra)
queryUTxO :: NetworkId
-> String -> [Address ShelleyAddr] -> IO (UTxO BabbageEra)
queryUTxO NetworkId
networkId String
socket [Address ShelleyAddr]
addresses =
  NetworkId -> String -> QueryUTxOFilter -> IO (UTxO BabbageEra)
queryUTxOFilter NetworkId
networkId String
socket (Set AddressAny -> QueryUTxOFilter
C.QueryUTxOByAddress (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Address ShelleyAddr -> AddressAny
C.AddressShelley [Address ShelleyAddr]
addresses))

-- | Query the entire UTxO set
--
-- Throws at least 'QueryException' if query fails.
queryUTxOWhole :: NetworkId -> FilePath -> IO (UTxO C.BabbageEra)
queryUTxOWhole :: NetworkId -> String -> IO (UTxO BabbageEra)
queryUTxOWhole NetworkId
networkId String
socket = NetworkId -> String -> QueryUTxOFilter -> IO (UTxO BabbageEra)
queryUTxOFilter NetworkId
networkId String
socket QueryUTxOFilter
C.QueryUTxOWhole

throwOnEraMismatch :: (MonadThrow m, MonadIO m) => Either EraMismatch a -> m a
throwOnEraMismatch :: forall (m :: * -> *) a.
(MonadThrow m, MonadIO m) =>
Either EraMismatch a -> m a
throwOnEraMismatch Either EraMismatch a
res =
  case Either EraMismatch a
res of
    Left EraMismatch
eraMismatch -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ EraMismatch -> QueryException
QueryEraMismatchException EraMismatch
eraMismatch
    Right a
result     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result

{-| Wait until the output appears on the chain
-}
waitForTxIn :: NetworkId -> FilePath -> TxIn -> IO ()
waitForTxIn :: NetworkId -> String -> TxIn -> IO ()
waitForTxIn NetworkId
networkId String
socket TxIn
txIn = do
  let query :: QueryInMode CardanoMode (Either EraMismatch (UTxO BabbageEra))
query =
        forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
C.QueryInEra
          EraInMode BabbageEra CardanoMode
C.BabbageEraInCardanoMode
          ( forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
C.QueryInShelleyBasedEra
              ShelleyBasedEra BabbageEra
C.ShelleyBasedEraBabbage
              ( forall era.
QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
C.QueryUTxO
                  (Set TxIn -> QueryUTxOFilter
C.QueryUTxOByTxIn (forall a. a -> Set a
Set.singleton TxIn
txIn))
              )
          )
      go :: IO ()
go = do
        UtxoSet CtxUTxO ()
utxo <- UTxO BabbageEra -> UtxoSet CtxUTxO ()
Utxos.fromApiUtxo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall b. QueryInMode CardanoMode b -> NetworkId -> String -> IO b
queryLocalState QueryInMode CardanoMode (Either EraMismatch (UTxO BabbageEra))
query NetworkId
networkId String
socket forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
(MonadThrow m, MonadIO m) =>
Either EraMismatch a -> m a
throwOnEraMismatch)
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UtxoSet CtxUTxO ()
utxo forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ do
          Int -> IO ()
threadDelay Int
2_000_000
          IO ()
go
  IO ()
go

waitForTxn :: NetworkId -> FilePath -> Tx BabbageEra -> IO ()
waitForTxn :: NetworkId -> String -> Tx BabbageEra -> IO ()
waitForTxn NetworkId
network String
socket (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Tx era -> [(TxIn, TxOut CtxTx era)]
txnUtxos -> TxIn
txi) = NetworkId -> String -> TxIn -> IO ()
waitForTxIn NetworkId
network String
socket TxIn
txi

{-| Wait until the 'TxIn' is not part of the utxo set anymore
-}
waitForTxInSpend :: NetworkId -> FilePath -> TxIn -> IO ()
waitForTxInSpend :: NetworkId -> String -> TxIn -> IO ()
waitForTxInSpend NetworkId
networkId String
socket TxIn
txIn = do
  let query :: QueryInMode CardanoMode (Either EraMismatch (UTxO BabbageEra))
query =
        forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
C.QueryInEra
          EraInMode BabbageEra CardanoMode
C.BabbageEraInCardanoMode
          ( forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
C.QueryInShelleyBasedEra
              ShelleyBasedEra BabbageEra
C.ShelleyBasedEraBabbage
              ( forall era.
QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
C.QueryUTxO
                  (Set TxIn -> QueryUTxOFilter
C.QueryUTxOByTxIn (forall a. a -> Set a
Set.singleton TxIn
txIn))
              )
          )
      go :: IO ()
go = do
        UtxoSet CtxUTxO ()
utxo <- UTxO BabbageEra -> UtxoSet CtxUTxO ()
Utxos.fromApiUtxo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall b. QueryInMode CardanoMode b -> NetworkId -> String -> IO b
queryLocalState QueryInMode CardanoMode (Either EraMismatch (UTxO BabbageEra))
query NetworkId
networkId String
socket forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
(MonadThrow m, MonadIO m) =>
Either EraMismatch a -> m a
throwOnEraMismatch)
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (UtxoSet CtxUTxO ()
utxo forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ do
          Int -> IO ()
threadDelay Int
2_000_000
          IO ()
go
  IO ()
go