\subsection{Replies to RPC requests}
A \textit{reply} to a Request packet is a Response packet with the Request ID in
the Response packet set equal to the Request ID in the Request packet.  A
response is accepted if and only if it is the first received reply to a request
which was sent sufficiently recently, according to a time limit which depends on
the service.

\begin{code}
{-# LANGUAGE Safe       #-}
{-# LANGUAGE StrictData #-}
module Network.Tox.DHT.PendingReplies where

import qualified Network.Tox.DHT.RpcPacket     as RpcPacket
import           Network.Tox.DHT.Stamped       (Stamped)
import qualified Network.Tox.DHT.Stamped       as Stamped
import           Network.Tox.NodeInfo.NodeInfo (NodeInfo)
import           Network.Tox.Time              (Timestamp)

{-------------------------------------------------------------------------------
 -
 - :: Implementation.
 -
 ------------------------------------------------------------------------------}

type PendingReplies = Stamped (NodeInfo, RpcPacket.RequestId)

expectReply :: Timestamp -> NodeInfo -> RpcPacket.RequestId ->
  PendingReplies -> PendingReplies
expectReply :: Timestamp
-> NodeInfo -> RequestId -> PendingReplies -> PendingReplies
expectReply Timestamp
time NodeInfo
node RequestId
requestId = Timestamp
-> (NodeInfo, RequestId) -> PendingReplies -> PendingReplies
forall a. Timestamp -> a -> Stamped a -> Stamped a
Stamped.add Timestamp
time (NodeInfo
node, RequestId
requestId)

checkExpectedReply :: Timestamp -> NodeInfo -> RpcPacket.RequestId ->
  PendingReplies -> (Bool, PendingReplies)
checkExpectedReply :: Timestamp
-> NodeInfo
-> RequestId
-> PendingReplies
-> (Bool, PendingReplies)
checkExpectedReply Timestamp
cutoff NodeInfo
node RequestId
requestId PendingReplies
pendingReplies =
  case (Timestamp -> Bool) -> [Timestamp] -> [Timestamp]
forall a. (a -> Bool) -> [a] -> [a]
filter (Timestamp -> Timestamp -> Bool
forall a. Ord a => a -> a -> Bool
>= Timestamp
cutoff) ([Timestamp] -> [Timestamp]) -> [Timestamp] -> [Timestamp]
forall a b. (a -> b) -> a -> b
$
    ((NodeInfo, RequestId) -> Bool) -> PendingReplies -> [Timestamp]
forall a. (a -> Bool) -> Stamped a -> [Timestamp]
Stamped.findStamps ((NodeInfo, RequestId) -> (NodeInfo, RequestId) -> Bool
forall a. Eq a => a -> a -> Bool
== (NodeInfo
node, RequestId
requestId)) PendingReplies
pendingReplies
  of
    []     -> (Bool
False, PendingReplies
pendingReplies)
    Timestamp
time:[Timestamp]
_ -> (Bool
True, Timestamp
-> (NodeInfo, RequestId) -> PendingReplies -> PendingReplies
forall a. Eq a => Timestamp -> a -> Stamped a -> Stamped a
Stamped.delete Timestamp
time (NodeInfo
node, RequestId
requestId) PendingReplies
pendingReplies)

{-------------------------------------------------------------------------------
 -
 - :: Tests.
 -
 ------------------------------------------------------------------------------}

\end{code}