{-# LANGUAGE LambdaCase #-}

module Marconi.Api.UtxoIndexersQuery
    ( bootstrap
    , findByCardanoAddress
    , findByAddress
    , findAll
    , reportQueryAddresses
    , Utxo.UtxoRow(..)
    , Utxo.UtxoIndex
    , reportQueryCardanoAddresses
    , reportBech32Addresses
    , withQueryAction
    , writeTMVar
    ) where
import Control.Concurrent.Async (forConcurrently)
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TMVar (TMVar, newEmptyTMVar, putTMVar, takeTMVar, tryTakeTMVar)
import Control.Exception (bracket)
import Control.Lens ((^.))
import Control.Monad.STM (STM)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Text (Text, intercalate, pack, unpack)

import Cardano.Api qualified as C
import Marconi.Api.Types (DBQueryEnv (DBQueryEnv, _queryAddresses, _queryTMVar),
                          HasDBQueryEnv (queryAddresses, queryTMVar),
                          QueryExceptions (AddressNotInListError, QueryError), TargetAddresses,
                          UtxoTxOutReport (UtxoTxOutReport))
import Marconi.Index.Utxo qualified as Utxo
import Marconi.Indexers (UtxoQueryTMVar (UtxoQueryTMVar, unUtxoIndex))

-- | Bootstraps the utxo query environment.
-- The module is responsible for accessing SQLite for quries.
-- The main issue we try to avoid here is mixing inserts and quries in SQLite to avoid locking the database
bootstrap
    :: TargetAddresses          -- ^ user provided target addresses
    -> IO DBQueryEnv            -- ^ returns Query runtime environment
bootstrap :: TargetAddresses -> IO DBQueryEnv
bootstrap TargetAddresses
targetAddresses = do
    TMVar UtxoIndex
ix <- STM (TMVar UtxoIndex) -> IO (TMVar UtxoIndex)
forall a. STM a -> IO a
atomically (STM (TMVar UtxoIndex)
forall a. STM (TMVar a)
newEmptyTMVar :: STM (TMVar Utxo.UtxoIndex) )
    DBQueryEnv -> IO DBQueryEnv
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DBQueryEnv -> IO DBQueryEnv) -> DBQueryEnv -> IO DBQueryEnv
forall a b. (a -> b) -> a -> b
$ DBQueryEnv :: UtxoQueryTMVar -> TargetAddresses -> DBQueryEnv
DBQueryEnv
        { _queryTMVar :: UtxoQueryTMVar
_queryTMVar = TMVar UtxoIndex -> UtxoQueryTMVar
UtxoQueryTMVar TMVar UtxoIndex
ix
        , _queryAddresses :: TargetAddresses
_queryAddresses = TargetAddresses
targetAddresses
        }
-- | finds reports for all user-provided addresses.
-- TODO consider sqlite streaming, https://hackage.haskell.org/package/sqlite-simple-0.4.18.2/docs/Database-SQLite-Simple.html#g:14
--
findAll
    :: DBQueryEnv                   -- ^ Query run time environment
    -> IO [UtxoTxOutReport]         -- ^ set of corresponding TxOutRefs
findAll :: DBQueryEnv -> IO [UtxoTxOutReport]
findAll DBQueryEnv
env = [Address ShelleyAddr]
-> (Address ShelleyAddr -> IO UtxoTxOutReport)
-> IO [UtxoTxOutReport]
forall (t :: * -> *) a b.
Traversable t =>
t a -> (a -> IO b) -> IO (t b)
forConcurrently [Address ShelleyAddr]
addresses Address ShelleyAddr -> IO UtxoTxOutReport
f
    where
        addresses :: [Address ShelleyAddr]
addresses = TargetAddresses -> [Address ShelleyAddr]
forall a. NonEmpty a -> [a]
NonEmpty.toList (DBQueryEnv
env DBQueryEnv
-> Getting TargetAddresses DBQueryEnv TargetAddresses
-> TargetAddresses
forall s a. s -> Getting a s a -> a
^. Getting TargetAddresses DBQueryEnv TargetAddresses
forall c. HasDBQueryEnv c => Lens' c TargetAddresses
queryAddresses)

        f  :: C.Address C.ShelleyAddr -> IO (UtxoTxOutReport)
        f :: Address ShelleyAddr -> IO UtxoTxOutReport
f Address ShelleyAddr
addr = (DBQueryEnv -> AddressAny -> IO [UtxoRow]
findByCardanoAddress DBQueryEnv
env (AddressAny -> IO [UtxoRow])
-> (Address ShelleyAddr -> AddressAny)
-> Address ShelleyAddr
-> IO [UtxoRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address ShelleyAddr -> AddressAny
forall addr. Address addr -> AddressAny
C.toAddressAny (Address ShelleyAddr -> IO [UtxoRow])
-> Address ShelleyAddr -> IO [UtxoRow]
forall a b. (a -> b) -> a -> b
$ Address ShelleyAddr
addr) IO [UtxoRow]
-> ([UtxoRow] -> IO UtxoTxOutReport) -> IO UtxoTxOutReport
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UtxoTxOutReport -> IO UtxoTxOutReport
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UtxoTxOutReport -> IO UtxoTxOutReport)
-> ([UtxoRow] -> UtxoTxOutReport)
-> [UtxoRow]
-> IO UtxoTxOutReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [UtxoRow] -> UtxoTxOutReport
UtxoTxOutReport (String -> Text
pack (String -> Text)
-> (Address ShelleyAddr -> String) -> Address ShelleyAddr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address ShelleyAddr -> String
forall a. Show a => a -> String
show (Address ShelleyAddr -> Text) -> Address ShelleyAddr -> Text
forall a b. (a -> b) -> a -> b
$ Address ShelleyAddr
addr))


-- | Query utxos by Cardano Address
--  To Cardano error may occure
findByCardanoAddress
    :: DBQueryEnv                   -- ^ Query run time environment
    -> C.AddressAny                 -- ^ Cardano address to query
    -> IO [Utxo.UtxoRow]
findByCardanoAddress :: DBQueryEnv -> AddressAny -> IO [UtxoRow]
findByCardanoAddress  = DBQueryEnv -> AddressAny -> IO [UtxoRow]
withQueryAction

-- | Retrieve a Set of TxOutRefs associated with the given Cardano Era address
-- We return an empty Set if no address is found
findByAddress
    :: DBQueryEnv                                   -- ^ Query run time environment
    -> Text                                         -- ^ Bech32 Address
    -> IO (Either QueryExceptions UtxoTxOutReport)  -- ^ To Plutus address conversion error may occure
findByAddress :: DBQueryEnv -> Text -> IO (Either QueryExceptions UtxoTxOutReport)
findByAddress DBQueryEnv
env Text
addressText =
    let
        f :: Either C.Bech32DecodeError (C.Address C.ShelleyAddr) -> IO (Either QueryExceptions UtxoTxOutReport)
        f :: Either Bech32DecodeError (Address ShelleyAddr)
-> IO (Either QueryExceptions UtxoTxOutReport)
f (Right Address ShelleyAddr
address)
            | Address ShelleyAddr
address Address ShelleyAddr -> TargetAddresses -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (DBQueryEnv
env DBQueryEnv
-> Getting TargetAddresses DBQueryEnv TargetAddresses
-> TargetAddresses
forall s a. s -> Getting a s a -> a
^. Getting TargetAddresses DBQueryEnv TargetAddresses
forall c. HasDBQueryEnv c => Lens' c TargetAddresses
queryAddresses) = -- allow for targetAddress search only
              (AddressAny -> IO AddressAny
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddressAny -> IO AddressAny)
-> (Address ShelleyAddr -> AddressAny)
-> Address ShelleyAddr
-> IO AddressAny
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address ShelleyAddr -> AddressAny
forall addr. Address addr -> AddressAny
C.toAddressAny (Address ShelleyAddr -> IO AddressAny)
-> Address ShelleyAddr -> IO AddressAny
forall a b. (a -> b) -> a -> b
$ Address ShelleyAddr
address)
              IO AddressAny -> (AddressAny -> IO [UtxoRow]) -> IO [UtxoRow]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DBQueryEnv -> AddressAny -> IO [UtxoRow]
findByCardanoAddress DBQueryEnv
env
              IO [UtxoRow]
-> ([UtxoRow] -> IO (Either QueryExceptions UtxoTxOutReport))
-> IO (Either QueryExceptions UtxoTxOutReport)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either QueryExceptions UtxoTxOutReport
-> IO (Either QueryExceptions UtxoTxOutReport)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QueryExceptions UtxoTxOutReport
 -> IO (Either QueryExceptions UtxoTxOutReport))
-> ([UtxoRow] -> Either QueryExceptions UtxoTxOutReport)
-> [UtxoRow]
-> IO (Either QueryExceptions UtxoTxOutReport)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoTxOutReport -> Either QueryExceptions UtxoTxOutReport
forall a b. b -> Either a b
Right (UtxoTxOutReport -> Either QueryExceptions UtxoTxOutReport)
-> ([UtxoRow] -> UtxoTxOutReport)
-> [UtxoRow]
-> Either QueryExceptions UtxoTxOutReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [UtxoRow] -> UtxoTxOutReport
UtxoTxOutReport Text
addressText
            | Bool
otherwise = Either QueryExceptions UtxoTxOutReport
-> IO (Either QueryExceptions UtxoTxOutReport)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QueryExceptions UtxoTxOutReport
 -> IO (Either QueryExceptions UtxoTxOutReport))
-> (String -> Either QueryExceptions UtxoTxOutReport)
-> String
-> IO (Either QueryExceptions UtxoTxOutReport)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryExceptions -> Either QueryExceptions UtxoTxOutReport
forall a b. a -> Either a b
Left (QueryExceptions -> Either QueryExceptions UtxoTxOutReport)
-> (String -> QueryExceptions)
-> String
-> Either QueryExceptions UtxoTxOutReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryExceptions -> QueryExceptions
AddressNotInListError (QueryExceptions -> QueryExceptions)
-> (String -> QueryExceptions) -> String -> QueryExceptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> QueryExceptions
QueryError (String -> IO (Either QueryExceptions UtxoTxOutReport))
-> String -> IO (Either QueryExceptions UtxoTxOutReport)
forall a b. (a -> b) -> a -> b
$
              Text -> String
unpack Text
addressText String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not in the provided target addresses"
        f (Left Bech32DecodeError
e) = Either QueryExceptions UtxoTxOutReport
-> IO (Either QueryExceptions UtxoTxOutReport)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either QueryExceptions UtxoTxOutReport
 -> IO (Either QueryExceptions UtxoTxOutReport))
-> (QueryExceptions -> Either QueryExceptions UtxoTxOutReport)
-> QueryExceptions
-> IO (Either QueryExceptions UtxoTxOutReport)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryExceptions -> Either QueryExceptions UtxoTxOutReport
forall a b. a -> Either a b
Left (QueryExceptions -> IO (Either QueryExceptions UtxoTxOutReport))
-> QueryExceptions -> IO (Either QueryExceptions UtxoTxOutReport)
forall a b. (a -> b) -> a -> b
$ String -> QueryExceptions
QueryError (Text -> String
unpack  Text
addressText
                     String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" generated error: "
                     String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Bech32DecodeError -> String
forall a. Show a => a -> String
show Bech32DecodeError
e)
    in
        Either Bech32DecodeError (Address ShelleyAddr)
-> IO (Either QueryExceptions UtxoTxOutReport)
f (Either Bech32DecodeError (Address ShelleyAddr)
 -> IO (Either QueryExceptions UtxoTxOutReport))
-> Either Bech32DecodeError (Address ShelleyAddr)
-> IO (Either QueryExceptions UtxoTxOutReport)
forall a b. (a -> b) -> a -> b
$ AsType (Address ShelleyAddr)
-> Text -> Either Bech32DecodeError (Address ShelleyAddr)
forall a.
SerialiseAsBech32 a =>
AsType a -> Text -> Either Bech32DecodeError a
C.deserialiseFromBech32 AsType (Address ShelleyAddr)
C.AsShelleyAddress Text
addressText

-- | Execute the query function
-- We must stop the utxo inserts before doing the query
withQueryAction
    :: DBQueryEnv                                            -- ^ Query run time environment
    -> C.AddressAny                                          -- ^ Cardano address to query
    -> IO [Utxo.UtxoRow]
withQueryAction :: DBQueryEnv -> AddressAny -> IO [UtxoRow]
withQueryAction DBQueryEnv
env AddressAny
address =
    let
        utxoIndexer :: TMVar UtxoIndex
utxoIndexer = UtxoQueryTMVar -> TMVar UtxoIndex
unUtxoIndex  (UtxoQueryTMVar -> TMVar UtxoIndex)
-> UtxoQueryTMVar -> TMVar UtxoIndex
forall a b. (a -> b) -> a -> b
$ DBQueryEnv
env DBQueryEnv
-> Getting UtxoQueryTMVar DBQueryEnv UtxoQueryTMVar
-> UtxoQueryTMVar
forall s a. s -> Getting a s a -> a
^. Getting UtxoQueryTMVar DBQueryEnv UtxoQueryTMVar
forall c. HasDBQueryEnv c => Lens' c UtxoQueryTMVar
queryTMVar
        action :: Utxo.UtxoIndex -> IO [Utxo.UtxoRow]
        action :: UtxoIndex -> IO [UtxoRow]
action UtxoIndex
ndxr = do
            Result
mayberows <- (UtxoIndex -> AddressAny -> IO Result
Utxo.queryPlusVolatile UtxoIndex
ndxr AddressAny
address)
            let rows :: [UtxoRow]
rows =  case Result
mayberows of
                    Result
Nothing -> []
                    Just [UtxoRow]
r  -> [UtxoRow]
r
            [UtxoRow] -> IO [UtxoRow]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [UtxoRow]
rows
    in
        IO UtxoIndex
-> (UtxoIndex -> IO ())
-> (UtxoIndex -> IO [UtxoRow])
-> IO [UtxoRow]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
          (STM UtxoIndex -> IO UtxoIndex
forall a. STM a -> IO a
atomically (STM UtxoIndex -> IO UtxoIndex) -> STM UtxoIndex -> IO UtxoIndex
forall a b. (a -> b) -> a -> b
$ TMVar UtxoIndex -> STM UtxoIndex
forall a. TMVar a -> STM a
takeTMVar  TMVar UtxoIndex
utxoIndexer)
          (STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> (UtxoIndex -> STM ()) -> UtxoIndex -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TMVar UtxoIndex -> UtxoIndex -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar UtxoIndex
utxoIndexer))
          UtxoIndex -> IO [UtxoRow]
action

-- | report target addresses
-- Used by JSON-RPC
reportQueryAddresses
    :: DBQueryEnv
    -> IO [(C.Address C.ShelleyAddr)]
reportQueryAddresses :: DBQueryEnv -> IO [Address ShelleyAddr]
reportQueryAddresses DBQueryEnv
env
    = [Address ShelleyAddr] -> IO [Address ShelleyAddr]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ([Address ShelleyAddr] -> IO [Address ShelleyAddr])
-> (TargetAddresses -> [Address ShelleyAddr])
-> TargetAddresses
-> IO [Address ShelleyAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetAddresses -> [Address ShelleyAddr]
forall a. NonEmpty a -> [a]
NonEmpty.toList
    (TargetAddresses -> IO [Address ShelleyAddr])
-> TargetAddresses -> IO [Address ShelleyAddr]
forall a b. (a -> b) -> a -> b
$ (DBQueryEnv
env DBQueryEnv
-> Getting TargetAddresses DBQueryEnv TargetAddresses
-> TargetAddresses
forall s a. s -> Getting a s a -> a
^. Getting TargetAddresses DBQueryEnv TargetAddresses
forall c. HasDBQueryEnv c => Lens' c TargetAddresses
queryAddresses )

reportQueryCardanoAddresses
    :: DBQueryEnv
    -> Text
reportQueryCardanoAddresses :: DBQueryEnv -> Text
reportQueryCardanoAddresses  = Text -> [Text] -> Text
intercalate Text
", " ([Text] -> Text) -> (DBQueryEnv -> [Text]) -> DBQueryEnv -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBQueryEnv -> [Text]
reportBech32Addresses

reportBech32Addresses
    :: DBQueryEnv
    -> [Text]
reportBech32Addresses :: DBQueryEnv -> [Text]
reportBech32Addresses DBQueryEnv
env
    = NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList
    (NonEmpty Text -> [Text])
-> (TargetAddresses -> NonEmpty Text) -> TargetAddresses -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Address ShelleyAddr -> Text) -> TargetAddresses -> NonEmpty Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Address ShelleyAddr -> Text
forall addr. SerialiseAddress addr => addr -> Text
C.serialiseAddress
    (TargetAddresses -> [Text]) -> TargetAddresses -> [Text]
forall a b. (a -> b) -> a -> b
$ (DBQueryEnv
env DBQueryEnv
-> Getting TargetAddresses DBQueryEnv TargetAddresses
-> TargetAddresses
forall s a. s -> Getting a s a -> a
^. Getting TargetAddresses DBQueryEnv TargetAddresses
forall c. HasDBQueryEnv c => Lens' c TargetAddresses
queryAddresses )

-- | Non-blocking write of a new value to a 'TMVar'
-- Puts if empty. Replaces if populated.
writeTMVar :: TMVar a -> a -> STM ()
writeTMVar :: TMVar a -> a -> STM ()
writeTMVar TMVar a
t a
new = TMVar a -> STM (Maybe a)
forall a. TMVar a -> STM (Maybe a)
tryTakeTMVar TMVar a
t STM (Maybe a) -> STM () -> STM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TMVar a -> a -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar a
t a
new