{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Rpc.Server.Internal.UtxoRpc.Query
  ( readParamsMethod
  , readUtxosMethod
  )
where

import Cardano.Api
import Cardano.Api.Experimental.Era
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc
import Cardano.Rpc.Server.Internal.Error
import Cardano.Rpc.Server.Internal.Monad
import Cardano.Rpc.Server.Internal.Orphans ()
import Cardano.Rpc.Server.Internal.UtxoRpc.Type

import RIO hiding (toList)

import Data.Default
import Data.ProtoLens (defMessage)
import GHC.IsList
import Network.GRPC.Spec

readParamsMethod
  :: MonadRpc e m
  => Proto UtxoRpc.ReadParamsRequest
  -> m (Proto UtxoRpc.ReadParamsResponse)
readParamsMethod :: forall e (m :: * -> *).
MonadRpc e m =>
Proto ReadParamsRequest -> m (Proto ReadParamsResponse)
readParamsMethod Proto ReadParamsRequest
_req = do
  -- TODO: implement field masks - they are ignored for now
  -- they need to be normalised beforehand, see: https://github.com/protocolbuffers/protobuf/blob/main/java/util/src/main/java/com/google/protobuf/util/FieldMaskTree.java#L76
  -- let fieldMask :: [Text] = req ^. #fieldMask . #paths
  nodeConnInfo <- m LocalNodeConnectInfo
forall field env (m :: * -> *).
(Has field env, MonadReader env m) =>
m field
grab
  AnyCardanoEra era <- liftIO . throwExceptT $ determineEra nodeConnInfo
  eon <- forEraInEon @Era era (error "Minimum Conway era required") pure
  let sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
eon

  let target = Target point
forall point. Target point
VolatileTip
  (pparams, chainPoint, blockNo) <- liftIO . (throwEither =<<) $ executeLocalStateQueryExpr nodeConnInfo target $ do
    pparams <- throwEither =<< throwEither =<< queryProtocolParameters sbe
    chainPoint <- throwEither =<< queryChainPoint
    blockNo <- throwEither =<< queryChainBlockNo
    pure (pparams, chainPoint, blockNo)

  pure $
    def
      & #ledgerTip .~ mkChainPointMsg chainPoint blockNo
      & #values . #cardano .~ obtainCommonConstraints eon (protocolParamsToUtxoRpcPParams eon pparams)

readUtxosMethod
  :: MonadRpc e m
  => Proto UtxoRpc.ReadUtxosRequest
  -> m (Proto UtxoRpc.ReadUtxosResponse)
readUtxosMethod :: forall e (m :: * -> *).
MonadRpc e m =>
Proto ReadUtxosRequest -> m (Proto ReadUtxosResponse)
readUtxosMethod Proto ReadUtxosRequest
req = do
  utxoFilter <-
    if Bool -> Bool
not ([Proto TxoRef] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Proto TxoRef] -> Bool) -> [Proto TxoRef] -> Bool
forall a b. (a -> b) -> a -> b
$ Proto ReadUtxosRequest
req Proto ReadUtxosRequest
-> Getting [Proto TxoRef] (Proto ReadUtxosRequest) [Proto TxoRef]
-> [Proto TxoRef]
forall s a. s -> Getting a s a -> a
^. Getting [Proto TxoRef] (Proto ReadUtxosRequest) [Proto TxoRef]
#keys)
      then Set TxIn -> QueryUTxOFilter
QueryUTxOByTxIn (Set TxIn -> QueryUTxOFilter)
-> ([TxIn] -> Set TxIn) -> [TxIn] -> QueryUTxOFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item (Set TxIn)] -> Set TxIn
[TxIn] -> Set TxIn
forall l. IsList l => [Item l] -> l
fromList ([TxIn] -> QueryUTxOFilter) -> m [TxIn] -> m QueryUTxOFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Proto TxoRef -> m TxIn) -> [Proto TxoRef] -> m [TxIn]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Proto TxoRef -> m TxIn
forall e (m :: * -> *). MonadRpc e m => Proto TxoRef -> m TxIn
txoRefToTxIn (Proto ReadUtxosRequest
req Proto ReadUtxosRequest
-> Getting [Proto TxoRef] (Proto ReadUtxosRequest) [Proto TxoRef]
-> [Proto TxoRef]
forall s a. s -> Getting a s a -> a
^. Getting [Proto TxoRef] (Proto ReadUtxosRequest) [Proto TxoRef]
#keys)
      -- TODO: reimplement this part as SearchUtxosRequest
      -- \| Just addressesProto <- req ^. #maybe'cardanoAddresses ->
      --     QueryUTxOByAddress . fromList <$> mapM readAddress (addressesProto ^. #items)
      else QueryUTxOFilter -> m QueryUTxOFilter
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryUTxOFilter
QueryUTxOWhole

  nodeConnInfo <- grab
  AnyCardanoEra era <- liftIO . throwExceptT $ determineEra nodeConnInfo
  eon <- forEraInEon @Era era (error "Minimum Conway era required") pure

  let target = Target point
forall point. Target point
VolatileTip
  (utxo, chainPoint, blockNo) <- liftIO . (throwEither =<<) $ executeLocalStateQueryExpr nodeConnInfo target $ do
    utxo <- throwEither =<< throwEither =<< queryUtxo (convert eon) utxoFilter
    chainPoint <- throwEither =<< queryChainPoint
    blockNo <- throwEither =<< queryChainBlockNo
    pure (utxo, chainPoint, blockNo)

  pure $
    defMessage
      & #ledgerTip .~ mkChainPointMsg chainPoint blockNo
      & #items .~ obtainCommonConstraints eon (utxoToUtxoRpcAnyUtxoData utxo)
 where
  txoRefToTxIn :: MonadRpc e m => Proto UtxoRpc.TxoRef -> m TxIn
  txoRefToTxIn :: forall e (m :: * -> *). MonadRpc e m => Proto TxoRef -> m TxIn
txoRefToTxIn Proto TxoRef
r = do
    txId' <- Either SerialiseAsRawBytesError TxId -> m TxId
forall e (m :: * -> *) a.
(Error e, HasCallStack, MonadIO m, Show e, Typeable e) =>
Either e a -> m a
throwEither (Either SerialiseAsRawBytesError TxId -> m TxId)
-> Either SerialiseAsRawBytesError TxId -> m TxId
forall a b. (a -> b) -> a -> b
$ AsType TxId -> ByteString -> Either SerialiseAsRawBytesError TxId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType TxId
AsTxId (ByteString -> Either SerialiseAsRawBytesError TxId)
-> ByteString -> Either SerialiseAsRawBytesError TxId
forall a b. (a -> b) -> a -> b
$ Proto TxoRef
r Proto TxoRef
-> Getting ByteString (Proto TxoRef) ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Proto TxoRef) ByteString
#hash
    pure $ TxIn txId' (TxIx . fromIntegral $ r ^. #index)

-- TODO: reimplement this part as SearchUtxosRequest
-- readAddress :: MonadRpc e m => ByteString -> m AddressAny
-- readAddress =
--   throwEither . first stringException . P.runParser parseAddressAny <=< throwEither . T.decodeUtf8'