@@ -524,7 +524,7 @@ handleIncomingMessages node = go initConnectionState
524 . (incomingFrom theirAddr ^: Set.insert cid)
524 . (incomingFrom theirAddr ^: Set.insert cid)
527− else invalidRequest cid st
527+ else invalidRequest cid st ("unsupported reliability: "++show rel)
528 NT.Received cid payload ->
528 NT.Received cid payload ->
529 case st ^. incomingAt cid of
529 case st ^. incomingAt cid of
530 Just (_, ToProc pid weakQueue) -> do
530 Just (_, ToProc pid weakQueue) -> do
@@ -557,7 +557,7 @@ handleIncomingMessages node = go initConnectionState
557 Just proc ->
557 Just proc ->
558 go (incomingAt cid ^= Just (src, ToProc pid (processWeakQ proc)) $ st)
558 go (incomingAt cid ^= Just (src, ToProc pid (processWeakQ proc)) $ st)
559 Nothing ->
559 Nothing ->
560− invalidRequest cid st
560+ invalidRequest cid st "unknown local process id"
561 SendPortIdentifier chId -> do
561 SendPortIdentifier chId -> do
562 let lcid = sendPortLocalId chId
562 let lcid = sendPortLocalId chId
563 lpid = processLocalId (sendPortProcessId chId)
563 lpid = processLocalId (sendPortProcessId chId)
@@ -569,19 +569,19 @@ handleIncomingMessages node = go initConnectionState
569 Just channel ->
569 Just channel ->
570 go (incomingAt cid ^= Just (src, ToChan channel) $ st)
570 go (incomingAt cid ^= Just (src, ToChan channel) $ st)
571 Nothing ->
571 Nothing ->
572− invalidRequest cid st
572+ invalidRequest cid st "unknown channel"
573 Nothing ->
573 Nothing ->
574− invalidRequest cid st
574+ invalidRequest cid st "unknown process id"
575 NodeIdentifier nid ->
575 NodeIdentifier nid ->
576 if nid == localNodeId node
576 if nid == localNodeId node
577 then go (incomingAt cid ^= Just (src, ToNode) $ st)
577 then go (incomingAt cid ^= Just (src, ToNode) $ st)
578− else invalidRequest cid st
578+ else invalidRequest cid st "invalid node id"
579 Nothing ->
579 Nothing ->
580− invalidRequest cid st
580+ invalidRequest cid st "invalid request target"
581 NT.ConnectionClosed cid ->
581 NT.ConnectionClosed cid ->
582 case st ^. incomingAt cid of
582 case st ^. incomingAt cid of
583 Nothing ->
583 Nothing ->
584− invalidRequest cid st
584+ invalidRequest cid st "closed unknown connection id"
585 Just (src, _) -> do
585 Just (src, _) -> do
586 trace node (MxDisconnected cid src)
586 trace node (MxDisconnected cid src)
587 go ( (incomingAt cid ^= Nothing)
587 go ( (incomingAt cid ^= Nothing)
@@ -612,13 +612,13 @@ handleIncomingMessages node = go initConnectionState
612 -- and we just give up
612 -- and we just give up
613 fail "Cloud Haskell fatal error: received unexpected multicast"
613 fail "Cloud Haskell fatal error: received unexpected multicast"
615− invalidRequest :: NT.ConnectionId -> ConnectionState -> IO ()
615+ invalidRequest :: NT.ConnectionId -> ConnectionState -> String -> IO ()
616− invalidRequest cid st = do
616+ invalidRequest cid st msg = do
617 -- TODO: We should treat this as a fatal error on the part of the remote
617 -- TODO: We should treat this as a fatal error on the part of the remote
618 -- node. That is, we should report the remote node as having died, and we
618 -- node. That is, we should report the remote node as having died, and we
619 -- should close incoming connections (this requires a Transport layer
619 -- should close incoming connections (this requires a Transport layer
620 -- extension).
620 -- extension).
621− traceEventFmtIO node "" [(TraceStr " [network] invalid request: "),
621+ traceEventFmtIO node "" [(TraceStr $ " [network] invalid request ("++msg++"): "),
622 (Trace cid)]
622 (Trace cid)]
623 go ( incomingAt cid ^= Nothing
623 go ( incomingAt cid ^= Nothing