-----------------------------------------------------------------------------
--
-- Module      :  $Headers
-- Copyright   :  (c) 2021 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <code@functionally.io>
-- Stability   :  Experimental
-- Portability :  Portable
--
-- | Querying the blockchain and submitting transactions.
--
-----------------------------------------------------------------------------


{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}


module Mantra.Query (
-- * Querying
  queryProtocol
, queryTip
, queryUTxO
-- * Transactions
, submitTransaction
-- * Slots
, adjustSlot
) where


import Cardano.Api (AddressAny, CardanoMode, ChainTip(..), ConsensusMode(CardanoMode), ConsensusModeParams, IsCardanoEra(..), IsShelleyBasedEra(..), LocalNodeConnectInfo(..), NetworkId, QueryInEra(QueryInShelleyBasedEra), QueryInMode(..), ShelleyBasedEra, SlotNo(..), Tx, TxInMode(..), TxValidationErrorInMode, getLocalChainTip, queryNodeLocalState, shelleyBasedToCardanoEra, submitTxToNodeLocal, toEraInMode)
import Cardano.Api.Shelley (ProtocolParameters, QueryInShelleyBasedEra(..), QueryUTxOFilter(..), UTxO)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Mantra.Types (MantraM, SlotRef(..), foistMantraEither, foistMantraEitherIO)
import Ouroboros.Network.Protocol.LocalTxSubmission.Type (SubmitResult)

import qualified Data.Set as S (singleton)


-- | Find the tip of the blockchain.
queryTip
  :: MonadFail m
  => MonadIO m
  => FilePath                        -- ^ Path to the node's socket.
  -> ConsensusModeParams CardanoMode -- ^ The consensus mode.
  -> NetworkId                       -- ^ The network.
  -> MantraM m SlotNo                -- ^ Action to find the slot number.
queryTip :: FilePath
-> ConsensusModeParams CardanoMode -> NetworkId -> MantraM m SlotNo
queryTip FilePath
socketPath ConsensusModeParams CardanoMode
mode NetworkId
network =
  do
    let
      localNodeConnInfo :: LocalNodeConnectInfo CardanoMode
localNodeConnInfo = ConsensusModeParams CardanoMode
-> NetworkId -> FilePath -> LocalNodeConnectInfo CardanoMode
forall mode.
ConsensusModeParams mode
-> NetworkId -> FilePath -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams CardanoMode
mode NetworkId
network FilePath
socketPath
    ChainTip SlotNo
slotNo Hash BlockHeader
_ BlockNo
_ <- IO ChainTip -> MantraM m ChainTip
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChainTip -> MantraM m ChainTip)
-> IO ChainTip -> MantraM m ChainTip
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo CardanoMode -> IO ChainTip
forall mode. LocalNodeConnectInfo mode -> IO ChainTip
getLocalChainTip LocalNodeConnectInfo CardanoMode
localNodeConnInfo
    SlotNo -> MantraM m SlotNo
forall (m :: * -> *) a. Monad m => a -> m a
return SlotNo
slotNo


-- | Compute a slot number.
adjustSlot :: SlotRef -- ^ The slot reference.
           -> SlotNo  -- ^ The current tip.
           -> SlotNo  -- ^ The resultant slot number.
adjustSlot :: SlotRef -> SlotNo -> SlotNo
adjustSlot (AbsoluteSlot Integer
slot ) SlotNo
_             = Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
slot
adjustSlot (RelativeSlot Integer
delta) (SlotNo Word64
slot) = Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ Word64
slot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
delta


-- | Find the protocol parameters.
queryProtocol :: IsShelleyBasedEra era
              => MonadFail m
              => MonadIO m
              => ShelleyBasedEra era             -- ^ The era.
              -> FilePath                        -- ^ Path to the node's socket.
              -> ConsensusModeParams CardanoMode -- ^ The consensus mode.
              -> NetworkId                       -- ^ The network.
              -> MantraM m ProtocolParameters    -- ^ Action to find the protocol parameters.
queryProtocol :: ShelleyBasedEra era
-> FilePath
-> ConsensusModeParams CardanoMode
-> NetworkId
-> MantraM m ProtocolParameters
queryProtocol ShelleyBasedEra era
sbe FilePath
socketPath ConsensusModeParams CardanoMode
mode NetworkId
network =
  do
    let
      Just EraInMode era CardanoMode
eraInMode = CardanoEra era
-> ConsensusMode CardanoMode -> Maybe (EraInMode era CardanoMode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
shelleyBasedToCardanoEra ShelleyBasedEra era
sbe) ConsensusMode CardanoMode
CardanoMode
      localNodeConnInfo :: LocalNodeConnectInfo CardanoMode
localNodeConnInfo = ConsensusModeParams CardanoMode
-> NetworkId -> FilePath -> LocalNodeConnectInfo CardanoMode
forall mode.
ConsensusModeParams mode
-> NetworkId -> FilePath -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams CardanoMode
mode NetworkId
network FilePath
socketPath
    Either EraMismatch ProtocolParameters
pparams <-
      IO (Either AcquireFailure (Either EraMismatch ProtocolParameters))
-> MantraM m (Either EraMismatch ProtocolParameters)
forall (m :: * -> *) e a.
(MonadIO m, Show e) =>
IO (Either e a) -> MantraM m a
foistMantraEitherIO
        (IO (Either AcquireFailure (Either EraMismatch ProtocolParameters))
 -> MantraM m (Either EraMismatch ProtocolParameters))
-> (QueryInEra era ProtocolParameters
    -> IO
         (Either AcquireFailure (Either EraMismatch ProtocolParameters)))
-> QueryInEra era ProtocolParameters
-> MantraM m (Either EraMismatch ProtocolParameters)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalNodeConnectInfo CardanoMode
-> Maybe ChainPoint
-> QueryInMode CardanoMode (Either EraMismatch ProtocolParameters)
-> IO
     (Either AcquireFailure (Either EraMismatch ProtocolParameters))
forall mode result.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode result
-> IO (Either AcquireFailure result)
queryNodeLocalState LocalNodeConnectInfo CardanoMode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing
        (QueryInMode CardanoMode (Either EraMismatch ProtocolParameters)
 -> IO
      (Either AcquireFailure (Either EraMismatch ProtocolParameters)))
-> (QueryInEra era ProtocolParameters
    -> QueryInMode CardanoMode (Either EraMismatch ProtocolParameters))
-> QueryInEra era ProtocolParameters
-> IO
     (Either AcquireFailure (Either EraMismatch ProtocolParameters))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraInMode era CardanoMode
-> QueryInEra era ProtocolParameters
-> QueryInMode CardanoMode (Either EraMismatch ProtocolParameters)
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era CardanoMode
eraInMode
        (QueryInEra era ProtocolParameters
 -> MantraM m (Either EraMismatch ProtocolParameters))
-> QueryInEra era ProtocolParameters
-> MantraM m (Either EraMismatch ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> QueryInShelleyBasedEra era ProtocolParameters
-> QueryInEra era ProtocolParameters
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra QueryInShelleyBasedEra era ProtocolParameters
forall era. QueryInShelleyBasedEra era ProtocolParameters
QueryProtocolParameters
    Either EraMismatch ProtocolParameters
-> MantraM m ProtocolParameters
forall (m :: * -> *) e a.
(Monad m, Show e) =>
Either e a -> MantraM m a
foistMantraEither Either EraMismatch ProtocolParameters
pparams


-- | Find UTxOs at an address.
queryUTxO :: IsCardanoEra era
          => MonadFail m
          => MonadIO m
          => ShelleyBasedEra era             -- ^ The era.
          -> FilePath                        -- ^ Path to the node's socket.
          -> ConsensusModeParams CardanoMode -- ^ The consensus mode.
          -> AddressAny                      -- ^ The address.
          -> NetworkId                       -- ^ The network.
          -> MantraM m (UTxO era)            -- ^ Action to find the UTxOs.
queryUTxO :: ShelleyBasedEra era
-> FilePath
-> ConsensusModeParams CardanoMode
-> AddressAny
-> NetworkId
-> MantraM m (UTxO era)
queryUTxO ShelleyBasedEra era
sbe FilePath
socketPath ConsensusModeParams CardanoMode
mode AddressAny
address NetworkId
network =
  do
    let
      Just EraInMode era CardanoMode
eraInMode = CardanoEra era
-> ConsensusMode CardanoMode -> Maybe (EraInMode era CardanoMode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
shelleyBasedToCardanoEra ShelleyBasedEra era
sbe) ConsensusMode CardanoMode
CardanoMode
      localNodeConnInfo :: LocalNodeConnectInfo CardanoMode
localNodeConnInfo = ConsensusModeParams CardanoMode
-> NetworkId -> FilePath -> LocalNodeConnectInfo CardanoMode
forall mode.
ConsensusModeParams mode
-> NetworkId -> FilePath -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams CardanoMode
mode NetworkId
network FilePath
socketPath
    Either EraMismatch (UTxO era)
utxo <-
      IO (Either AcquireFailure (Either EraMismatch (UTxO era)))
-> MantraM m (Either EraMismatch (UTxO era))
forall (m :: * -> *) e a.
(MonadIO m, Show e) =>
IO (Either e a) -> MantraM m a
foistMantraEitherIO
        (IO (Either AcquireFailure (Either EraMismatch (UTxO era)))
 -> MantraM m (Either EraMismatch (UTxO era)))
-> (Set AddressAny
    -> IO (Either AcquireFailure (Either EraMismatch (UTxO era))))
-> Set AddressAny
-> MantraM m (Either EraMismatch (UTxO era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalNodeConnectInfo CardanoMode
-> Maybe ChainPoint
-> QueryInMode CardanoMode (Either EraMismatch (UTxO era))
-> IO (Either AcquireFailure (Either EraMismatch (UTxO era)))
forall mode result.
LocalNodeConnectInfo mode
-> Maybe ChainPoint
-> QueryInMode mode result
-> IO (Either AcquireFailure result)
queryNodeLocalState LocalNodeConnectInfo CardanoMode
localNodeConnInfo Maybe ChainPoint
forall a. Maybe a
Nothing
        (QueryInMode CardanoMode (Either EraMismatch (UTxO era))
 -> IO (Either AcquireFailure (Either EraMismatch (UTxO era))))
-> (Set AddressAny
    -> QueryInMode CardanoMode (Either EraMismatch (UTxO era)))
-> Set AddressAny
-> IO (Either AcquireFailure (Either EraMismatch (UTxO era)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraInMode era CardanoMode
-> QueryInEra era (UTxO era)
-> QueryInMode CardanoMode (Either EraMismatch (UTxO era))
forall era mode result1.
EraInMode era mode
-> QueryInEra era result1
-> QueryInMode mode (Either EraMismatch result1)
QueryInEra EraInMode era CardanoMode
eraInMode
        (QueryInEra era (UTxO era)
 -> QueryInMode CardanoMode (Either EraMismatch (UTxO era)))
-> (Set AddressAny -> QueryInEra era (UTxO era))
-> Set AddressAny
-> QueryInMode CardanoMode (Either EraMismatch (UTxO era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era
-> QueryInShelleyBasedEra era (UTxO era)
-> QueryInEra era (UTxO era)
forall era result.
ShelleyBasedEra era
-> QueryInShelleyBasedEra era result -> QueryInEra era result
QueryInShelleyBasedEra ShelleyBasedEra era
sbe
        (QueryInShelleyBasedEra era (UTxO era)
 -> QueryInEra era (UTxO era))
-> (Set AddressAny -> QueryInShelleyBasedEra era (UTxO era))
-> Set AddressAny
-> QueryInEra era (UTxO era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
forall era.
QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era)
QueryUTxO
        (QueryUTxOFilter -> QueryInShelleyBasedEra era (UTxO era))
-> (Set AddressAny -> QueryUTxOFilter)
-> Set AddressAny
-> QueryInShelleyBasedEra era (UTxO era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set AddressAny -> QueryUTxOFilter
QueryUTxOByAddress
        (Set AddressAny -> MantraM m (Either EraMismatch (UTxO era)))
-> Set AddressAny -> MantraM m (Either EraMismatch (UTxO era))
forall a b. (a -> b) -> a -> b
$ AddressAny -> Set AddressAny
forall a. a -> Set a
S.singleton AddressAny
address
    Either EraMismatch (UTxO era) -> MantraM m (UTxO era)
forall (m :: * -> *) e a.
(Monad m, Show e) =>
Either e a -> MantraM m a
foistMantraEither Either EraMismatch (UTxO era)
utxo


-- | Submit a transaction.
submitTransaction :: IsCardanoEra era
                  => MonadIO m
                  => ShelleyBasedEra era                                            -- ^ The era.
                  -> FilePath                                                       -- ^ Path to the node's socket.
                  -> ConsensusModeParams CardanoMode                                -- ^ The consensus mode.
                  -> NetworkId                                                      -- ^ The network.
                  -> Tx era                                                         -- ^ The transaction.
                  -> MantraM m (SubmitResult (TxValidationErrorInMode CardanoMode)) -- ^ Action to submit the transaction and return its result.
submitTransaction :: ShelleyBasedEra era
-> FilePath
-> ConsensusModeParams CardanoMode
-> NetworkId
-> Tx era
-> MantraM m (SubmitResult (TxValidationErrorInMode CardanoMode))
submitTransaction ShelleyBasedEra era
sbe FilePath
socketPath ConsensusModeParams CardanoMode
mode NetworkId
network Tx era
tx =
  do
    let
      Just EraInMode era CardanoMode
eraInMode = CardanoEra era
-> ConsensusMode CardanoMode -> Maybe (EraInMode era CardanoMode)
forall era mode.
CardanoEra era -> ConsensusMode mode -> Maybe (EraInMode era mode)
toEraInMode (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
shelleyBasedToCardanoEra ShelleyBasedEra era
sbe) ConsensusMode CardanoMode
CardanoMode
      localNodeConnInfo :: LocalNodeConnectInfo CardanoMode
localNodeConnInfo = ConsensusModeParams CardanoMode
-> NetworkId -> FilePath -> LocalNodeConnectInfo CardanoMode
forall mode.
ConsensusModeParams mode
-> NetworkId -> FilePath -> LocalNodeConnectInfo mode
LocalNodeConnectInfo ConsensusModeParams CardanoMode
mode NetworkId
network FilePath
socketPath
    IO (SubmitResult (TxValidationErrorInMode CardanoMode))
-> MantraM m (SubmitResult (TxValidationErrorInMode CardanoMode))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SubmitResult (TxValidationErrorInMode CardanoMode))
 -> MantraM m (SubmitResult (TxValidationErrorInMode CardanoMode)))
-> IO (SubmitResult (TxValidationErrorInMode CardanoMode))
-> MantraM m (SubmitResult (TxValidationErrorInMode CardanoMode))
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo CardanoMode
-> TxInMode CardanoMode
-> IO (SubmitResult (TxValidationErrorInMode CardanoMode))
forall mode.
LocalNodeConnectInfo mode
-> TxInMode mode
-> IO (SubmitResult (TxValidationErrorInMode mode))
submitTxToNodeLocal LocalNodeConnectInfo CardanoMode
localNodeConnInfo
      (TxInMode CardanoMode
 -> IO (SubmitResult (TxValidationErrorInMode CardanoMode)))
-> TxInMode CardanoMode
-> IO (SubmitResult (TxValidationErrorInMode CardanoMode))
forall a b. (a -> b) -> a -> b
$ Tx era -> EraInMode era CardanoMode -> TxInMode CardanoMode
forall era mode. Tx era -> EraInMode era mode -> TxInMode mode
TxInMode Tx era
tx EraInMode era CardanoMode
eraInMode