Attempt to use MVar to prevent memory leaks, but get a deadlock

deadlockMVarUsageWithBracket.hs

protoReceiver :: RIO FdsEnv ()
protoReceiver = retryForever $ do
  logItS Info ["Entering FarmPCMessage protoReceiver"]
  tMap <- liftIO $ newThreadMap
  fdsEnv <- ask
  let lgr = fdsLogger fdsEnv
  loopBody <- pure $ bracketOnError
    (runResourceT $ do
      swTup <- protoServe fdsEnv tMap readFarmPCMessage
      serverMVar <- newMVar $ fst swTup
      pure (serverMVar, snd swTup)
      )
    (\(_, worker) -> do
      logLogItS Debug lgr ["Entering cleanup for protoReceiver"]
      killChildThreads tMap
      cancel worker
      )
    (\(serverMVar, _) -> do
      logLogItS Debug lgr ["Entering FarmPCMessage protoReceiver bracket"]
      server <- takeMVar serverMVar
      logLogItS Debug lgr ["FarmPCMessage protoReceiver bracket: got server"]
      server
        .| mapMC (liftIO . traverse_ (persistFarmEntry fdsEnv))
        .| mapMC ((logLogIt Info lgr) . pure)
        .| sinkUnits & runConduitRes
      )
  liftIO $ retryForever $ loopBody
  where
    killChildThreads = liftIO . killThreadHierarchy

Another way of doing it that doesn't leak or mutate and MVar, but has slightly less safety (still a lot, since protoServe itself catches a lot of exceptions internally) than some alternatives:

protoReceiver :: RIO FdsEnv ()
protoReceiver = retryForever $ do
  logItS Info ["Entering FarmPCMessage protoReceiver"]
  tMap <- liftIO $ newThreadMap
  fdsEnv <- ask
  let lgr = fdsLogger fdsEnv
  (dmgrProtoServe, tcpWorker) <- liftIO $ runResourceT $
    protoServe fdsEnv tMap readFarmPCMessage
  liftIO $ runResourceT $ finally
    (do
      logLogItS Debug lgr ["Entering FarmPCMessage protoReceiver bracket"]
      dmgrProtoServe
        .| mapMC (liftIO . traverse_ (persistFarmEntry fdsEnv))
        .| mapMC ((logLogIt Info lgr) . pure)
        .| sinkUnits & runConduit
      )
    (do
      logLogItS Debug lgr ["Entering cleanup for protoReceiver"]
      killChildThreads tMap
      cancel tcpWorker
      )
  where
    killChildThreads = liftIO . killThreadHierarchy