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


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


module Mantra.Chain (
-- * Handlers
  Processor
, Reverter
, IdleNotifier
, ScriptHandler
, TxInHandler
, TxOutHandler
-- * Activity
, walkBlocks
, extractScripts
, watchTransactions
) where


import Cardano.Api (Block(..), BlockHeader(..), BlockInMode(..), CardanoMode, ChainPoint, ChainTip, ConsensusModeParams, EraInMode(..), IsCardanoEra, LocalNodeClientProtocols(..), LocalChainSyncClient(..), LocalNodeConnectInfo(..), NetworkId, ScriptHash, ShelleyBasedEra(..), SimpleScript, SimpleScriptV2, TxBody(..), TxBodyContent(..), TxId, TxIn(..), TxIx(..), TxOut(..), connectToLocalNode, getTxBody, getTxId)
import Cardano.Api.ChainSync.Client (ChainSyncClient(..), ClientStIdle(..), ClientStNext(..))
import Cardano.Api.Shelley          (TxBody(ShelleyTxBody))
import Control.Monad.Extra          (whenJust)
import Control.Monad.IO.Class       (MonadIO, liftIO)
import Data.Maybe                   (catMaybes)
import Mantra.Chain.Internal        (interpretAsScript)
import Mantra.Types                 (MantraM)

import qualified Cardano.Ledger.Crypto              as Ledger       (StandardCrypto)
import qualified Cardano.Ledger.Alonzo.Scripts      as LedgerAlonzo (Script(..))
import qualified Cardano.Ledger.ShelleyMA.Timelocks as ShelleyMA    (Timelock)


-- | Process a block.
type Processor =  BlockInMode CardanoMode -- ^ The block.
               -> ChainTip                -- ^ The chain tip.
               -> IO ()                   -- ^ Action to process activity.


-- | Handle a rollback.
type Reverter =  ChainPoint -- ^ The new chain point.
              -> ChainTip   -- ^ The chain tip.
              -> IO ()      -- ^ Action to handle the rollback.


-- | Peform action when idle.
type IdleNotifier = IO Bool -- ^ Action that returns whether processing should terminate.


-- | Process activity on the blockchain.
walkBlocks :: MonadIO m
           => FilePath                        -- ^ The path to the node's socket.
           -> ConsensusModeParams CardanoMode -- ^ The consensus mode.
           -> NetworkId                       -- ^ The network.
           -> IdleNotifier                    -- ^ Handle idleness.
           -> Maybe Reverter                  -- ^ Handle rollbacks.
           -> Processor                       -- ^ Handle blocks.
           -> MantraM m ()                    -- ^ Action to walk the blockchain.
walkBlocks :: FilePath
-> ConsensusModeParams CardanoMode
-> NetworkId
-> IdleNotifier
-> Maybe Reverter
-> Processor
-> MantraM m ()
walkBlocks FilePath
socketPath ConsensusModeParams CardanoMode
mode NetworkId
network IdleNotifier
notifyIdle Maybe Reverter
revertPoint Processor
processBlock =
  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
    protocols :: LocalNodeClientProtocols
  (BlockInMode CardanoMode)
  ChainPoint
  ChainTip
  (TxInMode CardanoMode)
  (TxValidationErrorInMode CardanoMode)
  (QueryInMode CardanoMode)
  IO
protocols =
      LocalNodeClientProtocols :: forall block point tip tx txerr (query :: * -> *) (m :: * -> *).
LocalChainSyncClient block point tip m
-> Maybe (LocalTxSubmissionClient tx txerr m ())
-> Maybe (LocalStateQueryClient block point query m ())
-> LocalNodeClientProtocols block point tip tx txerr query m
LocalNodeClientProtocols
      {
        localChainSyncClient :: LocalChainSyncClient
  (BlockInMode CardanoMode) ChainPoint ChainTip IO
localChainSyncClient    = ChainSyncClient (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> LocalChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO
forall block point tip (m :: * -> *).
ChainSyncClient block point tip m ()
-> LocalChainSyncClient block point tip m
LocalChainSyncClient (ChainSyncClient
   (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
 -> LocalChainSyncClient
      (BlockInMode CardanoMode) ChainPoint ChainTip IO)
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> LocalChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO
forall a b. (a -> b) -> a -> b
$ IdleNotifier
-> Maybe Reverter
-> Processor
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
client IdleNotifier
notifyIdle Maybe Reverter
revertPoint Processor
processBlock
      , localTxSubmissionClient :: Maybe
  (LocalTxSubmissionClient
     (TxInMode CardanoMode) (TxValidationErrorInMode CardanoMode) IO ())
localTxSubmissionClient = Maybe
  (LocalTxSubmissionClient
     (TxInMode CardanoMode) (TxValidationErrorInMode CardanoMode) IO ())
forall a. Maybe a
Nothing
      , localStateQueryClient :: Maybe
  (LocalStateQueryClient
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ())
localStateQueryClient   = Maybe
  (LocalStateQueryClient
     (BlockInMode CardanoMode)
     ChainPoint
     (QueryInMode CardanoMode)
     IO
     ())
forall a. Maybe a
Nothing
      }
  in
    IO () -> MantraM m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
      (IO () -> MantraM m ()) -> IO () -> MantraM m ()
forall a b. (a -> b) -> a -> b
$ LocalNodeConnectInfo CardanoMode
-> LocalNodeClientProtocols
     (BlockInMode CardanoMode)
     ChainPoint
     ChainTip
     (TxInMode CardanoMode)
     (TxValidationErrorInMode CardanoMode)
     (QueryInMode CardanoMode)
     IO
-> IO ()
forall mode.
LocalNodeConnectInfo mode
-> LocalNodeClientProtocolsInMode mode -> IO ()
connectToLocalNode LocalNodeConnectInfo CardanoMode
localNodeConnInfo LocalNodeClientProtocols
  (BlockInMode CardanoMode)
  ChainPoint
  ChainTip
  (TxInMode CardanoMode)
  (TxValidationErrorInMode CardanoMode)
  (QueryInMode CardanoMode)
  IO
protocols


-- | Chain synchronization client.
client :: IdleNotifier                                                        -- ^ Handle idleness.
       -> Maybe Reverter                                                      -- ^ Handle rollbacks.
       -> Processor                                                           -- ^ Handle blocks.
       -> ChainSyncClient (BlockInMode CardanoMode) ChainPoint ChainTip IO () -- ^ The chain synchronization client.
client :: IdleNotifier
-> Maybe Reverter
-> Processor
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
client IdleNotifier
notifyIdle Maybe Reverter
revertPoint Processor
processBlock =
  IO
  (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSyncClient
    (IO
   (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
 -> ChainSyncClient
      (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$ let
        clientStIdle :: IO
  (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
clientStIdle =
          ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return
            (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
 -> IO
      (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()))
-> (IO
      (ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
    -> ClientStIdle
         (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> IO
     (ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> IO
     (ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
ClientStNext header point tip m a
-> m (ClientStNext header point tip m a)
-> ClientStIdle header point tip m a
SendMsgRequestNext ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
clientStNext
            (IO
   (ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
 -> IO
      (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ()))
-> IO
     (ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
forall a b. (a -> b) -> a -> b
$ do
              Bool
terminate <- IdleNotifier
notifyIdle
              if Bool
terminate
                then IO
  (ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
forall header point tip. IO (ClientStNext header point tip IO ())
clientDone
                else ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
-> IO
     (ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
clientStNext
        clientStNext :: ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
clientStNext =
          ClientStNext :: forall header point tip (m :: * -> *) a.
(header -> tip -> ChainSyncClient header point tip m a)
-> (point -> tip -> ChainSyncClient header point tip m a)
-> ClientStNext header point tip m a
ClientStNext
          {
            recvMsgRollForward :: BlockInMode CardanoMode
-> ChainTip
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
recvMsgRollForward  = \BlockInMode CardanoMode
block ChainTip
tip -> IO
  (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSyncClient (IO
   (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
 -> ChainSyncClient
      (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$ Processor
processBlock BlockInMode CardanoMode
block ChainTip
tip
                                                                IO ()
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO
  (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
clientStIdle
          , recvMsgRollBackward :: ChainPoint
-> ChainTip
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
recvMsgRollBackward = \ChainPoint
point ChainTip
tip -> IO
  (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSyncClient (IO
   (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
 -> ChainSyncClient
      (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> ChainSyncClient
     (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Reverter -> (Reverter -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Reverter
revertPoint (\Reverter
f -> Reverter
f ChainPoint
point ChainTip
tip)
                                                                IO ()
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
-> IO
     (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO
  (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
clientStIdle
          }
        clientDone :: IO (ClientStNext header point tip IO ())
clientDone =
          ClientStNext header point tip IO ()
-> IO (ClientStNext header point tip IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return
            (ClientStNext header point tip IO ()
 -> IO (ClientStNext header point tip IO ()))
-> ClientStNext header point tip IO ()
-> IO (ClientStNext header point tip IO ())
forall a b. (a -> b) -> a -> b
$ ClientStNext :: forall header point tip (m :: * -> *) a.
(header -> tip -> ChainSyncClient header point tip m a)
-> (point -> tip -> ChainSyncClient header point tip m a)
-> ClientStNext header point tip m a
ClientStNext
              {
                recvMsgRollForward :: header -> tip -> ChainSyncClient header point tip IO ()
recvMsgRollForward  = \header
_ tip
_ -> IO (ClientStIdle header point tip IO ())
-> ChainSyncClient header point tip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSyncClient (IO (ClientStIdle header point tip IO ())
 -> ChainSyncClient header point tip IO ())
-> (ClientStIdle header point tip IO ()
    -> IO (ClientStIdle header point tip IO ()))
-> ClientStIdle header point tip IO ()
-> ChainSyncClient header point tip IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientStIdle header point tip IO ()
-> IO (ClientStIdle header point tip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle header point tip IO ()
 -> ChainSyncClient header point tip IO ())
-> ClientStIdle header point tip IO ()
-> ChainSyncClient header point tip IO ()
forall a b. (a -> b) -> a -> b
$ () -> ClientStIdle header point tip IO ()
forall a header point tip (m :: * -> *).
a -> ClientStIdle header point tip m a
SendMsgDone ()
              , recvMsgRollBackward :: point -> tip -> ChainSyncClient header point tip IO ()
recvMsgRollBackward = \point
_ tip
_ -> IO (ClientStIdle header point tip IO ())
-> ChainSyncClient header point tip IO ()
forall header point tip (m :: * -> *) a.
m (ClientStIdle header point tip m a)
-> ChainSyncClient header point tip m a
ChainSyncClient (IO (ClientStIdle header point tip IO ())
 -> ChainSyncClient header point tip IO ())
-> (ClientStIdle header point tip IO ()
    -> IO (ClientStIdle header point tip IO ()))
-> ClientStIdle header point tip IO ()
-> ChainSyncClient header point tip IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientStIdle header point tip IO ()
-> IO (ClientStIdle header point tip IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle header point tip IO ()
 -> ChainSyncClient header point tip IO ())
-> ClientStIdle header point tip IO ()
-> ChainSyncClient header point tip IO ()
forall a b. (a -> b) -> a -> b
$ () -> ClientStIdle header point tip IO ()
forall a header point tip (m :: * -> *).
a -> ClientStIdle header point tip m a
SendMsgDone ()
              }
     in
      IO
  (ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO ())
clientStIdle


-- | Process a script.
type ScriptHandler =  BlockHeader                 -- ^ The block header.
                   -> TxId                        -- ^ The transaction identifier.
                   -> ScriptHash                  -- ^ The script's hash.
                   -> SimpleScript SimpleScriptV2 -- ^ The script.
                   -> IO ()                       -- ^ Action to process the script.


-- | Extract scripts from the blockchain.
extractScripts :: MonadIO m
               => FilePath                        -- ^ Path to the node's socket.
               -> ConsensusModeParams CardanoMode -- ^ Consensus mode.
               -> NetworkId                       -- ^ The network.
               -> IdleNotifier                    -- ^ Handle idleness.
               -> ScriptHandler                   -- ^ Handle a script.
               -> MantraM m ()                    -- ^ Action to extract scripts.
extractScripts :: FilePath
-> ConsensusModeParams CardanoMode
-> NetworkId
-> IdleNotifier
-> ScriptHandler
-> MantraM m ()
extractScripts FilePath
socketPath ConsensusModeParams CardanoMode
mode NetworkId
network IdleNotifier
notifyIdle ScriptHandler
handler =
  FilePath
-> ConsensusModeParams CardanoMode
-> NetworkId
-> IdleNotifier
-> Maybe Reverter
-> Processor
-> MantraM m ()
forall (m :: * -> *).
MonadIO m =>
FilePath
-> ConsensusModeParams CardanoMode
-> NetworkId
-> IdleNotifier
-> Maybe Reverter
-> Processor
-> MantraM m ()
walkBlocks FilePath
socketPath ConsensusModeParams CardanoMode
mode NetworkId
network IdleNotifier
notifyIdle Maybe Reverter
forall a. Maybe a
Nothing
    (Processor -> MantraM m ()) -> Processor -> MantraM m ()
forall a b. (a -> b) -> a -> b
$ ScriptHandler -> Processor
processScripts ScriptHandler
handler


-- | Process scripts.
processScripts :: ScriptHandler           -- ^ Handle a script.
               -> BlockInMode CardanoMode -- ^ The block.
               -> ChainTip                -- ^ The chain tip.
               -> IO ()                   -- ^ Action to process script.
processScripts :: ScriptHandler -> Processor
processScripts ScriptHandler
handler (BlockInMode (Block BlockHeader
header [Tx era]
txs) EraInMode era CardanoMode
_) ChainTip
_ =
  [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
    [
      Maybe (SimpleScript SimpleScriptV2, ScriptHash)
-> ((SimpleScript SimpleScriptV2, ScriptHash) -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (Timelock StandardCrypto
-> Maybe (SimpleScript SimpleScriptV2, ScriptHash)
interpretAsScript Timelock StandardCrypto
witness)
        (((SimpleScript SimpleScriptV2, ScriptHash) -> IO ()) -> IO ())
-> ((SimpleScript SimpleScriptV2, ScriptHash) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(SimpleScript SimpleScriptV2
script, ScriptHash
hash) -> ScriptHandler
handler BlockHeader
header TxId
txId ScriptHash
hash SimpleScript SimpleScriptV2
script
    |
      Tx era
tx <- [Tx era]
txs
    , let body :: TxBody era
body = Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody Tx era
tx
    , let txId :: TxId
txId = TxBody era -> TxId
forall era. TxBody era -> TxId
getTxId TxBody era
body
    , Timelock StandardCrypto
witness <- TxBody era -> [Timelock StandardCrypto]
forall era. TxBody era -> [Timelock StandardCrypto]
extractTimelocks TxBody era
body
    ]


-- | Extract the time-lock scripts from a transaction body.
extractTimelocks :: TxBody era                                 -- ^ The transaction body.
                 -> [ShelleyMA.Timelock Ledger.StandardCrypto] -- ^ The time-lock scripts.
extractTimelocks :: TxBody era -> [Timelock StandardCrypto]
extractTimelocks (ShelleyTxBody ShelleyBasedEra era
ShelleyBasedEraAllegra TxBody (ShelleyLedgerEra era)
_ [Script (ShelleyLedgerEra era)]
witnesses TxBodyScriptData era
_ Maybe (AuxiliaryData (ShelleyLedgerEra era))
_ TxScriptValidity era
_) = [Timelock StandardCrypto]
[Script (ShelleyLedgerEra era)]
witnesses
extractTimelocks (ShelleyTxBody ShelleyBasedEra era
ShelleyBasedEraMary    TxBody (ShelleyLedgerEra era)
_ [Script (ShelleyLedgerEra era)]
witnesses TxBodyScriptData era
_ Maybe (AuxiliaryData (ShelleyLedgerEra era))
_ TxScriptValidity era
_) = [Timelock StandardCrypto]
[Script (ShelleyLedgerEra era)]
witnesses
extractTimelocks (ShelleyTxBody ShelleyBasedEra era
ShelleyBasedEraAlonzo  TxBody (ShelleyLedgerEra era)
_ [Script (ShelleyLedgerEra era)]
witnesses TxBodyScriptData era
_ Maybe (AuxiliaryData (ShelleyLedgerEra era))
_ TxScriptValidity era
_) =
  [Maybe (Timelock StandardCrypto)] -> [Timelock StandardCrypto]
forall a. [Maybe a] -> [a]
catMaybes
    [
     case Script (AlonzoEra StandardCrypto)
witness of
       LedgerAlonzo.TimelockScript Timelock (Crypto (AlonzoEra StandardCrypto))
witness' -> Timelock StandardCrypto -> Maybe (Timelock StandardCrypto)
forall a. a -> Maybe a
Just Timelock StandardCrypto
Timelock (Crypto (AlonzoEra StandardCrypto))
witness'
       Script (AlonzoEra StandardCrypto)
_                                    -> Maybe (Timelock StandardCrypto)
forall a. Maybe a
Nothing
    |
      Script (AlonzoEra StandardCrypto)
witness <- [Script (ShelleyLedgerEra era)]
[Script (AlonzoEra StandardCrypto)]
witnesses
    ]
extractTimelocks TxBody era
_ = []


-- | Process a block.
type BlockHandler =  BlockHeader -- ^ The block header.
                  -> ChainTip    -- ^ The chain tip.
                  -> IO ()       -- ^ Action to process the block.


-- | Process a spent UTxO.
type TxInHandler =  BlockHeader -- ^ The block header.
                 -> TxIn        -- ^ The UTxO.
                 -> IO ()       -- ^ Action to process a spent UTxO.


-- | Process a transaction's output.
type TxOutHandler =  forall era
                  .  IsCardanoEra era
                  => BlockHeader   -- ^ The block header.
                  -> [TxIn]        -- ^ The spent UTxOs.
                  -> TxIn          -- ^ The output UTxO.
                  -> TxOut era     -- ^ The transaction output.
                  -> IO ()         -- ^ Action to process a transaction's output.


-- | Watch transactions on the blockchain. Note that transaction output is reported *before* spent UTxOs.
watchTransactions :: MonadIO m
                  => FilePath                        -- ^ Path to the node's socket.
                  -> ConsensusModeParams CardanoMode -- ^ The consensus mode.
                  -> NetworkId                       -- ^ The network.
                  -> Maybe Reverter                  -- ^ Handle rollbacks.
                  -> IdleNotifier                    -- ^ Handle idleness.
                  -> BlockHandler                    -- ^ Handle blocks.
                  -> TxInHandler                     -- ^ Handle spent UTxOs.
                  -> TxOutHandler                    -- ^ Handle transaction output.
                  -> MantraM m ()                    -- ^ Action to watch transactions.
watchTransactions :: FilePath
-> ConsensusModeParams CardanoMode
-> NetworkId
-> Maybe Reverter
-> IdleNotifier
-> BlockHandler
-> TxInHandler
-> TxOutHandler
-> MantraM m ()
watchTransactions FilePath
socketPath ConsensusModeParams CardanoMode
mode NetworkId
network Maybe Reverter
revertPoint IdleNotifier
notifyIdle BlockHandler
blockHandler TxInHandler
inHandler TxOutHandler
outHandler =
  FilePath
-> ConsensusModeParams CardanoMode
-> NetworkId
-> IdleNotifier
-> Maybe Reverter
-> Processor
-> MantraM m ()
forall (m :: * -> *).
MonadIO m =>
FilePath
-> ConsensusModeParams CardanoMode
-> NetworkId
-> IdleNotifier
-> Maybe Reverter
-> Processor
-> MantraM m ()
walkBlocks FilePath
socketPath ConsensusModeParams CardanoMode
mode NetworkId
network IdleNotifier
notifyIdle Maybe Reverter
revertPoint
    (Processor -> MantraM m ()) -> Processor -> MantraM m ()
forall a b. (a -> b) -> a -> b
$ BlockHandler -> TxInHandler -> TxOutHandler -> Processor
processTransactions BlockHandler
blockHandler TxInHandler
inHandler TxOutHandler
outHandler


-- | Process transactions.
processTransactions :: BlockHandler            -- ^ Handle blocks.
                    -> TxInHandler             -- ^ Handle spent UTxOs.
                    -> TxOutHandler            -- ^ Handle transaction output.
                    -> BlockInMode CardanoMode -- ^ The block.
                    -> ChainTip                -- ^ The chain tip.
                    -> IO ()                   -- ^ Action to process transactions.
processTransactions :: BlockHandler -> TxInHandler -> TxOutHandler -> Processor
processTransactions BlockHandler
blockHandler TxInHandler
inHandler TxOutHandler
outHandler (BlockInMode Block era
block EraInMode era CardanoMode
AlonzoEraInCardanoMode ) =
  BlockHandler
-> TxInHandler -> TxOutHandler -> Block era -> ChainTip -> IO ()
forall era.
IsCardanoEra era =>
BlockHandler
-> TxInHandler -> TxOutHandler -> Block era -> ChainTip -> IO ()
processTransactions' BlockHandler
blockHandler TxInHandler
inHandler TxOutHandler
outHandler Block era
block
processTransactions BlockHandler
blockHandler TxInHandler
inHandler TxOutHandler
outHandler (BlockInMode Block era
block EraInMode era CardanoMode
MaryEraInCardanoMode   ) =
  BlockHandler
-> TxInHandler -> TxOutHandler -> Block era -> ChainTip -> IO ()
forall era.
IsCardanoEra era =>
BlockHandler
-> TxInHandler -> TxOutHandler -> Block era -> ChainTip -> IO ()
processTransactions' BlockHandler
blockHandler TxInHandler
inHandler TxOutHandler
outHandler Block era
block
processTransactions BlockHandler
blockHandler TxInHandler
inHandler TxOutHandler
outHandler (BlockInMode Block era
block EraInMode era CardanoMode
AllegraEraInCardanoMode) =
  BlockHandler
-> TxInHandler -> TxOutHandler -> Block era -> ChainTip -> IO ()
forall era.
IsCardanoEra era =>
BlockHandler
-> TxInHandler -> TxOutHandler -> Block era -> ChainTip -> IO ()
processTransactions' BlockHandler
blockHandler TxInHandler
inHandler TxOutHandler
outHandler Block era
block
processTransactions BlockHandler
blockHandler TxInHandler
inHandler TxOutHandler
outHandler (BlockInMode Block era
block EraInMode era CardanoMode
ShelleyEraInCardanoMode) =
  BlockHandler
-> TxInHandler -> TxOutHandler -> Block era -> ChainTip -> IO ()
forall era.
IsCardanoEra era =>
BlockHandler
-> TxInHandler -> TxOutHandler -> Block era -> ChainTip -> IO ()
processTransactions' BlockHandler
blockHandler TxInHandler
inHandler TxOutHandler
outHandler Block era
block
processTransactions BlockHandler
blockHandler TxInHandler
inHandler TxOutHandler
outHandler (BlockInMode Block era
block EraInMode era CardanoMode
ByronEraInCardanoMode  ) =
  BlockHandler
-> TxInHandler -> TxOutHandler -> Block era -> ChainTip -> IO ()
forall era.
IsCardanoEra era =>
BlockHandler
-> TxInHandler -> TxOutHandler -> Block era -> ChainTip -> IO ()
processTransactions' BlockHandler
blockHandler TxInHandler
inHandler TxOutHandler
outHandler Block era
block


-- | Process transactions in a Cardano era.
processTransactions' :: IsCardanoEra era
                     => BlockHandler -- ^ Handle blocks.
                     -> TxInHandler  -- ^ Handle spent UTxOs.
                     -> TxOutHandler -- ^ Handle transaction output.
                     -> Block era    -- ^ The block.
                     -> ChainTip     -- ^ The chain tip.
                     -> IO ()        -- ^ Action to process transactions.
processTransactions' :: BlockHandler
-> TxInHandler -> TxOutHandler -> Block era -> ChainTip -> IO ()
processTransactions' BlockHandler
blockHandler TxInHandler
inHandler TxOutHandler
outHandler (Block BlockHeader
header [Tx era]
txs) ChainTip
tip =
  do
    BlockHandler
blockHandler BlockHeader
header ChainTip
tip
    [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
      [
        do
          [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
            [
              BlockHeader -> [TxIn] -> TxIn -> TxOut era -> IO ()
TxOutHandler
outHandler
                BlockHeader
header
                [TxIn]
txins
                (TxId -> TxIx -> TxIn
TxIn (TxBody era -> TxId
forall era. TxBody era -> TxId
getTxId TxBody era
body) (Word -> TxIx
TxIx Word
ix))
                TxOut era
txout
            |
              (Word
ix, TxOut era
txout) <- [Word] -> [TxOut era] -> [(Word, TxOut era)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0..] [TxOut era]
txouts
            ]
          [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
            [
              TxInHandler
inHandler BlockHeader
header TxIn
txin
            |
              TxIn
txin <- [TxIn]
txins
            ]
      |
        Tx era
tx <- [Tx era]
txs
      , let body :: TxBody era
body = Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody Tx era
tx
            TxBody TxBodyContent ViewTx era
content = TxBody era
body
            txins :: [TxIn]
txins  = (TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn era)) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn era)) -> TxIn)
-> [(TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn era))] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxBodyContent ViewTx era
-> [(TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn era))]
forall build era. TxBodyContent build era -> TxIns build era
txIns TxBodyContent ViewTx era
content
            txouts :: [TxOut era]
txouts = TxBodyContent ViewTx era -> [TxOut era]
forall build era. TxBodyContent build era -> [TxOut era]
txOuts TxBodyContent ViewTx era
content
      ]