{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}

module Plutus.Blockfrost.Queries (
    getTipBlockfrost
    , getDatumBlockfrost
    , getValidatorBlockfrost
    , getTxOutBlockfrost
    , getUnspentTxOutBlockfrost
    , getIsUtxoBlockfrost
    , getUtxoByAddressBlockfrost
    , getUnspentAtAddressBlockfrost
    , getDatumsAtAddressBlockfrost
    , getTxoAtAddressBlockfrost
    , getUtxoSetWithCurrency
    , getTxFromTxIdBlockfrost
    , getTxsFromTxIdsBlockfrost
    , defaultGetUtxo
    , defaultGetList
    , defaultIsUtxo
    ) where

import Control.Concurrent.Async (mapConcurrently)
import Control.Monad.Except (throwError)
import Control.Monad.Freer.Extras.Pagination (PageQuery (..))
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value)
import Data.Functor ((<&>))
import Data.Map (Map, fromList)
import Data.Maybe (catMaybes)
import Data.Text (Text)

import Blockfrost.Client

import Plutus.Blockfrost.Types


-- ENDPOINTS

getTipBlockfrost :: MonadBlockfrost m => m Block
getTipBlockfrost :: m Block
getTipBlockfrost = m Block
forall (m :: * -> *). MonadBlockfrost m => m Block
getLatestBlock

getDatumBlockfrost :: MonadBlockfrost m => DatumHash -> m Value
getDatumBlockfrost :: DatumHash -> m Value
getDatumBlockfrost DatumHash
dHash = DatumHash -> m ScriptDatum
forall (m :: * -> *).
MonadBlockfrost m =>
DatumHash -> m ScriptDatum
getScriptDatum DatumHash
dHash m ScriptDatum -> (ScriptDatum -> Value) -> m Value
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ScriptDatum -> Value
_scriptDatumJsonValue

getValidatorBlockfrost :: MonadBlockfrost m => ScriptHash -> m ScriptCBOR
getValidatorBlockfrost :: ScriptHash -> m ScriptCBOR
getValidatorBlockfrost = ScriptHash -> m ScriptCBOR
forall (m :: * -> *).
MonadBlockfrost m =>
ScriptHash -> m ScriptCBOR
getScriptCBOR

getTxOutBlockfrost :: (TxHash, Integer) -> BlockfrostClient UtxoOutput
getTxOutBlockfrost :: (TxHash, Integer) -> BlockfrostClient UtxoOutput
getTxOutBlockfrost (TxHash
tHash, Integer
idx) = do
    [UtxoOutput]
txos <- TxHash -> BlockfrostClientT IO TransactionUtxos
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m TransactionUtxos
getTxUtxos TxHash
tHash BlockfrostClientT IO TransactionUtxos
-> (TransactionUtxos -> [UtxoOutput])
-> BlockfrostClientT IO [UtxoOutput]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TransactionUtxos -> [UtxoOutput]
_transactionUtxosOutputs
    case [UtxoOutput] -> [UtxoOutput]
filterByIndex [UtxoOutput]
txos of
        []  -> BlockfrostError -> BlockfrostClient UtxoOutput
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError BlockfrostError
BlockfrostNotFound
        [UtxoOutput
x] -> UtxoOutput -> BlockfrostClient UtxoOutput
forall (f :: * -> *) a. Applicative f => a -> f a
pure UtxoOutput
x
        [UtxoOutput]
_   -> BlockfrostError -> BlockfrostClient UtxoOutput
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (BlockfrostError -> BlockfrostClient UtxoOutput)
-> BlockfrostError -> BlockfrostClient UtxoOutput
forall a b. (a -> b) -> a -> b
$ Text -> BlockfrostError
BlockfrostError Text
"Multiple UTxOs with the same index found!!!"
  where
    filterByIndex :: [UtxoOutput] -> [UtxoOutput]
    filterByIndex :: [UtxoOutput] -> [UtxoOutput]
filterByIndex = (UtxoOutput -> Bool) -> [UtxoOutput] -> [UtxoOutput]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(==) Integer
idx (Integer -> Bool) -> (UtxoOutput -> Integer) -> UtxoOutput -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoOutput -> Integer
_utxoOutputOutputIndex)

getUnspentTxOutBlockfrost :: (TxHash, Integer) -> BlockfrostClient UtxoOutput
getUnspentTxOutBlockfrost :: (TxHash, Integer) -> BlockfrostClient UtxoOutput
getUnspentTxOutBlockfrost (TxHash, Integer)
ref = do
    UtxoOutput
txo <- (TxHash, Integer) -> BlockfrostClient UtxoOutput
getTxOutBlockfrost (TxHash, Integer)
ref
    Bool
isUtxo <- (TxHash, Integer) -> BlockfrostClientT IO Bool
forall (m :: * -> *).
MonadBlockfrost m =>
(TxHash, Integer) -> m Bool
checkIsUtxo (TxHash, Integer)
ref
    if Bool
isUtxo then UtxoOutput -> BlockfrostClient UtxoOutput
forall (f :: * -> *) a. Applicative f => a -> f a
pure UtxoOutput
txo else BlockfrostError -> BlockfrostClient UtxoOutput
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError BlockfrostError
BlockfrostNotFound

getIsUtxoBlockfrost :: MonadBlockfrost m => (TxHash, Integer) -> m (Block, Bool)
getIsUtxoBlockfrost :: (TxHash, Integer) -> m (Block, Bool)
getIsUtxoBlockfrost (TxHash, Integer)
ref = do
    Block
tip <- m Block
forall (m :: * -> *). MonadBlockfrost m => m Block
getTipBlockfrost
    Bool
isUtxo <- (TxHash, Integer) -> m Bool
forall (m :: * -> *).
MonadBlockfrost m =>
(TxHash, Integer) -> m Bool
checkIsUtxo (TxHash, Integer)
ref
    (Block, Bool) -> m (Block, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Block
tip, Bool
isUtxo)

getUtxoByAddressBlockfrost :: MonadBlockfrost m => PageQuery a -> Address -> m (Block, [AddressUtxo])
getUtxoByAddressBlockfrost :: PageQuery a -> Address -> m (Block, [AddressUtxo])
getUtxoByAddressBlockfrost PageQuery a
_ Address
addr = do
    Block
tip <- m Block
forall (m :: * -> *). MonadBlockfrost m => m Block
getTipBlockfrost
    [AddressUtxo]
utxos <- (Paged -> m [AddressUtxo]) -> m [AddressUtxo]
forall (m :: * -> *) a. Monad m => (Paged -> m [a]) -> m [a]
allPages ((Address -> Paged -> SortOrder -> m [AddressUtxo])
-> Address -> Paged -> m [AddressUtxo]
forall a (m :: * -> *) b.
(a -> Paged -> SortOrder -> m [b]) -> a -> Paged -> m [b]
wrapperPaged Address -> Paged -> SortOrder -> m [AddressUtxo]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Paged -> SortOrder -> m [AddressUtxo]
getAddressUtxos' Address
addr)
    (Block, [AddressUtxo]) -> m (Block, [AddressUtxo])
forall (m :: * -> *) a. Monad m => a -> m a
return (Block
tip, [AddressUtxo]
utxos)

getUnspentAtAddressBlockfrost :: MonadBlockfrost m => PageQuery a -> Address -> m [AddressUtxo]
getUnspentAtAddressBlockfrost :: PageQuery a -> Address -> m [AddressUtxo]
getUnspentAtAddressBlockfrost PageQuery a
_ Address
addr = (Paged -> m [AddressUtxo]) -> m [AddressUtxo]
forall (m :: * -> *) a. Monad m => (Paged -> m [a]) -> m [a]
allPages ((Address -> Paged -> SortOrder -> m [AddressUtxo])
-> Address -> Paged -> m [AddressUtxo]
forall a (m :: * -> *) b.
(a -> Paged -> SortOrder -> m [b]) -> a -> Paged -> m [b]
wrapperPaged Address -> Paged -> SortOrder -> m [AddressUtxo]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Paged -> SortOrder -> m [AddressUtxo]
getAddressUtxos' Address
addr)

getDatumsAtAddressBlockfrost :: MonadBlockfrost m => PageQuery a -> Address -> m [Value]
getDatumsAtAddressBlockfrost :: PageQuery a -> Address -> m [Value]
getDatumsAtAddressBlockfrost PageQuery a
p Address
a = do
  -- get all txouts at address
  [UtxoInput]
txos <- PageQuery a -> Address -> m [UtxoInput]
forall (m :: * -> *) a.
MonadBlockfrost m =>
PageQuery a -> Address -> m [UtxoInput]
getTxoAtAddressBlockfrost PageQuery a
p Address
a
  let dhs :: [DatumHash]
dhs = [Maybe DatumHash] -> [DatumHash]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe DatumHash] -> [DatumHash])
-> [Maybe DatumHash] -> [DatumHash]
forall a b. (a -> b) -> a -> b
$ UtxoInput -> Maybe DatumHash
_utxoInputDataHash (UtxoInput -> Maybe DatumHash) -> [UtxoInput] -> [Maybe DatumHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UtxoInput]
txos
  IO [Value] -> m [Value]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Value] -> m [Value]) -> IO [Value] -> m [Value]
forall a b. (a -> b) -> a -> b
$ (DatumHash -> IO Value) -> [DatumHash] -> IO [Value]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently DatumHash -> IO Value
forall (m :: * -> *). MonadBlockfrost m => DatumHash -> m Value
getDatumBlockfrost [DatumHash]
dhs

getTxoAtAddressBlockfrost :: MonadBlockfrost m => PageQuery a -> Address -> m [UtxoInput]
getTxoAtAddressBlockfrost :: PageQuery a -> Address -> m [UtxoInput]
getTxoAtAddressBlockfrost PageQuery a
_ Address
a = do
    [AddressTransaction]
addTxs <- (Paged -> m [AddressTransaction]) -> m [AddressTransaction]
forall (m :: * -> *) a. Monad m => (Paged -> m [a]) -> m [a]
allPages ((Address
 -> Paged
 -> SortOrder
 -> Maybe BlockIndex
 -> Maybe BlockIndex
 -> m [AddressTransaction])
-> Address -> Paged -> m [AddressTransaction]
forall a b (m :: * -> *) c.
(a -> Paged -> SortOrder -> Maybe b -> Maybe b -> m [c])
-> a -> Paged -> m [c]
wrapperPagedTx Address
-> Paged
-> SortOrder
-> Maybe BlockIndex
-> Maybe BlockIndex
-> m [AddressTransaction]
forall (m :: * -> *).
MonadBlockfrost m =>
Address
-> Paged
-> SortOrder
-> Maybe BlockIndex
-> Maybe BlockIndex
-> m [AddressTransaction]
getAddressTransactions' Address
a)
    [TransactionUtxos]
txUtxos <- IO [TransactionUtxos] -> m [TransactionUtxos]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TransactionUtxos] -> m [TransactionUtxos])
-> IO [TransactionUtxos] -> m [TransactionUtxos]
forall a b. (a -> b) -> a -> b
$ (AddressTransaction -> IO TransactionUtxos)
-> [AddressTransaction] -> IO [TransactionUtxos]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently (TxHash -> IO TransactionUtxos
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m TransactionUtxos
getTxUtxos (TxHash -> IO TransactionUtxos)
-> (AddressTransaction -> TxHash)
-> AddressTransaction
-> IO TransactionUtxos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressTransaction -> TxHash
_addressTransactionTxHash) [AddressTransaction]
addTxs
    let txos :: [UtxoInput]
txos = (TransactionUtxos -> [UtxoInput])
-> [TransactionUtxos] -> [UtxoInput]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TransactionUtxos -> [UtxoInput]
_transactionUtxosInputs [TransactionUtxos]
txUtxos
    [UtxoInput] -> m [UtxoInput]
forall (m :: * -> *) a. Monad m => a -> m a
return ([UtxoInput] -> m [UtxoInput]) -> [UtxoInput] -> m [UtxoInput]
forall a b. (a -> b) -> a -> b
$ (UtxoInput -> Bool) -> [UtxoInput] -> [UtxoInput]
forall a. (a -> Bool) -> [a] -> [a]
filter (Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
(==) Address
a (Address -> Bool) -> (UtxoInput -> Address) -> UtxoInput -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoInput -> Address
_utxoInputAddress) [UtxoInput]
txos

getUtxoSetWithCurrency :: MonadBlockfrost m => PageQuery a -> AssetId -> m (Block, [AddressUtxo])
getUtxoSetWithCurrency :: PageQuery a -> AssetId -> m (Block, [AddressUtxo])
getUtxoSetWithCurrency PageQuery a
_ AssetId
assetId = do
    Block
tip <- m Block
forall (m :: * -> *). MonadBlockfrost m => m Block
getTipBlockfrost
    [AssetAddress]
xs <- (Paged -> m [AssetAddress]) -> m [AssetAddress]
forall (m :: * -> *) a. Monad m => (Paged -> m [a]) -> m [a]
allPages ((AssetId -> Paged -> SortOrder -> m [AssetAddress])
-> AssetId -> Paged -> m [AssetAddress]
forall a (m :: * -> *) b.
(a -> Paged -> SortOrder -> m [b]) -> a -> Paged -> m [b]
wrapperPaged AssetId -> Paged -> SortOrder -> m [AssetAddress]
forall (m :: * -> *).
MonadBlockfrost m =>
AssetId -> Paged -> SortOrder -> m [AssetAddress]
getAssetAddresses' AssetId
assetId)
    [[AddressUtxo]]
utxos <- IO [[AddressUtxo]] -> m [[AddressUtxo]]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[AddressUtxo]] -> m [[AddressUtxo]])
-> IO [[AddressUtxo]] -> m [[AddressUtxo]]
forall a b. (a -> b) -> a -> b
$ (AssetAddress -> IO [AddressUtxo])
-> [AssetAddress] -> IO [[AddressUtxo]]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently ((Address -> AssetId -> IO [AddressUtxo])
-> AssetId -> Address -> IO [AddressUtxo]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Address -> AssetId -> IO [AddressUtxo]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> AssetId -> m [AddressUtxo]
getAddressUtxosAsset AssetId
assetId (Address -> IO [AddressUtxo])
-> (AssetAddress -> Address) -> AssetAddress -> IO [AddressUtxo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssetAddress -> Address
_assetAddressAddress) [AssetAddress]
xs
    (Block, [AddressUtxo]) -> m (Block, [AddressUtxo])
forall (m :: * -> *) a. Monad m => a -> m a
return (Block
tip, [[AddressUtxo]] -> [AddressUtxo]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[AddressUtxo]]
utxos)

getTxFromTxIdBlockfrost :: MonadBlockfrost m => TxHash -> m TxResponse
getTxFromTxIdBlockfrost :: TxHash -> m TxResponse
getTxFromTxIdBlockfrost TxHash
tHash = do
    Transaction
specificTx <- TxHash -> m Transaction
forall (m :: * -> *). MonadBlockfrost m => TxHash -> m Transaction
getTx TxHash
tHash
    TransactionUtxos
txUtxos <- TxHash -> m TransactionUtxos
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m TransactionUtxos
getTxUtxos TxHash
tHash
    Map Text ScriptDatum
datumMap <- TransactionUtxos -> m (Map Text ScriptDatum)
forall (m :: * -> *).
MonadBlockfrost m =>
TransactionUtxos -> m (Map Text ScriptDatum)
getAllTxDatums TransactionUtxos
txUtxos
    [TransactionRedeemer]
redeemers <- TxHash -> m [TransactionRedeemer]
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m [TransactionRedeemer]
getTxRedeemers TxHash
tHash
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. Show a => a -> IO ()
print ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"INPUTS: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [UtxoInput] -> [Char]
forall a. Show a => a -> [Char]
show (TransactionUtxos -> [UtxoInput]
_transactionUtxosInputs TransactionUtxos
txUtxos)
    let scriptHashes :: [ScriptHash]
scriptHashes = (TransactionRedeemer -> ScriptHash)
-> [TransactionRedeemer] -> [ScriptHash]
forall a b. (a -> b) -> [a] -> [b]
map TransactionRedeemer -> ScriptHash
_transactionRedeemerScriptHash [TransactionRedeemer]
redeemers
    [(Integer, (ValidationPurpose, ScriptDatum))]
redeemersList <- IO [(Integer, (ValidationPurpose, ScriptDatum))]
-> m [(Integer, (ValidationPurpose, ScriptDatum))]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Integer, (ValidationPurpose, ScriptDatum))]
 -> m [(Integer, (ValidationPurpose, ScriptDatum))])
-> IO [(Integer, (ValidationPurpose, ScriptDatum))]
-> m [(Integer, (ValidationPurpose, ScriptDatum))]
forall a b. (a -> b) -> a -> b
$ (TransactionRedeemer
 -> IO (Integer, (ValidationPurpose, ScriptDatum)))
-> [TransactionRedeemer]
-> IO [(Integer, (ValidationPurpose, ScriptDatum))]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently TransactionRedeemer
-> IO (Integer, (ValidationPurpose, ScriptDatum))
getRedeemersList [TransactionRedeemer]
redeemers
    [(Text, ScriptCBOR)]
scriptsList <- IO [(Text, ScriptCBOR)] -> m [(Text, ScriptCBOR)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Text, ScriptCBOR)] -> m [(Text, ScriptCBOR)])
-> IO [(Text, ScriptCBOR)] -> m [(Text, ScriptCBOR)]
forall a b. (a -> b) -> a -> b
$ (ScriptHash -> IO (Text, ScriptCBOR))
-> [ScriptHash] -> IO [(Text, ScriptCBOR)]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently (\ScriptHash
sHash -> (ScriptHash -> Text
unScriptHash ScriptHash
sHash,) (ScriptCBOR -> (Text, ScriptCBOR))
-> IO ScriptCBOR -> IO (Text, ScriptCBOR)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptHash -> IO ScriptCBOR
forall (m :: * -> *).
MonadBlockfrost m =>
ScriptHash -> m ScriptCBOR
getScriptCBOR ScriptHash
sHash) [ScriptHash]
scriptHashes
    TxResponse -> m TxResponse
forall (m :: * -> *) a. Monad m => a -> m a
return (TxResponse -> m TxResponse) -> TxResponse -> m TxResponse
forall a b. (a -> b) -> a -> b
$ TxResponse :: TxHash
-> Maybe Text
-> Maybe Text
-> [UtxoInput]
-> [UtxoOutput]
-> Map Text ScriptDatum
-> Map Integer (ValidationPurpose, ScriptDatum)
-> Map Text ScriptCBOR
-> TxResponse
TxResponse { _txHash :: TxHash
_txHash        = TxHash
tHash
                        , _invalidBefore :: Maybe Text
_invalidBefore = Transaction -> Maybe Text
_transactionInvalidBefore Transaction
specificTx
                        , _invalidAfter :: Maybe Text
_invalidAfter  = Transaction -> Maybe Text
_transactionInvalidHereafter Transaction
specificTx
                        , _utxosInputs :: [UtxoInput]
_utxosInputs   = TransactionUtxos -> [UtxoInput]
_transactionUtxosInputs TransactionUtxos
txUtxos
                        , _utxosOutpus :: [UtxoOutput]
_utxosOutpus   = TransactionUtxos -> [UtxoOutput]
_transactionUtxosOutputs TransactionUtxos
txUtxos
                        , _datumsMap :: Map Text ScriptDatum
_datumsMap     = Map Text ScriptDatum
datumMap
                        , _redeemersMap :: Map Integer (ValidationPurpose, ScriptDatum)
_redeemersMap  = [(Integer, (ValidationPurpose, ScriptDatum))]
-> Map Integer (ValidationPurpose, ScriptDatum)
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(Integer, (ValidationPurpose, ScriptDatum))]
redeemersList
                        , _scriptsMap :: Map Text ScriptCBOR
_scriptsMap    = [(Text, ScriptCBOR)] -> Map Text ScriptCBOR
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(Text, ScriptCBOR)]
scriptsList
                        }
  where
    getRedeemersList :: TransactionRedeemer -> IO (Integer, (ValidationPurpose, ScriptDatum))
    getRedeemersList :: TransactionRedeemer
-> IO (Integer, (ValidationPurpose, ScriptDatum))
getRedeemersList TransactionRedeemer
red = do
        let idx :: Integer
idx     = TransactionRedeemer -> Integer
_transactionRedeemerTxIndex TransactionRedeemer
red
            purp :: ValidationPurpose
purp = TransactionRedeemer -> ValidationPurpose
_transactionRedeemerPurpose TransactionRedeemer
red
            dh :: DatumHash
dh      = TransactionRedeemer -> DatumHash
_transactionRedeemerDatumHash TransactionRedeemer
red
        ScriptDatum
dat <- DatumHash -> IO ScriptDatum
forall (m :: * -> *).
MonadBlockfrost m =>
DatumHash -> m ScriptDatum
getScriptDatum DatumHash
dh
        (Integer, (ValidationPurpose, ScriptDatum))
-> IO (Integer, (ValidationPurpose, ScriptDatum))
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
idx, (ValidationPurpose
purp  , ScriptDatum
dat))

getTxsFromTxIdsBlockfrost :: MonadBlockfrost m => [TxHash] -> m [TxResponse]
getTxsFromTxIdsBlockfrost :: [TxHash] -> m [TxResponse]
getTxsFromTxIdsBlockfrost = IO [TxResponse] -> m [TxResponse]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TxResponse] -> m [TxResponse])
-> ([TxHash] -> IO [TxResponse]) -> [TxHash] -> m [TxResponse]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxHash -> IO TxResponse) -> [TxHash] -> IO [TxResponse]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently TxHash -> IO TxResponse
forall (m :: * -> *). MonadBlockfrost m => TxHash -> m TxResponse
getTxFromTxIdBlockfrost

-- UTIL FUNCTIONS

getAllTxDatums :: MonadBlockfrost m => TransactionUtxos -> m (Map Text ScriptDatum)
getAllTxDatums :: TransactionUtxos -> m (Map Text ScriptDatum)
getAllTxDatums TransactionUtxos
utxos = do
    let inps :: [Maybe DatumHash]
inps = (UtxoInput -> Maybe DatumHash) -> [UtxoInput] -> [Maybe DatumHash]
forall a b. (a -> b) -> [a] -> [b]
map UtxoInput -> Maybe DatumHash
_utxoInputDataHash (TransactionUtxos -> [UtxoInput]
_transactionUtxosInputs TransactionUtxos
utxos)
        outs :: [Maybe DatumHash]
outs = (UtxoOutput -> Maybe DatumHash)
-> [UtxoOutput] -> [Maybe DatumHash]
forall a b. (a -> b) -> [a] -> [b]
map UtxoOutput -> Maybe DatumHash
_utxoOutputDataHash (TransactionUtxos -> [UtxoOutput]
_transactionUtxosOutputs TransactionUtxos
utxos)
        datumHashes :: [DatumHash]
datumHashes = [Maybe DatumHash] -> [DatumHash]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe DatumHash]
inps [Maybe DatumHash] -> [Maybe DatumHash] -> [Maybe DatumHash]
forall a. [a] -> [a] -> [a]
++ [Maybe DatumHash]
outs)
    [(Text, ScriptDatum)]
datumMap <- IO [(Text, ScriptDatum)] -> m [(Text, ScriptDatum)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Text, ScriptDatum)] -> m [(Text, ScriptDatum)])
-> IO [(Text, ScriptDatum)] -> m [(Text, ScriptDatum)]
forall a b. (a -> b) -> a -> b
$ (DatumHash -> IO (Text, ScriptDatum))
-> [DatumHash] -> IO [(Text, ScriptDatum)]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently (\DatumHash
dHash -> (DatumHash -> Text
unDatumHash DatumHash
dHash,) (ScriptDatum -> (Text, ScriptDatum))
-> IO ScriptDatum -> IO (Text, ScriptDatum)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatumHash -> IO ScriptDatum
forall (m :: * -> *).
MonadBlockfrost m =>
DatumHash -> m ScriptDatum
getScriptDatum DatumHash
dHash) [DatumHash]
datumHashes
    Map Text ScriptDatum -> m (Map Text ScriptDatum)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text ScriptDatum -> m (Map Text ScriptDatum))
-> Map Text ScriptDatum -> m (Map Text ScriptDatum)
forall a b. (a -> b) -> a -> b
$ [(Text, ScriptDatum)] -> Map Text ScriptDatum
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(Text, ScriptDatum)]
datumMap

getAddressFromReference :: MonadBlockfrost m => (TxHash, Integer) -> m (Maybe Address)
getAddressFromReference :: (TxHash, Integer) -> m (Maybe Address)
getAddressFromReference (TxHash
tHash, Integer
idx) = TxHash -> m TransactionUtxos
forall (m :: * -> *).
MonadBlockfrost m =>
TxHash -> m TransactionUtxos
getTxUtxos TxHash
tHash m TransactionUtxos
-> (TransactionUtxos -> Maybe Address) -> m (Maybe Address)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([UtxoOutput] -> Maybe Address
getAddress ([UtxoOutput] -> Maybe Address)
-> (TransactionUtxos -> [UtxoOutput])
-> TransactionUtxos
-> Maybe Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionUtxos -> [UtxoOutput]
_transactionUtxosOutputs)
  where
    getAddress :: [UtxoOutput] -> Maybe Address
    getAddress :: [UtxoOutput] -> Maybe Address
getAddress [UtxoOutput]
outs = case (UtxoOutput -> Bool) -> [UtxoOutput] -> [UtxoOutput]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(==) Integer
idx (Integer -> Bool) -> (UtxoOutput -> Integer) -> UtxoOutput -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoOutput -> Integer
_utxoOutputOutputIndex) [UtxoOutput]
outs of
        [UtxoOutput
out] -> Address -> Maybe Address
forall a. a -> Maybe a
Just (Address -> Maybe Address) -> Address -> Maybe Address
forall a b. (a -> b) -> a -> b
$ UtxoOutput -> Address
_utxoOutputAddress UtxoOutput
out
        [UtxoOutput]
_     -> Maybe Address
forall a. Maybe a
Nothing

checkIsUtxo :: MonadBlockfrost m => (TxHash, Integer) -> m Bool
checkIsUtxo :: (TxHash, Integer) -> m Bool
checkIsUtxo ref :: (TxHash, Integer)
ref@(TxHash
tHash, Integer
idx) = (TxHash, Integer) -> m (Maybe Address)
forall (m :: * -> *).
MonadBlockfrost m =>
(TxHash, Integer) -> m (Maybe Address)
getAddressFromReference (TxHash, Integer)
ref m (Maybe Address)
-> (Maybe Address -> m [AddressUtxo]) -> m [AddressUtxo]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m [AddressUtxo]
-> (Address -> m [AddressUtxo]) -> Maybe Address -> m [AddressUtxo]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([AddressUtxo] -> m [AddressUtxo]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) ((Paged -> m [AddressUtxo]) -> m [AddressUtxo]
forall (m :: * -> *) a. Monad m => (Paged -> m [a]) -> m [a]
allPages ((Paged -> m [AddressUtxo]) -> m [AddressUtxo])
-> (Address -> Paged -> m [AddressUtxo])
-> Address
-> m [AddressUtxo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Address -> Paged -> SortOrder -> m [AddressUtxo])
-> Address -> Paged -> m [AddressUtxo]
forall a (m :: * -> *) b.
(a -> Paged -> SortOrder -> m [b]) -> a -> Paged -> m [b]
wrapperPaged Address -> Paged -> SortOrder -> m [AddressUtxo]
forall (m :: * -> *).
MonadBlockfrost m =>
Address -> Paged -> SortOrder -> m [AddressUtxo]
getAddressUtxos') m [AddressUtxo] -> ([AddressUtxo] -> Bool) -> m Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (AddressUtxo -> Bool) -> [AddressUtxo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any AddressUtxo -> Bool
matchUtxo
  where
    matchUtxo :: AddressUtxo -> Bool
    matchUtxo :: AddressUtxo -> Bool
matchUtxo AddressUtxo{Integer
[Amount]
Maybe Text
BlockHash
TxHash
_addressUtxoTxHash :: AddressUtxo -> TxHash
_addressUtxoOutputIndex :: AddressUtxo -> Integer
_addressUtxoDataHash :: AddressUtxo -> Maybe Text
_addressUtxoBlock :: AddressUtxo -> BlockHash
_addressUtxoAmount :: AddressUtxo -> [Amount]
_addressUtxoDataHash :: Maybe Text
_addressUtxoBlock :: BlockHash
_addressUtxoAmount :: [Amount]
_addressUtxoOutputIndex :: Integer
_addressUtxoTxHash :: TxHash
..} = (TxHash
tHash TxHash -> TxHash -> Bool
forall a. Eq a => a -> a -> Bool
== TxHash
_addressUtxoTxHash) Bool -> Bool -> Bool
&& (Integer
idx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
_addressUtxoOutputIndex)

wrapperPaged :: (a -> Paged -> SortOrder -> m [b]) -> a -> Paged -> m [b]
wrapperPaged :: (a -> Paged -> SortOrder -> m [b]) -> a -> Paged -> m [b]
wrapperPaged a -> Paged -> SortOrder -> m [b]
f a
a Paged
p = a -> Paged -> SortOrder -> m [b]
f a
a Paged
p SortOrder
forall a. Default a => a
def

wrapperPagedTx :: (a -> Paged -> SortOrder -> Maybe b -> Maybe b -> m [c]) -> a -> Paged -> m [c]
wrapperPagedTx :: (a -> Paged -> SortOrder -> Maybe b -> Maybe b -> m [c])
-> a -> Paged -> m [c]
wrapperPagedTx a -> Paged -> SortOrder -> Maybe b -> Maybe b -> m [c]
f a
a Paged
p = a -> Paged -> SortOrder -> Maybe b -> Maybe b -> m [c]
f a
a Paged
p SortOrder
forall a. Default a => a
def Maybe b
forall a. Maybe a
Nothing Maybe b
forall a. Maybe a
Nothing

-- DEFAULT RESPONSES

defaultGetUtxo :: MonadBlockfrost m => m (Block, [AddressUtxo])
defaultGetUtxo :: m (Block, [AddressUtxo])
defaultGetUtxo = do
    Block
tip <- m Block
forall (m :: * -> *). MonadBlockfrost m => m Block
getTipBlockfrost
    (Block, [AddressUtxo]) -> m (Block, [AddressUtxo])
forall (m :: * -> *) a. Monad m => a -> m a
return (Block
tip, [])

defaultGetList :: MonadBlockfrost m => m [a]
defaultGetList :: m [a]
defaultGetList = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []

defaultIsUtxo :: MonadBlockfrost m => m (Block, Bool)
defaultIsUtxo :: m (Block, Bool)
defaultIsUtxo = do
    Block
tip <- m Block
forall (m :: * -> *). MonadBlockfrost m => m Block
getTipBlockfrost
    (Block, Bool) -> m (Block, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return(Block
tip, Bool
False)