bracket all socket-using operations to avoid resource leakage

src/Hash2Pub/DHTProtocol.hs

@@ -23,6 +23,7 @@ module Hash2Pub.DHTProtocol
         where
 
 import           Control.Concurrent.Async
+import           Control.Exception
 import           Control.Concurrent.STM
 import           Control.Concurrent.STM.TBQueue
 import           Control.Concurrent.STM.TQueue
@@ -146,8 +147,8 @@ markCacheEntryAsVerified timestamp = Map.adjust adjustFunc
 requestJoin :: NodeState a => a             -- ^ currently responsible node to be contacted
             -> LocalNodeState               -- ^ joining NodeState
             -> IO (Maybe LocalNodeState)    -- ^ node after join with all its new information
-requestJoin toJoinOn ownState = do
-    sock <- mkSendSocket (getDomain toJoinOn) (getDhtPort toJoinOn)
+requestJoin toJoinOn ownState =
+    bracket (mkSendSocket (getDomain toJoinOn) (getDhtPort toJoinOn)) close (\sock -> do
         responses <- sendRequestTo 5000 3 (\rid -> Request rid (toRemoteNodeState ownState) 1 1 Join (Just JoinRequestPayload)) sock
         joinedStateUnsorted <- foldM
             (\nsAcc msg -> case payload msg of
@@ -168,6 +169,7 @@ requestJoin toJoinOn ownState = do
            then pure Nothing
             -- sort successors and predecessors
            else pure . Just . setSuccessors (sortBy localCompare $ successors joinedStateUnsorted) . setPredecessors (sortBy localCompare $ predecessors joinedStateUnsorted) $ joinedStateUnsorted
+                                                                            )
 
 
 -- | Send a 'QueryID' 'Request' for getting the node that handles a certain key ID.
@@ -192,10 +194,9 @@ queryIdLookupLoop cacheSnapshot ns targetID = do
     case localResult of
       FOUND thisNode -> pure thisNode
       FORWARD nodeSet -> do
-          -- create connected sockets to all query targets
-          sockets <- mapM (\resultNode -> mkSendSocket (getDomain resultNode) (getDhtPort resultNode)) $ remoteNode <$> Set.toList nodeSet
+          -- create connected sockets to all query targets and use them for request handling
           -- ToDo: make attempts and timeout configurable
-          queryThreads <- mapM (async . sendQueryIdMessage targetID ns) sockets
+          queryThreads <- mapM (\resultNode -> async $ bracket (mkSendSocket (getDomain resultNode) (getDhtPort resultNode)) close (sendQueryIdMessage targetID ns)) $ remoteNode <$> Set.toList nodeSet
           -- ToDo: process results immediately instead of waiting for the last one to finish, see https://stackoverflow.com/a/38815224/9198613
           -- ToDo: exception handling, maybe log them
           responses <- (mconcat . fmap Set.elems) . rights <$> mapM waitCatch queryThreads

src/Hash2Pub/FediChord.hs

@@ -117,9 +117,9 @@ fediChordBootstrapJoin :: LocalNodeState              -- ^ the local 'NodeState'
                         -> (String, PortNumber)   -- ^ domain and port of a bootstrapping node
                         -> IO (Either String LocalNodeState) -- ^ the joined 'NodeState' after a
                                             -- successful join, otherwise an error message
-fediChordBootstrapJoin ns (joinHost, joinPort) = do
+fediChordBootstrapJoin ns (joinHost, joinPort) =
     -- can be invoked multiple times with all known bootstrapping nodes until successfully joined
-    sock <- mkSendSocket joinHost joinPort
+    bracket (mkSendSocket joinHost joinPort) close (\sock -> do
         -- 1. get routed to placement of own ID until FOUND:
         -- Initialise an empty cache only with the responses from a bootstrapping node
         bootstrapResponse <- sendQueryIdMessage (getNid ns) ns sock
@@ -137,6 +137,7 @@ fediChordBootstrapJoin ns (joinHost, joinPort) = do
                               )
                            initCache bootstrapResponse
                fediChordJoin bootstrapCache ns
+                                                   )
 
 -- | join a node to the DHT, using the provided cache snapshot for resolving the new
 -- node's position.

src/Hash2Pub/Main.hs

@@ -1,6 +1,7 @@
 module Main where
 
 import           Control.Concurrent
+import           Control.Exception
 import           Data.IP            (IPv6, toHostAddress6)
 import           System.Environment