{-# LANGUAGE OverloadedStrings #-}

-- | Actions that record their name when they run, and the values they return,
-- for testing which queries a field fill runs.
module Test.Cardano.Rpc.RecordedQuery where

import Cardano.Api (ChainPoint (..))
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as U5c
import Cardano.Rpc.Server.Internal.FieldMask (FieldFill, FieldPath, resolve, runFill)
import Cardano.Rpc.Server.Internal.UtxoRpc.Type (mkChainPointMsg)

import Cardano.Slotting.Slot (WithOrigin (..))

import RIO
import RIO.Writer (Writer, runWriter, tell)

import Data.ProtoLens (Message)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Network.GRPC.Spec (getProto)

-- | Run a fill for the mask paths, recording the session and each query it runs.
runRecordedFill
  :: Message msg
  => [FieldPath]
  -- ^ Field mask paths, rooted at the response
  -> FieldFill (Writer [Text]) msg
  -- ^ Fills the response from recorded actions
  -> (msg, [Text])
runRecordedFill :: forall msg.
Message msg =>
[FieldPath]
-> FieldFill (Writer [FieldPath]) msg -> (msg, [FieldPath])
runRecordedFill [FieldPath]
paths = Writer [FieldPath] msg -> (msg, [FieldPath])
forall w a. Writer w a -> (a, w)
runWriter (Writer [FieldPath] msg -> (msg, [FieldPath]))
-> (FieldFill (Writer [FieldPath]) msg -> Writer [FieldPath] msg)
-> FieldFill (Writer [FieldPath]) msg
-> (msg, [FieldPath])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Writer [FieldPath] x -> Writer [FieldPath] x)
-> FieldMaskTree msg
-> FieldFill (Writer [FieldPath]) msg
-> Writer [FieldPath] msg
forall (n :: * -> *) msg (m :: * -> *).
(Applicative n, Message msg) =>
(forall x. m x -> n x)
-> FieldMaskTree msg -> FieldFill m msg -> n msg
runFill Writer [FieldPath] x -> Writer [FieldPath] x
forall x. Writer [FieldPath] x -> Writer [FieldPath] x
session ([FieldPath] -> FieldMaskTree msg
forall msg. Message msg => [FieldPath] -> FieldMaskTree msg
resolve [FieldPath]
paths)

-- | An action that records its name when it runs.
recorded
  :: Text
  -- ^ The name to record
  -> a
  -- ^ The result of the action
  -> Writer [Text] a
recorded :: forall a. FieldPath -> a -> Writer [FieldPath] a
recorded FieldPath
name a
value = [FieldPath] -> WriterT [FieldPath] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [FieldPath
name] WriterT [FieldPath] Identity ()
-> a -> WriterT [FieldPath] Identity a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
value

-- | A runner that records each session it opens.
session
  :: Writer [Text] a
  -- ^ The actions to run in the session
  -> Writer [Text] a
session :: forall x. Writer [FieldPath] x -> Writer [FieldPath] x
session = ([FieldPath] -> WriterT [FieldPath] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [FieldPath
"session"] WriterT [FieldPath] Identity ()
-> WriterT [FieldPath] Identity a -> WriterT [FieldPath] Identity a
forall a b.
WriterT [FieldPath] Identity a
-> WriterT [FieldPath] Identity b -> WriterT [FieldPath] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>)

-- | The chain tip that the recorded tip queries return.
realTip :: U5c.ChainPoint
realTip :: ChainPoint
realTip = Proto ChainPoint -> ChainPoint
forall msg. Proto msg -> msg
getProto (Proto ChainPoint -> ChainPoint) -> Proto ChainPoint -> ChainPoint
forall a b. (a -> b) -> a -> b
$ ChainPoint -> WithOrigin BlockNo -> UTCTime -> Proto ChainPoint
mkChainPointMsg ChainPoint
ChainPointAtGenesis WithOrigin BlockNo
forall t. WithOrigin t
Origin (NominalDiffTime -> UTCTime
posixSecondsToUTCTime NominalDiffTime
1)