@@ -516,7 +516,7 @@ handleIncomingMessages node = go initConnectionState
516 . (incomingFrom theirAddr ^: Set.insert cid)
516 . (incomingFrom theirAddr ^: Set.insert cid)
519− else invalidRequest cid st
519+ else invalidRequest cid st ("unsupported reliability: "++show rel)
520 NT.Received cid payload ->
520 NT.Received cid payload ->
521 case st ^. incomingAt cid of
521 case st ^. incomingAt cid of
522 Just (_, ToProc pid weakQueue) -> do
522 Just (_, ToProc pid weakQueue) -> do
@@ -549,7 +549,7 @@ handleIncomingMessages node = go initConnectionState
549 Just proc ->
549 Just proc ->
550 go (incomingAt cid ^= Just (src, ToProc pid (processWeakQ proc)) $ st)
550 go (incomingAt cid ^= Just (src, ToProc pid (processWeakQ proc)) $ st)
551 Nothing ->
551 Nothing ->
552− invalidRequest cid st
552+ invalidRequest cid st "unknown local process id"
553 SendPortIdentifier chId -> do
553 SendPortIdentifier chId -> do
554 let lcid = sendPortLocalId chId
554 let lcid = sendPortLocalId chId
555 lpid = processLocalId (sendPortProcessId chId)
555 lpid = processLocalId (sendPortProcessId chId)
@@ -561,19 +561,19 @@ handleIncomingMessages node = go initConnectionState
561 Just channel ->
561 Just channel ->
562 go (incomingAt cid ^= Just (src, ToChan channel) $ st)
562 go (incomingAt cid ^= Just (src, ToChan channel) $ st)
563 Nothing ->
563 Nothing ->
564− invalidRequest cid st
564+ invalidRequest cid st "unknown channel"
565 Nothing ->
565 Nothing ->
566− invalidRequest cid st
566+ invalidRequest cid st "unknown process id"
567 NodeIdentifier nid ->
567 NodeIdentifier nid ->
568 if nid == localNodeId node
568 if nid == localNodeId node
569 then go (incomingAt cid ^= Just (src, ToNode) $ st)
569 then go (incomingAt cid ^= Just (src, ToNode) $ st)
570− else invalidRequest cid st
570+ else invalidRequest cid st "invalid node id"
571 Nothing ->
571 Nothing ->
572− invalidRequest cid st
572+ invalidRequest cid st "invalid request target"
573 NT.ConnectionClosed cid ->
573 NT.ConnectionClosed cid ->
574 case st ^. incomingAt cid of
574 case st ^. incomingAt cid of
575 Nothing ->
575 Nothing ->
576− invalidRequest cid st
576+ invalidRequest cid st "closed unknown connection id"
577 Just (src, _) -> do
577 Just (src, _) -> do
578 trace node (MxDisconnected cid src)
578 trace node (MxDisconnected cid src)
579 go ( (incomingAt cid ^= Nothing)
579 go ( (incomingAt cid ^= Nothing)
@@ -604,13 +604,13 @@ handleIncomingMessages node = go initConnectionState
604 -- and we just give up
604 -- and we just give up
605 fail "Cloud Haskell fatal error: received unexpected multicast"
605 fail "Cloud Haskell fatal error: received unexpected multicast"
607− invalidRequest :: NT.ConnectionId -> ConnectionState -> IO ()
607+ invalidRequest :: NT.ConnectionId -> ConnectionState -> String -> IO ()
608− invalidRequest cid st = do
608+ invalidRequest cid st msg = do
609 -- TODO: We should treat this as a fatal error on the part of the remote
609 -- TODO: We should treat this as a fatal error on the part of the remote
610 -- node. That is, we should report the remote node as having died, and we
610 -- node. That is, we should report the remote node as having died, and we
611 -- should close incoming connections (this requires a Transport layer
611 -- should close incoming connections (this requires a Transport layer
612 -- extension).
612 -- extension).
613− traceEventFmtIO node "" [(TraceStr " [network] invalid request: "),
613+ traceEventFmtIO node "" [(TraceStr $ " [network] invalid request ("++msg++"): "),
614 (Trace cid)]
614 (Trace cid)]
615 go ( incomingAt cid ^= Nothing
615 go ( incomingAt cid ^= Nothing