hriemann 0.3.3.1 → 0.3.3.2

raw patch · 2 files changed

+22/−17 lines, 2 filesdep +stmPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: stm

API changes (from Hackage documentation)

Files

• hriemann.cabal +3/−2
• src/Network/Monitoring/Riemann/TCP.hs +19/−15

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 02c6f9cc6fa0ddb8bf2db0ae03e66a26f59d2620504af25e742ac84f44752bbf+-- hash: 27fb5d42fe1036839a8e668517e27953974a2b64365c4f7be64b9ad838268da7  name:           hriemann-version:        0.3.3.1+version:        0.3.3.2 synopsis:       A Riemann Client for Haskell description:    A Riemann Client for Haskell category:       Monitoring@@ -59,6 +59,7 @@     , protocol-buffers     , protocol-buffers-descriptor     , scientific+    , stm     , text     , time     , unagi-chan

@@ -11,8 +11,10 @@   , Port   ) where -import Control.Concurrent (MVar, newMVar, putMVar, takeMVar)-import Control.Exception (try)+import Control.Concurrent.STM (atomically)+import Control.Concurrent.STM.TVar (TVar, newTVarIO, readTVarIO, writeTVar)+import Control.Exception (IOException, try)+import Data.Bifunctor (first) import qualified Data.Binary.Put as Put import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy.Char8 as BC@@ -49,7 +51,7 @@   , _status :: TCPStatus   } -type TCPConnection = MVar ClientInfo+type TCPConnection = TVar ClientInfo  data TCPStatus   = CnxClosed@@ -61,7 +63,7 @@ tcpConnection :: HostName -> Port -> IO TCPConnection tcpConnection _hostname _port = do   clientInfo <- doConnect $ ClientInfo {_status = CnxClosed, ..}-  newMVar clientInfo+  newTVarIO clientInfo  doConnect :: ClientInfo -> IO ClientInfo doConnect clientInfo@(_status -> CnxOpen _) = pure clientInfo@@ -117,23 +119,25 @@ sendMsg client msg = go True   where     go reconnect = do-      clientInfo <- takeMVar client+      putStrLn $ "SENDING " <> show reconnect+      clientInfo <- readTVarIO client       case (_status clientInfo, reconnect) of-        (CnxClosed, True) -> pure $ Left msg-        (CnxClosed, False) -> do+        (CnxClosed, True) -> do           newInfo <- doConnect clientInfo-          putMVar client newInfo+          atomically $ writeTVar client newInfo           go False+        (CnxClosed, False) -> pure $ Left msg         (CnxOpen (s, _), _) -> do-          NSB.sendAll s $ msgToByteString msg-          bs <- NSB.recv s 4096-          case decodeMsg bs of-            Right m -> do-              putMVar client clientInfo-              pure $ Right m+          response <-+            first (show :: IOException -> String) <$>+            try+              (do NSB.sendAll s $ msgToByteString msg+                  NSB.recv s 4096)+          case decodeMsg =<< response of             Left _ -> do-              putMVar client (clientInfo {_status = CnxClosed})+              atomically $ writeTVar client (clientInfo {_status = CnxClosed})               pure $ Left msg+            Right m -> pure $ Right m  {-|     Send a list of Riemann events