exit cleanly on eg, failure to bind socket
This commit is contained in:
parent
9984252ab5
commit
53000cf06e
1 changed files with 16 additions and 7 deletions
|
@ -185,26 +185,35 @@ withLocalP2PConnections workerpool a = do
|
||||||
myuuid <- getUUID
|
myuuid <- getUUID
|
||||||
reqv <- liftIO newEmptyTMVarIO
|
reqv <- liftIO newEmptyTMVarIO
|
||||||
relv <- liftIO newEmptyTMVarIO
|
relv <- liftIO newEmptyTMVarIO
|
||||||
asyncservicer <- liftIO $ async $ servicer myuuid reqv relv
|
endv <- liftIO newEmptyTMVarIO
|
||||||
a (acquireconn reqv) `finally` join (liftIO (wait asyncservicer))
|
asyncservicer <- liftIO $ async $ servicer myuuid reqv relv endv
|
||||||
|
let endit = do
|
||||||
|
liftIO $ atomically $ putTMVar endv ()
|
||||||
|
liftIO $ wait asyncservicer
|
||||||
|
a (acquireconn reqv) `finally` endit
|
||||||
where
|
where
|
||||||
acquireconn reqv connparams = do
|
acquireconn reqv connparams = do
|
||||||
respvar <- newEmptyTMVarIO
|
respvar <- newEmptyTMVarIO
|
||||||
atomically $ putTMVar reqv (connparams, respvar)
|
atomically $ putTMVar reqv (connparams, respvar)
|
||||||
atomically $ takeTMVar respvar
|
atomically $ takeTMVar respvar
|
||||||
|
|
||||||
servicer myuuid reqv relv = do
|
servicer myuuid reqv relv endv = do
|
||||||
reqrel <- liftIO $
|
reqrel <- liftIO $
|
||||||
atomically $
|
atomically $
|
||||||
(Right <$> takeTMVar reqv)
|
(Right <$> takeTMVar reqv)
|
||||||
`orElse`
|
`orElse`
|
||||||
(Left <$> takeTMVar relv)
|
(Left . Right <$> takeTMVar relv)
|
||||||
|
`orElse`
|
||||||
|
(Left . Left <$> takeTMVar endv)
|
||||||
case reqrel of
|
case reqrel of
|
||||||
Right (connparams, respvar) ->
|
Right (connparams, respvar) -> do
|
||||||
servicereq myuuid relv connparams
|
servicereq myuuid relv connparams
|
||||||
>>= atomically . putTMVar respvar
|
>>= atomically . putTMVar respvar
|
||||||
Left releaseconn -> releaseconn
|
servicer myuuid reqv relv endv
|
||||||
servicer myuuid reqv relv
|
Left (Right releaseconn) -> do
|
||||||
|
releaseconn
|
||||||
|
servicer myuuid reqv relv endv
|
||||||
|
Left (Left ()) -> return ()
|
||||||
|
|
||||||
servicereq myuuid relv connparams
|
servicereq myuuid relv connparams
|
||||||
| connectionServerUUID connparams /= myuuid =
|
| connectionServerUUID connparams /= myuuid =
|
||||||
|
|
Loading…
Reference in a new issue