BrokerClient: handle timeout in getNotifications

src/ATrade/Broker/Client.hs

@@ -278,18 +278,22 @@ bcGetNotifications clientIdentity idCounter notifSqnumRef cmdVar lastKnownNotifi
   sqnum <- nextId idCounter
   notifSqnum <- nextSqnum <$> readIORef notifSqnumRef
   now <- getCurrentTime
-  putMVar cmdVar (RequestNotifications (RequestId sqnum) clientIdentity notifSqnum, respVar, now)
+  result <- timeout 3000000 $ do
-  resp <- takeMVar respVar
+    putMVar cmdVar (RequestNotifications (RequestId sqnum) clientIdentity notifSqnum, respVar, now)
-  case resp of
+    resp <- takeMVar respVar
-    (ResponseNotifications (RequestId requestId) ns) ->
+    case resp of
-      if (requestId == sqnum)
+      (ResponseNotifications (RequestId requestId) ns) ->
-        then do
+        if (requestId == sqnum)
-          case lastMay ns of
+          then do
-            Just n  -> atomicWriteIORef notifSqnumRef (getNotificationSqnum n)
+            case lastMay ns of
-            Nothing -> readIORef lastKnownNotification >>= atomicWriteIORef notifSqnumRef
+              Just n  -> atomicWriteIORef notifSqnumRef (getNotificationSqnum n)
-          return $ Right ns
+              Nothing -> readIORef lastKnownNotification >>= atomicWriteIORef notifSqnumRef
-        else do
+            return $ Right ns
-          logWith logger Warning "Broker.Client" "GetNotifications: requestId mismatch"
+          else do
-          return $ Left "requestId mismatch"
+            logWith logger Warning "Broker.Client" "GetNotifications: requestId mismatch"
-    (ResponseError (RequestId requestId) msg)        -> return $ Left msg
+            return $ Left "requestId mismatch"
-    _                          -> return $ Left "Unknown error"
+      (ResponseError (RequestId requestId) msg)        -> return $ Left msg
+      _                          -> return $ Left "Unknown error"
+  case result of
+    Just r -> pure $ r
+    _      -> pure $ Left "Request timeout"