a1cbb75 · distributed-process

357 -- | Invalid remote endpoint (for example, invalid address)

358 RemoteEndPointInvalid !(TransportError ConnectErrorCode)

359 -- | The remote endpoint is being initialized

360− | RemoteEndPointInit !(MVar ()) !RequestedBy

360+ | RemoteEndPointInit !(MVar ()) !(MVar ()) !RequestedBy

361 -- | "Normal" working endpoint

362 | RemoteEndPointValid !ValidRemoteEndPointState

363 -- | The remote endpoint is being closed (garbage collected)

604 act <- withMVar (remoteState theirEndPoint) $ \st -> case st of

605 RemoteEndPointInvalid _ ->

606 relyViolation (ourEndPoint, theirEndPoint) "apiSend"

607− RemoteEndPointInit _ _ ->

607+ RemoteEndPointInit _ _ _ ->

608 relyViolation (ourEndPoint, theirEndPoint) "apiSend"

609 RemoteEndPointValid vst -> do

610 alive <- readIORef connAlive

660 case st of

661 RemoteEndPointInvalid _ ->

662 return (st, Nothing)

663− RemoteEndPointInit resolved _ -> do

663+ RemoteEndPointInit resolved _ _ -> do

664 putMVar resolved ()

665 return (closed, Nothing)

666 RemoteEndPointValid vst -> do

764 RemoteEndPointInvalid _ ->

765 relyViolation (ourEndPoint, theirEndPoint)

766 "handleIncomingMessages (invalid)"

767− RemoteEndPointInit _ _ ->

767+ RemoteEndPointInit _ _ _ ->

768 relyViolation (ourEndPoint, theirEndPoint)

769 "handleIncomingMessages (init)"

770 RemoteEndPointValid ep ->

820 RemoteEndPointInvalid _ ->

821 relyViolation (ourEndPoint, theirEndPoint)

822 "handleIncomingMessages:createNewConnection (invalid)"

823− RemoteEndPointInit _ _ ->

823+ RemoteEndPointInit _ _ _ ->

824 relyViolation (ourEndPoint, theirEndPoint)

825 "handleIncomingMessages:createNewConnection (init)"

826 RemoteEndPointValid vst ->

854 RemoteEndPointInvalid _ ->

855 relyViolation (ourEndPoint, theirEndPoint)

856 "readControlResponse (invalid)"

857− RemoteEndPointInit _ _ ->

857+ RemoteEndPointInit _ _ _ ->

858 relyViolation (ourEndPoint, theirEndPoint)

859 "readControlResponse (init)"

860 RemoteEndPointValid vst ->

884 modifyMVar_ theirState $ \st -> case st of

885 RemoteEndPointInvalid _ ->

886 relyViolation (ourEndPoint, theirEndPoint) "closeConnection (invalid)"

887− RemoteEndPointInit _ _ ->

887+ RemoteEndPointInit _ _ _ ->

888 relyViolation (ourEndPoint, theirEndPoint) "closeConnection (init)"

889 RemoteEndPointValid vst -> do

890 unless (IntSet.member cid (vst ^. remoteIncoming)) $

913 RemoteEndPointInvalid _ ->

914 relyViolation (ourEndPoint, theirEndPoint)

915 "handleIncomingMessages:closeSocket (invalid)"

916− RemoteEndPointInit _ _ ->

916+ RemoteEndPointInit _ _ _ ->

917 relyViolation (ourEndPoint, theirEndPoint)

918 "handleIncomingMessages:closeSocket (init)"

919 RemoteEndPointValid vst -> do

971 RemoteEndPointInvalid _ ->

972 relyViolation (ourEndPoint, theirEndPoint)

973 "handleIncomingMessages:prematureExit"

974− RemoteEndPointInit _ _ ->

974+ RemoteEndPointInit _ _ _ ->

975 relyViolation (ourEndPoint, theirEndPoint)

976 "handleIncomingMessages:prematureExit"

977 RemoteEndPointValid vst -> do

1055 tryCloseSocket sock

1056 return False

1057 Right (sock, ConnectionRequestCrossed) -> do

1058+ withMVar (remoteState theirEndPoint) $ \st -> case st of

1059+ RemoteEndPointInit _ crossed _ ->

1060+ putMVar crossed ()

1061+ RemoteEndPointFailed ex ->

1062+ throwIO ex

1063+ _ ->

1058− resolveInit (ourEndPoint, theirEndPoint) RemoteEndPointClosed

1064+ relyViolation (ourEndPoint, theirEndPoint) "setupRemoteEndPoint: Crossed"

1059 tryCloseSocket sock

1065 tryCloseSocket sock

1060 return False

1066 return False

1061 Left err -> do

1067 Left err -> do

1088 -- Error cases

1094 -- Error cases

1089 RemoteEndPointInvalid err ->

1095 RemoteEndPointInvalid err ->

1090 throwIO err

1096 throwIO err

1091− RemoteEndPointInit _ _ ->

1097+ RemoteEndPointInit _ _ _ ->

1092 relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (init)"

1098 relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (init)"

1093 RemoteEndPointClosing _ _ ->

1099 RemoteEndPointClosing _ _ ->

1094 relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (closing)"

1100 relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (closing)"

1193resolveInit :: EndPointPair -> RemoteState -> IO ()

1199resolveInit :: EndPointPair -> RemoteState -> IO ()

1194resolveInit (ourEndPoint, theirEndPoint) newState =

1200resolveInit (ourEndPoint, theirEndPoint) newState =

1195 modifyMVar_ (remoteState theirEndPoint) $ \st -> case st of

1201 modifyMVar_ (remoteState theirEndPoint) $ \st -> case st of

1196− RemoteEndPointInit resolved _ -> do

1202+ RemoteEndPointInit resolved _ _ -> do

1197 putMVar resolved ()

1203 putMVar resolved ()

1198 case newState of

1204 case newState of

1199 RemoteEndPointClosed ->

1205 RemoteEndPointClosed ->

1307 return (st, (theirEndPoint, False))

1313 return (st, (theirEndPoint, False))

1308 Nothing -> do

1314 Nothing -> do

1309 resolved <- newEmptyMVar

1315 resolved <- newEmptyMVar

1316+ crossed <- newEmptyMVar

1310− theirState <- newMVar (RemoteEndPointInit resolved findOrigin)

1317+ theirState <- newMVar (RemoteEndPointInit resolved crossed findOrigin)

1311 scheduled <- newChan

1318 scheduled <- newChan

1312 let theirEndPoint = RemoteEndPoint

1319 let theirEndPoint = RemoteEndPoint

1313 { remoteAddress = theirAddress

1320 { remoteAddress = theirAddress

1347 case snapshot of

1354 case snapshot of

1348 RemoteEndPointInvalid err ->

1355 RemoteEndPointInvalid err ->

1349 throwIO err

1356 throwIO err

1350− RemoteEndPointInit resolved initOrigin ->

1357+ RemoteEndPointInit resolved crossed initOrigin ->

1351 case (findOrigin, initOrigin) of

1358 case (findOrigin, initOrigin) of

1352 (RequestedByUs, RequestedByUs) ->

1359 (RequestedByUs, RequestedByUs) ->

1353 readMVar resolved >> go

1360 readMVar resolved >> go

1355 readMVar resolved >> go

1362 readMVar resolved >> go

1356 (RequestedByThem, RequestedByUs) ->

1363 (RequestedByThem, RequestedByUs) ->

1357 if ourAddress > theirAddress

1364 if ourAddress > theirAddress

1358− then

1365+ then do

1359 -- Wait for the Crossed message

1366 -- Wait for the Crossed message

1360− readMVar resolved >> go

1367+ readMVar crossed

1368+ return (theirEndPoint, True)

1361 else

1369 else

1362 return (theirEndPoint, False)

1370 return (theirEndPoint, False)

1363 (RequestedByThem, RequestedByThem) ->

1371 (RequestedByThem, RequestedByThem) ->

1531 Nothing -> throwIO $ userError "Remote endpoint not found"

1539 Nothing -> throwIO $ userError "Remote endpoint not found"

1532 Just ep -> return ep

1540 Just ep -> return ep

1533 withMVar (remoteState theirEndPoint) $ \st -> case st of

1541 withMVar (remoteState theirEndPoint) $ \st -> case st of

1534− RemoteEndPointInit _ _ ->

1542+ RemoteEndPointInit _ _ _ ->

1535 throwIO $ userError "Remote endpoint not yet initialized"

1543 throwIO $ userError "Remote endpoint not yet initialized"

1536 RemoteEndPointValid vst ->

1544 RemoteEndPointValid vst ->

1537 return $ remoteSocket vst

1545 return $ remoteSocket vst