manage incoming request parts before handling

This commit is contained in:
Trolli Schmittlauch 2020-05-31 01:13:34 +02:00
parent 2542091379
commit bcd1c34c7c
3 changed files with 76 additions and 33 deletions

View file

@ -152,15 +152,16 @@ isJoined_ ns = not . all null $ [successors ns, predecessors ns]
-- ====== message send and receive operations ====== -- ====== message send and receive operations ======
handleIncomingRequest :: LocalNodeState -- ^ the handling node handleIncomingRequest :: LocalNodeState -- ^ the handling node
-> TQueue (BS.ByteString, SockAddr) -- ^ send queue -> TQueue (BS.ByteString, SockAddr) -- ^ send queue
-> FediChordMessage -- ^ request to handle -> Set.Set FediChordMessage -- ^ all parts of the request to handle
-> SockAddr -- ^ source address of the request -> SockAddr -- ^ source address of the request
-> IO () -> IO ()
handleIncomingRequest ns sendQ msg sourceAddr = do handleIncomingRequest ns sendQ msgSet sourceAddr = do
-- add nodestate to cache -- add nodestate to cache
now <- getPOSIXTime now <- getPOSIXTime
queueAddEntries (Identity . RemoteCacheEntry (sender msg) $ now) ns queueAddEntries (Identity . RemoteCacheEntry (sender . head . Set.elems $ msgSet) $ now) ns
-- distinguish on whether and how to respond -- distinguish on whether and how to respond
-- create and enqueue ACK -- create and enqueue ACK
-- Idea: only respond with payload on last part (part == parts), problem: need to know partnumber of response from first part on -- Idea: only respond with payload on last part (part == parts), problem: need to know partnumber of response from first part on

View file

@ -47,10 +47,12 @@ module Hash2Pub.FediChord (
, cacheWriter , cacheWriter
) where ) where
import Control.Applicative ((<|>))
import Control.Exception import Control.Exception
import Data.Foldable (foldr') import Data.Foldable (foldr')
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Maybe (fromJust, fromMaybe, isJust,
mapMaybe)
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import Network.Socket hiding (recv, recvFrom, send, import Network.Socket hiding (recv, recvFrom, send,
@ -207,30 +209,70 @@ fediMainThreads sock ns = do
(recvThread sock recvQ) (recvThread sock recvQ)
-- defining this here as, for now, the RequestMap is only used by fediMessageHandler.
-- Once that changes, move to FediChordTypes
type RequestMap = Map.Map (SockAddr, Integer) RequestMapEntry
data RequestMapEntry = RequestMapEntry (Set.Set FediChordMessage) (Maybe Integer)
POSIXTime
requestMapPurge :: MVar RequestMap -> IO ()
-- PLACEHOLDER
requestMapPurge mapVar = pure ()
-- | Wait for messages, deserialise them, manage parts and acknowledgement status, -- | Wait for messages, deserialise them, manage parts and acknowledgement status,
-- and pass them to their specific handling function. -- and pass them to their specific handling function.
fediMessageHandler :: TQueue (BS.ByteString, SockAddr) -- ^ send queue fediMessageHandler :: TQueue (BS.ByteString, SockAddr) -- ^ send queue
-> TQueue (BS.ByteString, SockAddr) -- ^ receive queue -> TQueue (BS.ByteString, SockAddr) -- ^ receive queue
-> LocalNodeState -- ^ acting NodeState -> LocalNodeState -- ^ acting NodeState
-> IO () -> IO ()
fediMessageHandler sendQ recvQ ns = forever $ do fediMessageHandler sendQ recvQ ns = do
-- wait for incoming messages
(rawMsg, sourceAddr) <- atomically $ readTQueue recvQ
let aMsg = deserialiseMessage rawMsg
-- handling multipart messages: -- handling multipart messages:
-- So far I handle the effects of each message part immedeiately, before making sure that and whether all parts have been received, based on the idea that even incomplete information is beneficial and handled idempotent. -- Request parts can be insert into a map (key: (sender IP against spoofing, request ID), value: timestamp + set of message parts, handle all of them when size of set == parts) before being handled. This map needs to be purged periodically by a separate thread and can be protected by an MVar for fairness.
-- If this turns out not to be the case, request parts can be insert into a map (key: (sender IP against spoofing, request ID), value: timestamp + set of message parts, handle all of them when size of set == parts) before being handled. This map needs to be purged periodically by a separate thread and can be protected by an MVar for fairness. requestMap <- newMVar (Map.empty :: RequestMap)
either (\_ -> forever $ do
-- drop invalid messages -- wait for incoming messages
pure () (rawMsg, sourceAddr) <- atomically $ readTQueue recvQ
) let aMsg = deserialiseMessage rawMsg
(\validMsg -> either (\_ ->
case validMsg of -- drop invalid messages
aRequest@Request{} -> forkIO (handleIncomingRequest ns sendQ aRequest sourceAddr) >> pure () pure ()
-- Responses should never arrive on the main server port, as they are always )
-- responses to requests sent from dedicated sockets on another port (\validMsg ->
_ -> pure () case validMsg of
) aRequest@Request{}
aMsg -- if not a multipart message, handle immediately. Response is at the same time a confirmation
| part aRequest == 1 && isFinalPart aRequest ->
forkIO (handleIncomingRequest ns sendQ (Set.singleton aRequest) sourceAddr) >> pure ()
-- otherwise collect all message parts first before handling the whole request
| otherwise -> do
now <- getPOSIXTime
-- critical locking section of requestMap
rMapState <- takeMVar requestMap
-- insert new message and get set
let
theseMaxParts = if isFinalPart aRequest then Just (part aRequest) else Nothing
thisKey = (sourceAddr, requestID aRequest)
newMapState = Map.insertWith (\
(RequestMapEntry thisMsgSet p' ts) (RequestMapEntry oldMsgSet p'' _) ->
RequestMapEntry (thisMsgSet `Set.union` oldMsgSet) (p' <|> p'') ts
)
thisKey
(RequestMapEntry (Set.singleton aRequest) theseMaxParts now)
rMapState
-- put map back into MVar, end of critical section
putMVar requestMap newMapState
-- if all parts received, then handle request.
let
(RequestMapEntry theseParts mayMaxParts _) = fromJust $ Map.lookup thisKey newMapState
numParts = Set.size theseParts
if maybe False (numParts ==) (fromIntegral <$> mayMaxParts)
then forkIO (handleIncomingRequest ns sendQ theseParts sourceAddr) >> pure()
else pure()
-- Responses should never arrive on the main server port, as they are always
-- responses to requests sent from dedicated sockets on another port
_ -> pure ()
)
aMsg
pure () pure ()

View file

@ -19,21 +19,21 @@ data Action = QueryID
deriving (Show, Eq, Enum) deriving (Show, Eq, Enum)
data FediChordMessage = Request data FediChordMessage = Request
{ requestID :: Integer { requestID :: Integer
, sender :: RemoteNodeState , sender :: RemoteNodeState
, part :: Integer , part :: Integer
, isFinalPart :: Bool , isFinalPart :: Bool
-- ^ part starts at 1 -- ^ part starts at 1
, action :: Action , action :: Action
, payload :: Maybe ActionPayload , payload :: Maybe ActionPayload
} }
| Response | Response
{ responseTo :: Integer { responseTo :: Integer
, senderID :: NodeID , senderID :: NodeID
, part :: Integer , part :: Integer
, isFinalPart :: Bool , isFinalPart :: Bool
, action :: Action , action :: Action
, payload :: Maybe ActionPayload , payload :: Maybe ActionPayload
} }
deriving (Show, Eq) deriving (Show, Eq)