hedis 0.12.1 → 0.12.2

raw patch · 3 files changed

+40/−30 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +4/−0
• hedis.cabal +1/−1
• src/Database/Redis/ProtocolPipelining.hs +35/−29

@@ -1,5 +1,9 @@ # Changelog for Hedis +## 0.12.2++* PR #134. Fix some asynchronous exception safety problems+ ## 0.12.1  * PR #133. Fixes to stream commands

@@ -1,5 +1,5 @@ name:               hedis-version:            0.12.1+version:            0.12.2 synopsis:     Client library for the Redis datastore: supports full command set,     pipelining.

@@ -1,4 +1,7 @@-{-# LANGUAGE RecordWildCards, DeriveDataTypeable, OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}  -- |A module for automatic, optimal protocol pipelining. --@@ -75,25 +78,28 @@  getHostAddrInfo :: NS.HostName -> NS.PortNumber -> IO [NS.AddrInfo] getHostAddrInfo hostname port = do-  addresses <- NS.getAddrInfo-    (Just NS.defaultHints)-    (Just hostname)-    (Just (show port))-  return addresses+  NS.getAddrInfo (Just hints) (Just hostname) (Just $ show port)+  where+    hints = NS.defaultHints+      { NS.addrSocketType = NS.Stream }  connectSocket :: [NS.AddrInfo] -> IO NS.Socket-connectSocket addresses = do-  let addrInfo = head addresses-  socket <- NS.socket (NS.addrFamily addrInfo) NS.Stream NS.defaultProtocol-  catch-    (do-      _ <- NS.connect socket (NS.addrAddress addrInfo)-      return socket)-    (\(SomeException e) -> do-      _ <- NS.close socket-      case (tail addresses) of-        [] -> throwIO e-        others -> connectSocket others)+connectSocket [] = error "connectSocket: unexpected empty list"+connectSocket (addr:rest) = tryConnect >>= \case+  Right sock -> return sock+  Left err   -> if null rest+                then throwIO err+                else connectSocket rest+  where+    tryConnect :: IO (Either IOError NS.Socket)+    tryConnect = bracketOnError createSock NS.close $ \sock -> do+      try (NS.connect sock $ NS.addrAddress addr) >>= \case+        Right () -> return (Right sock)+        Left err -> return (Left err)+      where+        createSock = NS.socket (NS.addrFamily addr)+                               (NS.addrSocketType addr)+                               (NS.addrProtocol addr)  connect :: NS.HostName -> PortID -> Maybe Int -> IO Connection connect hostName portId timeoutOpt =@@ -117,20 +123,20 @@                 Right () -> do                   phase <- readMVar phaseMVar                   errConnectTimeout phase-        hConnect' mvar =-          do-            sock <- case portId of+        hConnect' mvar = bracketOnError createSock NS.close $ \sock -> do+          NS.setSocketOption sock NS.KeepAlive 1+          void $ swapMVar mvar PhaseResolve+          void $ swapMVar mvar PhaseOpenSocket+          NS.socketToHandle sock ReadWriteMode+          where+            createSock = case portId of               PortNumber portNumber -> do                 addrInfo <- getHostAddrInfo hostName portNumber                 connectSocket addrInfo-              UnixSocket addr -> do-                socket <- NS.socket NS.AF_UNIX NS.Stream NS.defaultProtocol-                NS.connect socket (NS.SockAddrUnix addr)-                return socket-            NS.setSocketOption sock NS.KeepAlive 1-            void $ swapMVar mvar PhaseResolve-            void $ swapMVar mvar PhaseOpenSocket-            NS.socketToHandle sock ReadWriteMode+              UnixSocket addr -> bracketOnError+                (NS.socket NS.AF_UNIX NS.Stream NS.defaultProtocol)+                NS.close+                (\sock -> NS.connect sock (NS.SockAddrUnix addr) >> return sock)  enableTLS :: TLS.ClientParams -> Connection -> IO Connection enableTLS tlsParams conn@Conn{..} = do