{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TypeApplications  #-}

module Plutus.Blockfrost.Responses (
    processTip
    , processGetDatum
    , processGetValidator
    , processUnspentTxOut
    , processIsUtxo
    , processGetUtxos
    , processGetTxos
    , processUnspentTxOutSetAtAddress
    , processDatumsAtAddress
    , processGetTxFromTxId
    , processGetTxsFromTxIds
    ) where

import Control.Monad.Extra (mapMaybeM)
import Control.Monad.Freer.Extras.Pagination (Page (..), PageQuery (..))
import Data.Aeson qualified as JSON
import Data.Aeson.QQ
import Data.List (find)
import Data.Map as Map (Map, elems, fromList, keys, lookup, toList)
import Data.Maybe (catMaybes, fromJust)
import Data.Text (Text)
import Data.Text qualified as Text (drop)
import Text.Hex (decodeHex)

import Blockfrost.Client
import Cardano.Api hiding (Block, Script, ScriptDatum, ScriptHash, TxIn, TxOut)
import Cardano.Api.Shelley qualified as Shelley
import Ledger.Address qualified as Ledger (CardanoAddress, cardanoAddressCredential)
import Ledger.Slot qualified as Ledger (Slot)
import Ledger.Tx (DatumFromQuery (DatumUnknown), DecoratedTxOut (..), Language (PlutusV1), RedeemerPtr (..), TxIn (..),
                  TxOutRef (..), Versioned (Versioned, unversioned), mkPubkeyDecoratedTxOut, mkScriptDecoratedTxOut,
                  pubKeyTxIn, scriptTxIn)
import Plutus.ChainIndex.Api (IsUtxoResponse (..), QueryResponse (..), TxosResponse (..), UtxosResponse (..))
import Plutus.ChainIndex.Types (BlockId (..), BlockNumber (..), ChainIndexTx (..), ChainIndexTxOutputs (..), Tip (..))
import Plutus.V1.Ledger.Api (BuiltinByteString, PubKeyHash)
import Plutus.V1.Ledger.Credential (Credential (PubKeyCredential, ScriptCredential))
import Plutus.V1.Ledger.Scripts (Datum, MintingPolicy, Redeemer, StakeValidator, Validator (..), ValidatorHash (..))
import Plutus.V1.Ledger.Scripts qualified as Ledger (DatumHash, Script, ScriptHash (..))
import Plutus.V1.Ledger.Tx qualified

import PlutusTx qualified

import Control.Monad ((<=<))

import Plutus.Blockfrost.Types
import Plutus.Blockfrost.Utils
import Plutus.ChainIndex.Types qualified as CI
import Plutus.V2.Ledger.Api qualified as PV2


class FromJSON a => PlutusValidator a where
  fromCBOR :: Text -> JSON.Result a

instance PlutusValidator Validator where
  fromCBOR :: Text -> Result Validator
fromCBOR Text
t = Value -> Result Validator
forall a. FromJSON a => Value -> Result a
JSON.fromJSON [aesonQQ|{"getValidator": #{t}}|]

instance PlutusValidator MintingPolicy where
  fromCBOR :: Text -> Result MintingPolicy
fromCBOR Text
t = Value -> Result MintingPolicy
forall a. FromJSON a => Value -> Result a
JSON.fromJSON [aesonQQ|{"getMintingPolicy": #{t}}|]

instance PlutusValidator StakeValidator where
  fromCBOR :: Text -> Result StakeValidator
fromCBOR Text
t = Value -> Result StakeValidator
forall a. FromJSON a => Value -> Result a
JSON.fromJSON [aesonQQ|{"getStakeValidator": #{t}}|]

instance PlutusValidator Ledger.Script where
  fromCBOR :: Text -> Result Script
fromCBOR Text
t = Value -> Result Script
forall a. FromJSON a => Value -> Result a
JSON.fromJSON [aesonQQ|#{t}|]

processGetDatum ::  PlutusTx.FromData a => Maybe JSON.Value -> IO (Maybe a)
processGetDatum :: Maybe Value -> IO (Maybe a)
processGetDatum Maybe Value
sdt = case Maybe Value
sdt of
    Maybe Value
Nothing -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Just Value
res ->
        case ScriptDataJsonSchema
-> Value -> Either ScriptDataJsonError ScriptData
Shelley.scriptDataFromJson ScriptDataJsonSchema
Shelley.ScriptDataJsonDetailedSchema Value
res of
            Right ScriptData
dec -> do
                case  ScriptData -> Maybe a
forall a. FromData a => ScriptData -> Maybe a
decodeData ScriptData
dec of
                    Just a
x  -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
                    Maybe a
Nothing -> IOError -> IO (Maybe a)
forall a. IOError -> IO a
ioError (String -> IOError
userError String
"Error in parser")
            Left ScriptDataJsonError
err -> IOError -> IO (Maybe a)
forall a. IOError -> IO a
ioError (String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ ScriptDataJsonError -> String
forall a. Show a => a -> String
show ScriptDataJsonError
err)
  where
    decodeData :: PlutusTx.FromData a => ScriptData -> Maybe a
    decodeData :: ScriptData -> Maybe a
decodeData = BuiltinData -> Maybe a
forall a. FromData a => BuiltinData -> Maybe a
PlutusTx.fromBuiltinData (BuiltinData -> Maybe a)
-> (ScriptData -> BuiltinData) -> ScriptData -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> BuiltinData
PlutusTx.dataToBuiltinData (Data -> BuiltinData)
-> (ScriptData -> Data) -> ScriptData -> BuiltinData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptData -> Data
Shelley.toPlutusData

processTip :: Block -> IO Tip
processTip :: Block -> IO Tip
processTip Block{Integer
Maybe Integer
Maybe Text
Maybe Slot
Maybe Epoch
Maybe BlockHash
Maybe Lovelaces
Text
BlockHash
POSIXTime
_blockTime :: Block -> POSIXTime
_blockHeight :: Block -> Maybe Integer
_blockHash :: Block -> BlockHash
_blockSlot :: Block -> Maybe Slot
_blockEpoch :: Block -> Maybe Epoch
_blockEpochSlot :: Block -> Maybe Integer
_blockSlotLeader :: Block -> Text
_blockSize :: Block -> Integer
_blockTxCount :: Block -> Integer
_blockOutput :: Block -> Maybe Lovelaces
_blockFees :: Block -> Maybe Lovelaces
_blockBlockVrf :: Block -> Maybe Text
_blockPreviousBlock :: Block -> Maybe BlockHash
_blockNextBlock :: Block -> Maybe BlockHash
_blockConfirmations :: Block -> Integer
_blockConfirmations :: Integer
_blockNextBlock :: Maybe BlockHash
_blockPreviousBlock :: Maybe BlockHash
_blockBlockVrf :: Maybe Text
_blockFees :: Maybe Lovelaces
_blockOutput :: Maybe Lovelaces
_blockTxCount :: Integer
_blockSize :: Integer
_blockSlotLeader :: Text
_blockEpochSlot :: Maybe Integer
_blockEpoch :: Maybe Epoch
_blockSlot :: Maybe Slot
_blockHash :: BlockHash
_blockHeight :: Maybe Integer
_blockTime :: POSIXTime
..} = Tip -> IO Tip
forall (m :: * -> *) a. Monad m => a -> m a
return (Tip -> IO Tip) -> Tip -> IO Tip
forall a b. (a -> b) -> a -> b
$ Tip :: Slot -> BlockId -> BlockNumber -> Tip
Tip { tipSlot :: Slot
tipSlot = Slot
slotNumber
                                    , tipBlockId :: BlockId
tipBlockId = BlockId
blockId
                                    , tipBlockNo :: BlockNumber
tipBlockNo = BlockNumber
blockNo}
  where
    slotNumber :: Ledger.Slot
    slotNumber :: Slot
slotNumber = Integer -> Slot
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Slot) -> Integer -> Slot
forall a b. (a -> b) -> a -> b
$ Slot -> Integer
unSlot (Slot -> Integer) -> Slot -> Integer
forall a b. (a -> b) -> a -> b
$ Maybe Slot -> Slot
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Slot
_blockSlot

    blockNo :: BlockNumber
    blockNo :: BlockNumber
blockNo = Word64 -> BlockNumber
BlockNumber (Word64 -> BlockNumber) -> Word64 -> BlockNumber
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> Integer
forall a. HasCallStack => Maybe a -> a
fromJust  Maybe Integer
_blockHeight

    blockId :: BlockId
    blockId :: BlockId
blockId =  ByteString -> BlockId
BlockId (ByteString -> BlockId) -> ByteString -> BlockId
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Maybe ByteString
decodeHex (Text -> Maybe ByteString) -> Text -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ BlockHash -> Text
unBlockHash BlockHash
_blockHash

processGetValidator :: PlutusValidator a => Maybe ScriptCBOR -> IO (Maybe (Versioned a))
processGetValidator :: Maybe ScriptCBOR -> IO (Maybe (Versioned a))
processGetValidator Maybe ScriptCBOR
val = Maybe (Versioned a) -> IO (Maybe (Versioned a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Versioned a) -> IO (Maybe (Versioned a)))
-> Maybe (Versioned a) -> IO (Maybe (Versioned a))
forall a b. (a -> b) -> a -> b
$ Maybe ScriptCBOR
val Maybe ScriptCBOR
-> (ScriptCBOR -> Maybe (Versioned a)) -> Maybe (Versioned a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ScriptCBOR -> Maybe (Versioned a)
forall a. PlutusValidator a => ScriptCBOR -> Maybe (Versioned a)
buildResponse
  where
    buildResponse :: PlutusValidator a => ScriptCBOR -> Maybe (Versioned a)
    buildResponse :: ScriptCBOR -> Maybe (Versioned a)
buildResponse = Text -> Maybe (Versioned a)
forall a. PlutusValidator a => Text -> Maybe (Versioned a)
retFromCbor (Text -> Maybe (Versioned a))
-> (ScriptCBOR -> Maybe Text) -> ScriptCBOR -> Maybe (Versioned a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ScriptCBOR -> Maybe Text
_scriptCborCbor

    retFromCbor :: PlutusValidator a => Text -> Maybe (Versioned a)
    retFromCbor :: Text -> Maybe (Versioned a)
retFromCbor Text
txt = case Text -> Result a
forall a. PlutusValidator a => Text -> Result a
fromCBOR (Text -> Result a) -> Text -> Result a
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.drop Int
6 Text
txt of
              JSON.Success a
a -> Versioned a -> Maybe (Versioned a)
forall a. a -> Maybe a
Just (a -> Language -> Versioned a
forall script. script -> Language -> Versioned script
Versioned a
a Language
PlutusV1)
              JSON.Error String
_   -> Maybe (Versioned a)
forall a. Maybe a
Nothing

processUnspentTxOut :: Maybe UtxoOutput -> IO (Maybe DecoratedTxOut)
processUnspentTxOut :: Maybe UtxoOutput -> IO (Maybe DecoratedTxOut)
processUnspentTxOut Maybe UtxoOutput
Nothing = Maybe DecoratedTxOut -> IO (Maybe DecoratedTxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DecoratedTxOut
forall a. Maybe a
Nothing
processUnspentTxOut (Just UtxoOutput
utxo) = UtxoOutput -> IO (Maybe DecoratedTxOut)
buildResponse UtxoOutput
utxo
  where
    buildResponse :: UtxoOutput -> IO (Maybe DecoratedTxOut)
    buildResponse :: UtxoOutput -> IO (Maybe DecoratedTxOut)
buildResponse UtxoOutput
utxoOut = case Address -> Either String (AddressInEra BabbageEra)
toCardanoAddress (UtxoOutput -> Address
_utxoOutputAddress UtxoOutput
utxoOut) of
              Left String
err   -> IOError -> IO (Maybe DecoratedTxOut)
forall a. IOError -> IO a
ioError (String -> IOError
userError String
err)
              Right AddressInEra BabbageEra
addr -> case AddressInEra BabbageEra -> Credential
forall era. AddressInEra era -> Credential
Ledger.cardanoAddressCredential AddressInEra BabbageEra
addr of
                    PubKeyCredential PubKeyHash
_ -> Maybe DecoratedTxOut -> IO (Maybe DecoratedTxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe DecoratedTxOut -> IO (Maybe DecoratedTxOut))
-> Maybe DecoratedTxOut -> IO (Maybe DecoratedTxOut)
forall a b. (a -> b) -> a -> b
$ AddressInEra BabbageEra -> UtxoOutput -> Maybe DecoratedTxOut
buildPublicKeyTxOut AddressInEra BabbageEra
addr UtxoOutput
utxoOut
                    ScriptCredential ValidatorHash
_ -> Maybe DecoratedTxOut -> IO (Maybe DecoratedTxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe DecoratedTxOut -> IO (Maybe DecoratedTxOut))
-> Maybe DecoratedTxOut -> IO (Maybe DecoratedTxOut)
forall a b. (a -> b) -> a -> b
$ AddressInEra BabbageEra -> UtxoOutput -> Maybe DecoratedTxOut
buildScriptTxOut AddressInEra BabbageEra
addr UtxoOutput
utxoOut

    buildScriptTxOut :: Ledger.CardanoAddress -> UtxoOutput -> Maybe DecoratedTxOut
    buildScriptTxOut :: AddressInEra BabbageEra -> UtxoOutput -> Maybe DecoratedTxOut
buildScriptTxOut AddressInEra BabbageEra
addr UtxoOutput
utxoOut = AddressInEra BabbageEra
-> Value
-> (DatumHash, DatumFromQuery)
-> Maybe (Versioned Script)
-> Maybe (Versioned Validator)
-> Maybe DecoratedTxOut
mkScriptDecoratedTxOut AddressInEra BabbageEra
addr
                                                          (UtxoOutput -> Value
utxoValue UtxoOutput
utxoOut)
                                                          (UtxoOutput -> DatumHash
utxoDatumHash UtxoOutput
utxoOut, DatumFromQuery
DatumUnknown)
                                                          Maybe (Versioned Script)
forall a. Maybe a
Nothing
                                                          Maybe (Versioned Validator)
forall a. Maybe a
Nothing

    buildPublicKeyTxOut :: Ledger.CardanoAddress -> UtxoOutput -> Maybe DecoratedTxOut
    buildPublicKeyTxOut :: AddressInEra BabbageEra -> UtxoOutput -> Maybe DecoratedTxOut
buildPublicKeyTxOut AddressInEra BabbageEra
addr UtxoOutput
utxoOut = AddressInEra BabbageEra
-> Value
-> Maybe (DatumHash, DatumFromQuery)
-> Maybe (Versioned Script)
-> Maybe DecoratedTxOut
mkPubkeyDecoratedTxOut AddressInEra BabbageEra
addr (UtxoOutput -> Value
utxoValue UtxoOutput
utxoOut) Maybe (DatumHash, DatumFromQuery)
forall a. Maybe a
Nothing Maybe (Versioned Script)
forall a. Maybe a
Nothing

    utxoValue :: UtxoOutput -> Value
    utxoValue :: UtxoOutput -> Value
utxoValue = [Amount] -> Value
amountsToValue ([Amount] -> Value)
-> (UtxoOutput -> [Amount]) -> UtxoOutput -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoOutput -> [Amount]
_utxoOutputAmount

    utxoDatumHash :: UtxoOutput -> Ledger.DatumHash
    utxoDatumHash :: UtxoOutput -> DatumHash
utxoDatumHash = Text -> DatumHash
textToDatumHash (Text -> DatumHash)
-> (UtxoOutput -> Text) -> UtxoOutput -> DatumHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatumHash -> Text
unDatumHash (DatumHash -> Text)
-> (UtxoOutput -> DatumHash) -> UtxoOutput -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe DatumHash -> DatumHash
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DatumHash -> DatumHash)
-> (UtxoOutput -> Maybe DatumHash) -> UtxoOutput -> DatumHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoOutput -> Maybe DatumHash
_utxoOutputDataHash

processIsUtxo :: (Block, Bool) -> IO IsUtxoResponse
processIsUtxo :: (Block, Bool) -> IO IsUtxoResponse
processIsUtxo (Block
blockN, Bool
isUtxo) = do
    Tip
tip <- Block -> IO Tip
processTip Block
blockN
    IsUtxoResponse -> IO IsUtxoResponse
forall (m :: * -> *) a. Monad m => a -> m a
return (IsUtxoResponse -> IO IsUtxoResponse)
-> IsUtxoResponse -> IO IsUtxoResponse
forall a b. (a -> b) -> a -> b
$ IsUtxoResponse :: Tip -> Bool -> IsUtxoResponse
IsUtxoResponse {$sel:currentTip:IsUtxoResponse :: Tip
currentTip=Tip
tip, $sel:isUtxo:IsUtxoResponse :: Bool
isUtxo=Bool
isUtxo}

processGetUtxos :: PageQuery TxOutRef -> (Block, [AddressUtxo]) -> IO UtxosResponse
processGetUtxos :: PageQuery TxOutRef -> (Block, [AddressUtxo]) -> IO UtxosResponse
processGetUtxos PageQuery TxOutRef
pq (Block
blockN, [AddressUtxo]
xs) = do
    Tip
tip <- Block -> IO Tip
processTip Block
blockN
    UtxosResponse -> IO UtxosResponse
forall (m :: * -> *) a. Monad m => a -> m a
return (UtxosResponse -> IO UtxosResponse)
-> UtxosResponse -> IO UtxosResponse
forall a b. (a -> b) -> a -> b
$ UtxosResponse :: Tip -> Page TxOutRef -> UtxosResponse
UtxosResponse {$sel:currentTip:UtxosResponse :: Tip
currentTip=Tip
tip, $sel:page:UtxosResponse :: Page TxOutRef
page=Page TxOutRef
refPage}
  where
      refPage :: Page TxOutRef
      refPage :: Page TxOutRef
refPage = Page :: forall a. PageQuery a -> Maybe (PageQuery a) -> [a] -> Page a
Page {currentPageQuery :: PageQuery TxOutRef
currentPageQuery=PageQuery TxOutRef
pq
                  , nextPageQuery :: Maybe (PageQuery TxOutRef)
nextPageQuery=Maybe (PageQuery TxOutRef)
forall a. Maybe a
Nothing
                  , pageItems :: [TxOutRef]
pageItems=[TxOutRef]
items
                  }

      items :: [TxOutRef]
      items :: [TxOutRef]
items = (AddressUtxo -> TxOutRef) -> [AddressUtxo] -> [TxOutRef]
forall a b. (a -> b) -> [a] -> [b]
map AddressUtxo -> TxOutRef
utxoToRef [AddressUtxo]
xs

processGetTxos :: PageQuery TxOutRef -> [UtxoInput] -> IO TxosResponse
processGetTxos :: PageQuery TxOutRef -> [UtxoInput] -> IO TxosResponse
processGetTxos PageQuery TxOutRef
pq [UtxoInput]
xs = TxosResponse -> IO TxosResponse
forall (m :: * -> *) a. Monad m => a -> m a
return (TxosResponse -> IO TxosResponse)
-> TxosResponse -> IO TxosResponse
forall a b. (a -> b) -> a -> b
$ TxosResponse :: Page TxOutRef -> TxosResponse
TxosResponse {$sel:paget:TxosResponse :: Page TxOutRef
paget=Page TxOutRef
refPage}
  where
      refPage :: Page TxOutRef
      refPage :: Page TxOutRef
refPage = Page :: forall a. PageQuery a -> Maybe (PageQuery a) -> [a] -> Page a
Page {currentPageQuery :: PageQuery TxOutRef
currentPageQuery=PageQuery TxOutRef
pq
                  , nextPageQuery :: Maybe (PageQuery TxOutRef)
nextPageQuery=Maybe (PageQuery TxOutRef)
forall a. Maybe a
Nothing
                  , pageItems :: [TxOutRef]
pageItems=[TxOutRef]
items
                  }

      items :: [TxOutRef]
      items :: [TxOutRef]
items = (UtxoInput -> TxOutRef) -> [UtxoInput] -> [TxOutRef]
forall a b. (a -> b) -> [a] -> [b]
map UtxoInput -> TxOutRef
txoToRef [UtxoInput]
xs

processUnspentTxOutSetAtAddress ::
    PageQuery TxOutRef
    -> Credential
    -> [AddressUtxo]
    -> IO (QueryResponse [(TxOutRef, DecoratedTxOut)])
processUnspentTxOutSetAtAddress :: PageQuery TxOutRef
-> Credential
-> [AddressUtxo]
-> IO (QueryResponse [(TxOutRef, DecoratedTxOut)])
processUnspentTxOutSetAtAddress PageQuery TxOutRef
_ Credential
cred [AddressUtxo]
xs =
  QueryResponse [(TxOutRef, DecoratedTxOut)]
-> IO (QueryResponse [(TxOutRef, DecoratedTxOut)])
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryResponse [(TxOutRef, DecoratedTxOut)]
 -> IO (QueryResponse [(TxOutRef, DecoratedTxOut)]))
-> QueryResponse [(TxOutRef, DecoratedTxOut)]
-> IO (QueryResponse [(TxOutRef, DecoratedTxOut)])
forall a b. (a -> b) -> a -> b
$ QueryResponse :: forall a. a -> Maybe (PageQuery TxOutRef) -> QueryResponse a
QueryResponse {$sel:queryResult:QueryResponse :: [(TxOutRef, DecoratedTxOut)]
queryResult = [(TxOutRef, DecoratedTxOut)]
items, $sel:nextQuery:QueryResponse :: Maybe (PageQuery TxOutRef)
nextQuery = Maybe (PageQuery TxOutRef)
forall a. Maybe a
Nothing}
  where
    items :: [(TxOutRef, DecoratedTxOut)]
    items :: [(TxOutRef, DecoratedTxOut)]
items = (AddressUtxo -> (TxOutRef, DecoratedTxOut))
-> [AddressUtxo] -> [(TxOutRef, DecoratedTxOut)]
forall a b. (a -> b) -> [a] -> [b]
map AddressUtxo -> (TxOutRef, DecoratedTxOut)
transform [AddressUtxo]
xs

    transform :: AddressUtxo -> (TxOutRef, DecoratedTxOut)
    transform :: AddressUtxo -> (TxOutRef, DecoratedTxOut)
transform AddressUtxo
utxo = (AddressUtxo -> TxOutRef
utxoToRef AddressUtxo
utxo, AddressUtxo -> DecoratedTxOut
buildResponse AddressUtxo
utxo)

    buildResponse :: AddressUtxo -> DecoratedTxOut
    buildResponse :: AddressUtxo -> DecoratedTxOut
buildResponse AddressUtxo
utxo = case Credential
cred of
        PubKeyCredential PubKeyHash
pkh     -> PubKeyHash -> AddressUtxo -> DecoratedTxOut
buildPublicKeyTxOut PubKeyHash
pkh AddressUtxo
utxo
        ScriptCredential ValidatorHash
valHash -> ValidatorHash -> AddressUtxo -> DecoratedTxOut
buildScriptTxOut ValidatorHash
valHash AddressUtxo
utxo

    buildScriptTxOut :: ValidatorHash -> AddressUtxo -> DecoratedTxOut
    buildScriptTxOut :: ValidatorHash -> AddressUtxo -> DecoratedTxOut
buildScriptTxOut ValidatorHash
valHash AddressUtxo
utxo = ScriptDecoratedTxOut :: ValidatorHash
-> Maybe StakingCredential
-> Value
-> (DatumHash, DatumFromQuery)
-> Maybe (Versioned Script)
-> Maybe (Versioned Validator)
-> DecoratedTxOut
ScriptDecoratedTxOut { _decoratedTxOutValidatorHash :: ValidatorHash
_decoratedTxOutValidatorHash=ValidatorHash
valHash
                                                        , _decoratedTxOutStakingCredential :: Maybe StakingCredential
_decoratedTxOutStakingCredential=Maybe StakingCredential
forall a. Maybe a
Nothing
                                                        , _decoratedTxOutValue :: Value
_decoratedTxOutValue=AddressUtxo -> Value
utxoValue AddressUtxo
utxo
                                                        , _decoratedTxOutScriptDatum :: (DatumHash, DatumFromQuery)
_decoratedTxOutScriptDatum=(AddressUtxo -> DatumHash
utxoDatumHash AddressUtxo
utxo, DatumFromQuery
DatumUnknown)
                                                        , _decoratedTxOutValidator :: Maybe (Versioned Validator)
_decoratedTxOutValidator=Maybe (Versioned Validator)
forall a. Maybe a
Nothing
                                                        , _decoratedTxOutReferenceScript :: Maybe (Versioned Script)
_decoratedTxOutReferenceScript=Maybe (Versioned Script)
forall a. Maybe a
Nothing
                                                        }

    buildPublicKeyTxOut :: PubKeyHash -> AddressUtxo -> DecoratedTxOut
    buildPublicKeyTxOut :: PubKeyHash -> AddressUtxo -> DecoratedTxOut
buildPublicKeyTxOut PubKeyHash
pkh AddressUtxo
utxo = PublicKeyDecoratedTxOut :: PubKeyHash
-> Maybe StakingCredential
-> Value
-> Maybe (DatumHash, DatumFromQuery)
-> Maybe (Versioned Script)
-> DecoratedTxOut
PublicKeyDecoratedTxOut { _decoratedTxOutPubKeyHash :: PubKeyHash
_decoratedTxOutPubKeyHash=PubKeyHash
pkh
                                                          , _decoratedTxOutStakingCredential :: Maybe StakingCredential
_decoratedTxOutStakingCredential=Maybe StakingCredential
forall a. Maybe a
Nothing
                                                           , _decoratedTxOutValue :: Value
_decoratedTxOutValue=AddressUtxo -> Value
utxoValue AddressUtxo
utxo
                                                           , _decoratedTxOutPubKeyDatum :: Maybe (DatumHash, DatumFromQuery)
_decoratedTxOutPubKeyDatum=Maybe (DatumHash, DatumFromQuery)
forall a. Maybe a
Nothing
                                                           , _decoratedTxOutReferenceScript :: Maybe (Versioned Script)
_decoratedTxOutReferenceScript=Maybe (Versioned Script)
forall a. Maybe a
Nothing
                                                           }

    utxoValue :: AddressUtxo -> Value
    utxoValue :: AddressUtxo -> Value
utxoValue = [Amount] -> Value
amountsToValue ([Amount] -> Value)
-> (AddressUtxo -> [Amount]) -> AddressUtxo -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressUtxo -> [Amount]
_addressUtxoAmount

    utxoDatumHash :: AddressUtxo -> Ledger.DatumHash
    utxoDatumHash :: AddressUtxo -> DatumHash
utxoDatumHash = Text -> DatumHash
textToDatumHash (Text -> DatumHash)
-> (AddressUtxo -> Text) -> AddressUtxo -> DatumHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text)
-> (AddressUtxo -> Maybe Text) -> AddressUtxo -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressUtxo -> Maybe Text
_addressUtxoDataHash


processDatumsAtAddress ::
  PlutusTx.FromData a
  => PageQuery TxOutRef
  -> Credential
  -> [JSON.Value]
  -> IO (QueryResponse [a])
processDatumsAtAddress :: PageQuery TxOutRef
-> Credential -> [Value] -> IO (QueryResponse [a])
processDatumsAtAddress PageQuery TxOutRef
_ Credential
_ [Value]
xs = do
  [a]
items <- (Value -> IO (Maybe a)) -> [Value] -> IO [a]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (\Value
d -> Maybe Value -> IO (Maybe a)
forall a. FromData a => Maybe Value -> IO (Maybe a)
processGetDatum (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
d)) [Value]
xs
  QueryResponse [a] -> IO (QueryResponse [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryResponse [a] -> IO (QueryResponse [a]))
-> QueryResponse [a] -> IO (QueryResponse [a])
forall a b. (a -> b) -> a -> b
$ QueryResponse :: forall a. a -> Maybe (PageQuery TxOutRef) -> QueryResponse a
QueryResponse {$sel:queryResult:QueryResponse :: [a]
queryResult = [a]
items, $sel:nextQuery:QueryResponse :: Maybe (PageQuery TxOutRef)
nextQuery = Maybe (PageQuery TxOutRef)
forall a. Maybe a
Nothing}


processGetTxFromTxId :: Maybe TxResponse -> IO (Maybe ChainIndexTx)
processGetTxFromTxId :: Maybe TxResponse -> IO (Maybe ChainIndexTx)
processGetTxFromTxId Maybe TxResponse
Nothing = Maybe ChainIndexTx -> IO (Maybe ChainIndexTx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ChainIndexTx
forall a. Maybe a
Nothing
processGetTxFromTxId (Just TxResponse{[UtxoInput]
[UtxoOutput]
Maybe Text
Map Integer (ValidationPurpose, ScriptDatum)
Map Text ScriptDatum
Map Text ScriptCBOR
TxHash
_scriptsMap :: TxResponse -> Map Text ScriptCBOR
_redeemersMap :: TxResponse -> Map Integer (ValidationPurpose, ScriptDatum)
_datumsMap :: TxResponse -> Map Text ScriptDatum
_utxosOutpus :: TxResponse -> [UtxoOutput]
_utxosInputs :: TxResponse -> [UtxoInput]
_invalidAfter :: TxResponse -> Maybe Text
_invalidBefore :: TxResponse -> Maybe Text
_txHash :: TxResponse -> TxHash
_scriptsMap :: Map Text ScriptCBOR
_redeemersMap :: Map Integer (ValidationPurpose, ScriptDatum)
_datumsMap :: Map Text ScriptDatum
_utxosOutpus :: [UtxoOutput]
_utxosInputs :: [UtxoInput]
_invalidAfter :: Maybe Text
_invalidBefore :: Maybe Text
_txHash :: TxHash
..}) = do
    Map DatumHash Datum
datums <- Map Text ScriptDatum -> IO (Map DatumHash Datum)
getAllDatumsMap Map Text ScriptDatum
_datumsMap
    Redeemers
redeemers <- Map Integer (ValidationPurpose, ScriptDatum) -> IO Redeemers
getAllRedeemersMap Map Integer (ValidationPurpose, ScriptDatum)
_redeemersMap
    Map ScriptHash (Versioned Script)
scripts <- Map Text ScriptCBOR -> IO (Map ScriptHash (Versioned Script))
getAllScriptsMap Map Text ScriptCBOR
_scriptsMap
    ChainIndexTxOutputs
txouts <- [UtxoOutput] -> IO ChainIndexTxOutputs
processTxOuts [UtxoOutput]
_utxosOutpus
    Maybe ChainIndexTx -> IO (Maybe ChainIndexTx)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ChainIndexTx -> IO (Maybe ChainIndexTx))
-> Maybe ChainIndexTx -> IO (Maybe ChainIndexTx)
forall a b. (a -> b) -> a -> b
$ ChainIndexTx -> Maybe ChainIndexTx
forall a. a -> Maybe a
Just ChainIndexTx :: TxId
-> [TxIn]
-> ChainIndexTxOutputs
-> SlotRange
-> Map DatumHash Datum
-> Redeemers
-> Map ScriptHash (Versioned Script)
-> Maybe CardanoTx
-> ChainIndexTx
ChainIndexTx { _citxTxId :: TxId
_citxTxId       = TxHash -> TxId
txHashToTxId TxHash
_txHash
                               , _citxInputs :: [TxIn]
_citxInputs     = Map ScriptHash Script
-> Redeemers -> Map DatumHash Datum -> [UtxoInput] -> [TxIn]
processTxIn ((Versioned Script -> Script)
-> Map ScriptHash (Versioned Script) -> Map ScriptHash Script
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Versioned Script -> Script
forall script. Versioned script -> script
unversioned Map ScriptHash (Versioned Script)
scripts) Redeemers
redeemers Map DatumHash Datum
datums [UtxoInput]
_utxosInputs
                               , _citxOutputs :: ChainIndexTxOutputs
_citxOutputs    = ChainIndexTxOutputs
txouts
                               , _citxValidRange :: SlotRange
_citxValidRange = Maybe Text -> Maybe Text -> SlotRange
toPlutusSlotRange Maybe Text
_invalidBefore Maybe Text
_invalidAfter
                               , _citxData :: Map DatumHash Datum
_citxData       = Map DatumHash Datum
datums
                               , _citxRedeemers :: Redeemers
_citxRedeemers  = Redeemers
redeemers
                               , _citxScripts :: Map ScriptHash (Versioned Script)
_citxScripts    = Map ScriptHash (Versioned Script)
scripts
                               , _citxCardanoTx :: Maybe CardanoTx
_citxCardanoTx  = Maybe CardanoTx
forall a. Maybe a
Nothing
                               }
  where
    processTxOuts :: [UtxoOutput] -> IO ChainIndexTxOutputs
    processTxOuts :: [UtxoOutput] -> IO ChainIndexTxOutputs
processTxOuts [] = ChainIndexTxOutputs -> IO ChainIndexTxOutputs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainIndexTxOutputs -> IO ChainIndexTxOutputs)
-> ChainIndexTxOutputs -> IO ChainIndexTxOutputs
forall a b. (a -> b) -> a -> b
$ Maybe ChainIndexTxOut -> ChainIndexTxOutputs
InvalidTx Maybe ChainIndexTxOut
forall a. Maybe a
Nothing
    processTxOuts [UtxoOutput]
xs = [ChainIndexTxOut] -> ChainIndexTxOutputs
ValidTx ([ChainIndexTxOut] -> ChainIndexTxOutputs)
-> IO [ChainIndexTxOut] -> IO ChainIndexTxOutputs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UtxoOutput -> IO ChainIndexTxOut)
-> [UtxoOutput] -> IO [ChainIndexTxOut]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM UtxoOutput -> IO ChainIndexTxOut
utxoOutputToTxOut [UtxoOutput]
xs

    utxoOutputToTxOut :: UtxoOutput -> IO CI.ChainIndexTxOut
    utxoOutputToTxOut :: UtxoOutput -> IO ChainIndexTxOut
utxoOutputToTxOut UtxoOutput
utxo = do
        AddressInEra BabbageEra
addr <- (String -> IO (AddressInEra BabbageEra))
-> (AddressInEra BabbageEra -> IO (AddressInEra BabbageEra))
-> Either String (AddressInEra BabbageEra)
-> IO (AddressInEra BabbageEra)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IOError -> IO (AddressInEra BabbageEra)
forall a. IOError -> IO a
ioError (IOError -> IO (AddressInEra BabbageEra))
-> (String -> IOError) -> String -> IO (AddressInEra BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError) AddressInEra BabbageEra -> IO (AddressInEra BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> Either String (AddressInEra BabbageEra)
toCardanoAddress (Address -> Either String (AddressInEra BabbageEra))
-> Address -> Either String (AddressInEra BabbageEra)
forall a b. (a -> b) -> a -> b
$ UtxoOutput -> Address
_utxoOutputAddress UtxoOutput
utxo)
        ChainIndexTxOut -> IO ChainIndexTxOut
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainIndexTxOut -> IO ChainIndexTxOut)
-> ChainIndexTxOut -> IO ChainIndexTxOut
forall a b. (a -> b) -> a -> b
$ ChainIndexTxOut :: AddressInEra BabbageEra
-> Value -> OutputDatum -> ReferenceScript -> ChainIndexTxOut
CI.ChainIndexTxOut
          { citoAddress :: AddressInEra BabbageEra
CI.citoAddress = AddressInEra BabbageEra
addr
          , citoValue :: Value
CI.citoValue     = [Amount] -> Value
amountsToValue ([Amount] -> Value) -> [Amount] -> Value
forall a b. (a -> b) -> a -> b
$ UtxoOutput -> [Amount]
_utxoOutputAmount UtxoOutput
utxo
          , citoDatum :: OutputDatum
CI.citoDatum = OutputDatum
-> (DatumHash -> OutputDatum) -> Maybe DatumHash -> OutputDatum
forall b a. b -> (a -> b) -> Maybe a -> b
maybe OutputDatum
PV2.NoOutputDatum DatumHash -> OutputDatum
PV2.OutputDatumHash (Text -> DatumHash
textToDatumHash (Text -> DatumHash)
-> (DatumHash -> Text) -> DatumHash -> DatumHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatumHash -> Text
unDatumHash (DatumHash -> DatumHash) -> Maybe DatumHash -> Maybe DatumHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UtxoOutput -> Maybe DatumHash
_utxoOutputDataHash UtxoOutput
utxo)
          , citoRefScript :: ReferenceScript
CI.citoRefScript = ReferenceScript
CI.ReferenceScriptNone
          }

    getAllDatumsMap :: Map Text ScriptDatum -> IO (Map Ledger.DatumHash Datum)
    getAllDatumsMap :: Map Text ScriptDatum -> IO (Map DatumHash Datum)
getAllDatumsMap Map Text ScriptDatum
datumMap = do
        let newKeys :: [DatumHash]
newKeys = (Text -> DatumHash) -> [Text] -> [DatumHash]
forall a b. (a -> b) -> [a] -> [b]
map Text -> DatumHash
textToDatumHash ([Text] -> [DatumHash]) -> [Text] -> [DatumHash]
forall a b. (a -> b) -> a -> b
$ Map Text ScriptDatum -> [Text]
forall k a. Map k a -> [k]
keys Map Text ScriptDatum
datumMap
            newElems :: [IO Datum]
newElems = (ScriptDatum -> IO Datum) -> [ScriptDatum] -> [IO Datum]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Datum -> Datum) -> IO (Maybe Datum) -> IO Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) Maybe Datum -> Datum
forall a. HasCallStack => Maybe a -> a
fromJust (IO (Maybe Datum) -> IO Datum)
-> (ScriptDatum -> IO (Maybe Datum)) -> ScriptDatum -> IO Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Value -> IO (Maybe Datum)
forall a. FromData a => Maybe Value -> IO (Maybe a)
processGetDatum (Maybe Value -> IO (Maybe Datum))
-> (ScriptDatum -> Maybe Value) -> ScriptDatum -> IO (Maybe Datum)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value)
-> (ScriptDatum -> Value) -> ScriptDatum -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptDatum -> Value
_scriptDatumJsonValue) ([ScriptDatum] -> [IO Datum]) -> [ScriptDatum] -> [IO Datum]
forall a b. (a -> b) -> a -> b
$ Map Text ScriptDatum -> [ScriptDatum]
forall k a. Map k a -> [a]
elems Map Text ScriptDatum
datumMap
        [Datum]
datElems <- [IO Datum] -> IO [Datum]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [IO Datum]
newElems
        Map DatumHash Datum -> IO (Map DatumHash Datum)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map DatumHash Datum -> IO (Map DatumHash Datum))
-> Map DatumHash Datum -> IO (Map DatumHash Datum)
forall a b. (a -> b) -> a -> b
$ [(DatumHash, Datum)] -> Map DatumHash Datum
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(DatumHash, Datum)] -> Map DatumHash Datum)
-> [(DatumHash, Datum)] -> Map DatumHash Datum
forall a b. (a -> b) -> a -> b
$ [DatumHash] -> [Datum] -> [(DatumHash, Datum)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DatumHash]
newKeys [Datum]
datElems

    getAllRedeemersMap :: Map Integer (ValidationPurpose, ScriptDatum) -> IO Plutus.V1.Ledger.Tx.Redeemers
    getAllRedeemersMap :: Map Integer (ValidationPurpose, ScriptDatum) -> IO Redeemers
getAllRedeemersMap Map Integer (ValidationPurpose, ScriptDatum)
datumMap = do
        let indexs :: [Integer]
indexs = Map Integer (ValidationPurpose, ScriptDatum) -> [Integer]
forall k a. Map k a -> [k]
keys Map Integer (ValidationPurpose, ScriptDatum)
datumMap
            st :: [ScriptTag]
st     = ((ValidationPurpose, ScriptDatum) -> ScriptTag)
-> [(ValidationPurpose, ScriptDatum)] -> [ScriptTag]
forall a b. (a -> b) -> [a] -> [b]
map (ValidationPurpose -> ScriptTag
toPlutusScriptTag (ValidationPurpose -> ScriptTag)
-> ((ValidationPurpose, ScriptDatum) -> ValidationPurpose)
-> (ValidationPurpose, ScriptDatum)
-> ScriptTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidationPurpose, ScriptDatum) -> ValidationPurpose
forall a b. (a, b) -> a
fst) (Map Integer (ValidationPurpose, ScriptDatum)
-> [(ValidationPurpose, ScriptDatum)]
forall k a. Map k a -> [a]
elems Map Integer (ValidationPurpose, ScriptDatum)
datumMap)
            redPtr :: [RedeemerPtr]
redPtr = (ScriptTag -> Integer -> RedeemerPtr)
-> [ScriptTag] -> [Integer] -> [RedeemerPtr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ScriptTag -> Integer -> RedeemerPtr
RedeemerPtr [ScriptTag]
st [Integer]
indexs
            newElems :: [IO Redeemer]
newElems = ((ValidationPurpose, ScriptDatum) -> IO Redeemer)
-> [(ValidationPurpose, ScriptDatum)] -> [IO Redeemer]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Redeemer -> Redeemer) -> IO (Maybe Redeemer) -> IO Redeemer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) Maybe Redeemer -> Redeemer
forall a. HasCallStack => Maybe a -> a
fromJust (IO (Maybe Redeemer) -> IO Redeemer)
-> ((ValidationPurpose, ScriptDatum) -> IO (Maybe Redeemer))
-> (ValidationPurpose, ScriptDatum)
-> IO Redeemer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Value -> IO (Maybe Redeemer)
forall a. FromData a => Maybe Value -> IO (Maybe a)
processGetDatum (Maybe Value -> IO (Maybe Redeemer))
-> ((ValidationPurpose, ScriptDatum) -> Maybe Value)
-> (ValidationPurpose, ScriptDatum)
-> IO (Maybe Redeemer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value)
-> ((ValidationPurpose, ScriptDatum) -> Value)
-> (ValidationPurpose, ScriptDatum)
-> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptDatum -> Value
_scriptDatumJsonValue (ScriptDatum -> Value)
-> ((ValidationPurpose, ScriptDatum) -> ScriptDatum)
-> (ValidationPurpose, ScriptDatum)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidationPurpose, ScriptDatum) -> ScriptDatum
forall a b. (a, b) -> b
snd) ([(ValidationPurpose, ScriptDatum)] -> [IO Redeemer])
-> [(ValidationPurpose, ScriptDatum)] -> [IO Redeemer]
forall a b. (a -> b) -> a -> b
$ Map Integer (ValidationPurpose, ScriptDatum)
-> [(ValidationPurpose, ScriptDatum)]
forall k a. Map k a -> [a]
elems Map Integer (ValidationPurpose, ScriptDatum)
datumMap
        [Redeemer]
redElems <- [IO Redeemer] -> IO [Redeemer]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [IO Redeemer]
newElems
        Redeemers -> IO Redeemers
forall (m :: * -> *) a. Monad m => a -> m a
return (Redeemers -> IO Redeemers) -> Redeemers -> IO Redeemers
forall a b. (a -> b) -> a -> b
$ [(RedeemerPtr, Redeemer)] -> Redeemers
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(RedeemerPtr, Redeemer)] -> Redeemers)
-> [(RedeemerPtr, Redeemer)] -> Redeemers
forall a b. (a -> b) -> a -> b
$ [RedeemerPtr] -> [Redeemer] -> [(RedeemerPtr, Redeemer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [RedeemerPtr]
redPtr [Redeemer]
redElems

    getAllScriptsMap :: Map Text ScriptCBOR -> IO (Map Ledger.ScriptHash (Versioned Ledger.Script))
    getAllScriptsMap :: Map Text ScriptCBOR -> IO (Map ScriptHash (Versioned Script))
getAllScriptsMap Map Text ScriptCBOR
scriptsMap = do
        let newKeys :: [ScriptHash]
newKeys = (Text -> ScriptHash) -> [Text] -> [ScriptHash]
forall a b. (a -> b) -> [a] -> [b]
map Text -> ScriptHash
textToScriptHash ([Text] -> [ScriptHash]) -> [Text] -> [ScriptHash]
forall a b. (a -> b) -> a -> b
$ Map Text ScriptCBOR -> [Text]
forall k a. Map k a -> [k]
keys Map Text ScriptCBOR
scriptsMap
            newElems :: [IO (Versioned Script)]
newElems = (ScriptCBOR -> IO (Versioned Script))
-> [ScriptCBOR] -> [IO (Versioned Script)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe (Versioned Script) -> Versioned Script)
-> IO (Maybe (Versioned Script)) -> IO (Versioned Script)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) Maybe (Versioned Script) -> Versioned Script
forall a. HasCallStack => Maybe a -> a
fromJust (IO (Maybe (Versioned Script)) -> IO (Versioned Script))
-> (ScriptCBOR -> IO (Maybe (Versioned Script)))
-> ScriptCBOR
-> IO (Versioned Script)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ScriptCBOR -> IO (Maybe (Versioned Script))
forall a.
PlutusValidator a =>
Maybe ScriptCBOR -> IO (Maybe (Versioned a))
processGetValidator (Maybe ScriptCBOR -> IO (Maybe (Versioned Script)))
-> (ScriptCBOR -> Maybe ScriptCBOR)
-> ScriptCBOR
-> IO (Maybe (Versioned Script))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptCBOR -> Maybe ScriptCBOR
forall a. a -> Maybe a
Just) ([ScriptCBOR] -> [IO (Versioned Script)])
-> [ScriptCBOR] -> [IO (Versioned Script)]
forall a b. (a -> b) -> a -> b
$ Map Text ScriptCBOR -> [ScriptCBOR]
forall k a. Map k a -> [a]
elems Map Text ScriptCBOR
scriptsMap
        [Versioned Script]
scriptElems <- [IO (Versioned Script)] -> IO [Versioned Script]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [IO (Versioned Script)]
newElems
        Map ScriptHash (Versioned Script)
-> IO (Map ScriptHash (Versioned Script))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map ScriptHash (Versioned Script)
 -> IO (Map ScriptHash (Versioned Script)))
-> Map ScriptHash (Versioned Script)
-> IO (Map ScriptHash (Versioned Script))
forall a b. (a -> b) -> a -> b
$ [(ScriptHash, Versioned Script)]
-> Map ScriptHash (Versioned Script)
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(ScriptHash, Versioned Script)]
 -> Map ScriptHash (Versioned Script))
-> [(ScriptHash, Versioned Script)]
-> Map ScriptHash (Versioned Script)
forall a b. (a -> b) -> a -> b
$ [ScriptHash]
-> [Versioned Script] -> [(ScriptHash, Versioned Script)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ScriptHash]
newKeys [Versioned Script]
scriptElems

    processTxIn ::
        Map Ledger.ScriptHash Ledger.Script
        -> Plutus.V1.Ledger.Tx.Redeemers
        -> Map Ledger.DatumHash Datum
        -> [UtxoInput]
        -> [TxIn]
    processTxIn :: Map ScriptHash Script
-> Redeemers -> Map DatumHash Datum -> [UtxoInput] -> [TxIn]
processTxIn Map ScriptHash Script
scripts Redeemers
redeemers Map DatumHash Datum
datums [UtxoInput]
utxoIns = (UtxoInput -> Integer -> TxIn)
-> [UtxoInput] -> [Integer] -> [TxIn]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith UtxoInput -> Integer -> TxIn
toPlutusTxIn [UtxoInput]
utxoIns [Integer
0..]
      where
        toPlutusTxIn :: UtxoInput -> Integer -> TxIn
        toPlutusTxIn :: UtxoInput -> Integer -> TxIn
toPlutusTxIn UtxoInput
utxoIn Integer
idx = case UtxoInput -> Credential
addr UtxoInput
utxoIn  of
                            ScriptCredential (ValidatorHash BuiltinByteString
bbs)  -> TxOutRef -> Versioned Validator -> Redeemer -> Maybe Datum -> TxIn
scriptTxIn (UtxoInput -> TxOutRef
txoToRef UtxoInput
utxoIn) (Validator -> Language -> Versioned Validator
forall script. script -> Language -> Versioned script
Versioned (BuiltinByteString -> Validator
val BuiltinByteString
bbs) Language
PlutusV1) (Integer -> Redeemer
red Integer
idx) (Datum -> Maybe Datum
forall a. a -> Maybe a
Just (Datum -> Maybe Datum) -> Datum -> Maybe Datum
forall a b. (a -> b) -> a -> b
$ UtxoInput -> Datum
dat UtxoInput
utxoIn)
                            PubKeyCredential PubKeyHash
_                    -> TxOutRef -> TxIn
pubKeyTxIn (TxOutRef -> TxIn) -> TxOutRef -> TxIn
forall a b. (a -> b) -> a -> b
$ UtxoInput -> TxOutRef
txoToRef UtxoInput
utxoIn

        addr :: UtxoInput -> Credential
        addr :: UtxoInput -> Credential
addr UtxoInput
utxoIn = (String -> Credential)
-> (AddressInEra BabbageEra -> Credential)
-> Either String (AddressInEra BabbageEra)
-> Credential
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> String -> Credential
forall a. HasCallStack => String -> a
error String
"processTxIn: Error decoding address") AddressInEra BabbageEra -> Credential
forall era. AddressInEra era -> Credential
Ledger.cardanoAddressCredential (Address -> Either String (AddressInEra BabbageEra)
toCardanoAddress (Address -> Either String (AddressInEra BabbageEra))
-> Address -> Either String (AddressInEra BabbageEra)
forall a b. (a -> b) -> a -> b
$ UtxoInput -> Address
_utxoInputAddress UtxoInput
utxoIn)

        red :: Integer -> Redeemer
        red :: Integer -> Redeemer
red Integer
idx = case ((RedeemerPtr, Redeemer) -> Bool)
-> [(RedeemerPtr, Redeemer)] -> Maybe (RedeemerPtr, Redeemer)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(RedeemerPtr ScriptTag
_ Integer
i, Redeemer
_) -> Integer
idx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
i) (Redeemers -> [(RedeemerPtr, Redeemer)]
forall k a. Map k a -> [(k, a)]
Map.toList Redeemers
redeemers) of
              Maybe (RedeemerPtr, Redeemer)
Nothing -> String -> Redeemer
forall a. HasCallStack => String -> a
error (String -> Redeemer) -> String -> Redeemer
forall a b. (a -> b) -> a -> b
$ String
"processTxIn: Can't find a redeemer that has the same index as this UtxoInput (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
idx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
              Just (RedeemerPtr
_, Redeemer
redeemer) -> Redeemer
redeemer

        val :: BuiltinByteString -> Validator
        val :: BuiltinByteString -> Validator
val BuiltinByteString
bbs = Script -> Validator
Validator (Script -> Validator) -> Script -> Validator
forall a b. (a -> b) -> a -> b
$ Maybe Script -> Script
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Script -> Script) -> Maybe Script -> Script
forall a b. (a -> b) -> a -> b
$ ScriptHash -> Map ScriptHash Script -> Maybe Script
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (BuiltinByteString -> ScriptHash
Ledger.ScriptHash BuiltinByteString
bbs) Map ScriptHash Script
scripts

        dat :: UtxoInput -> Datum
        dat :: UtxoInput -> Datum
dat UtxoInput
utxoIn = Maybe Datum -> Datum
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Datum -> Datum) -> Maybe Datum -> Datum
forall a b. (a -> b) -> a -> b
$ DatumHash -> Map DatumHash Datum -> Maybe Datum
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> DatumHash
textToDatumHash (Text -> DatumHash) -> Text -> DatumHash
forall a b. (a -> b) -> a -> b
$ DatumHash -> Text
unDatumHash (DatumHash -> Text) -> DatumHash -> Text
forall a b. (a -> b) -> a -> b
$ Maybe DatumHash -> DatumHash
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DatumHash -> DatumHash) -> Maybe DatumHash -> DatumHash
forall a b. (a -> b) -> a -> b
$ UtxoInput -> Maybe DatumHash
_utxoInputDataHash UtxoInput
utxoIn) Map DatumHash Datum
datums

processGetTxsFromTxIds :: [TxResponse] -> IO [ChainIndexTx]
processGetTxsFromTxIds :: [TxResponse] -> IO [ChainIndexTx]
processGetTxsFromTxIds [TxResponse]
txs = [Maybe ChainIndexTx] -> [ChainIndexTx]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ChainIndexTx] -> [ChainIndexTx])
-> IO [Maybe ChainIndexTx] -> IO [ChainIndexTx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxResponse -> IO (Maybe ChainIndexTx))
-> [TxResponse] -> IO [Maybe ChainIndexTx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe TxResponse -> IO (Maybe ChainIndexTx)
processGetTxFromTxId (Maybe TxResponse -> IO (Maybe ChainIndexTx))
-> (TxResponse -> Maybe TxResponse)
-> TxResponse
-> IO (Maybe ChainIndexTx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxResponse -> Maybe TxResponse
forall a. a -> Maybe a
Just) [TxResponse]
txs