A pattern for asynchronous server interaction testing

AsyncServer.hs

withAsyncServer $ \(asyncContext, _) -> do
      echoResults <- asyncContext $ \ asyncServer -> do
          sendToServer "data"
          asyncRecv asyncServer
      echoResults `shouldBe` "data"

asyncRecv :: Async a -> IO a
asyncRecv = wait

withAsyncServer :: (((Async String -> IO String) -> IO String, Socket) -> IO c) -> IO c
withAsyncServer = bracket create release
  where
    create = do
      server <- socket AF_INET Stream defaultProtocol
      setSocketOption server ReuseAddr 1
      bind server (SockAddrInet (8080 :: PortNumber) (tupleToHostAddress (127,0,0,1)))
      listen server 1
      pure (withAsync (asyncServerAccept server), server)
    release (asyncContext, socket) = asyncContext (\asyncServer -> cancel asyncServer >> pure mempty) >> close socket

asyncServerAccept :: Socket -> IO String
asyncServerAccept server = do
    conn <- accept server
    runConn conn
  where
    runConn :: (Socket, SockAddr) -> IO String
    runConn (conn, _) = C.unpack <$> recv conn 1084