diff --git a/imap.cabal b/imap.cabal --- a/imap.cabal +++ b/imap.cabal @@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: imap -version: 0.1.0.2 +version: 0.1.0.3 synopsis: An efficient IMAP client library, with SSL and streaming license: BSD3 license-file: LICENSE @@ -103,23 +103,22 @@ -- other-modules: -- other-extensions: build-depends: base >=4.8 && <4.9, - attoparsec == 0.13.0.1, - text == 1.2.2.0, - connection == 0.2.5, - bytestring == 0.10.6.0, - random == 1.1, - word8 == 0.1.2, + attoparsec >= 0.13 && <0.14, + text >= 1.2 && <1.3, + connection >= 0.2 && <0.3, + bytestring >= 0.10.6.0 && <0.11, + random >= 1.1 && <1.2, + word8 >= 0.1.2 && <0.2, rolling-queue == 0.1, - stm == 2.4.4.1, - either == 4.4.1, - hslogger == 1.2.9, - transformers == 0.4.2.0, - list-t == 0.4.5.1, - monadIO == 0.10.1.4, - derive == 2.5.23, - data-default == 0.5.3, - stm-delay == 0.1.1.1, - exceptions == 0.8.2.1 + stm >= 2.4.4.1 && <2.5, + either >= 4.4.1 && <4.5, + hslogger >= 1.2.9 && < 1.3, + transformers >= 0.4.2.0 && <0.5, + list-t >= 0.4.5.1 && <0.5, + monadIO >= 0.10.1.4 && <0.11, + derive >= 2.5.23 && <2.6, + stm-delay >= 0.1.1.1 && <0.2, + exceptions >= 0.8.2.1 && <0.9 hs-source-dirs: src default-language: Haskell2010 default-extensions: OverloadedStrings, @@ -138,30 +137,29 @@ main-is: main.hs hs-source-dirs: test, src build-depends: base >=4.8 && <4.9, - attoparsec == 0.13.0.1, - text == 1.2.2.0, - connection == 0.2.5, - bytestring == 0.10.6.0, - random == 1.1, - word8 == 0.1.2, + attoparsec >= 0.13 && <0.14, + text >= 1.2 && <1.3, + connection >= 0.2 && <0.3, + bytestring >= 0.10.6.0 && <0.11, + random >= 1.1 && <1.2, + word8 >= 0.1.2 && <0.2, rolling-queue == 0.1, - stm == 2.4.4.1, - either == 4.4.1, - hslogger == 1.2.9, - transformers == 0.4.2.0, - list-t == 0.4.5.1, - monadIO == 0.10.1.4, - derive == 2.5.23, - data-default == 0.5.3, - stm-delay == 0.1.1.1, - exceptions == 0.8.2.1, + stm >= 2.4.4.1 && <2.5, + either >= 4.4.1 && <4.5, + hslogger >= 1.2.9 && < 1.3, + transformers >= 0.4.2.0 && <0.5, + list-t >= 0.4.5.1 && <0.5, + monadIO >= 0.10.1.4 && <0.11, + derive >= 2.5.23 && <2.6, + stm-delay >= 0.1.1.1 && <0.2, + exceptions >= 0.8.2.1 && <0.9, - tasty == 0.11.0.2, - HUnit == 1.3.1.1, - QuickCheck == 2.8.2, - tasty-hunit == 0.9.2, - tasty-quickcheck == 0.8.4, - mtl == 2.2.1 + tasty >= 0.11.0.2 && <0.12, + HUnit >= 1.3.1.1 && <1.4, + QuickCheck >= 2.8.2 && <2.9, + tasty-hunit >= 0.9.2 && <0.10, + tasty-quickcheck >= 0.8.4 && <0.9, + mtl >= 2.2.1 default-language: Haskell2010 default-extensions: OverloadedStrings, GeneralizedNewtypeDeriving, diff --git a/src/Network/IMAP.hs b/src/Network/IMAP.hs --- a/src/Network/IMAP.hs +++ b/src/Network/IMAP.hs @@ -71,7 +71,7 @@ import Network.IMAP.RequestWatcher import Network.IMAP.Utils -import Control.Monad (MonadPlus(..)) +import Control.Monad (MonadPlus(..), when) import Control.Monad.IO.Class (MonadIO(..)) import ListT (toList, ListT) import qualified Data.List as L @@ -133,7 +133,7 @@ -- = Connected state commands -- |Upgrade a connection to a TLS connection from an insecure one. Accepts TLS settings --- you with your connection to use +-- you wish your connection to use startTLS :: (MonadPlus m, MonadIO m, Universe m) => IMAPConnection -> TLSSettings -> m CommandResult startTLS conn tls = do @@ -141,8 +141,8 @@ let state = imapState conn case res of - Tagged (TaggedResult _ resState _) -> if resState == OK - then do + Tagged (TaggedResult _ resState _) -> when (resState == OK) $ + do threadId <- liftIO . atomically . readTVar $ serverWatcherThread state liftIO . killThread . fromJust $ threadId liftIO $ connectionSetSecure (connectionContext state) (rawConnection state) tls @@ -150,8 +150,7 @@ watcherThreadId <- liftIO . forkIO $ requestWatcher conn liftIO . atomically $ do writeTVar (serverWatcherThread state) $ Just watcherThreadId - writeTVar (connectionState conn) $ Connected - else return () + writeTVar (connectionState conn) Connected _ -> return () return res @@ -196,7 +195,7 @@ watcherThreadId <- liftIO . forkIO $ requestWatcher conn liftIO . atomically $ do writeTVar (serverWatcherThread state) $ Just watcherThreadId - writeTVar (connectionState conn) $ Connected + writeTVar (connectionState conn) Connected return () diff --git a/src/Network/IMAP/RequestWatcher.hs b/src/Network/IMAP/RequestWatcher.hs --- a/src/Network/IMAP/RequestWatcher.hs +++ b/src/Network/IMAP/RequestWatcher.hs @@ -25,6 +25,8 @@ import Control.Exception (SomeException) import qualified Control.Monad.Catch as C import Control.Monad.Catch (MonadCatch) +import Control.Monad (when) +import Data.Foldable (forM_) import System.Log.Logger (errorM) @@ -33,9 +35,7 @@ requestWatcher conn = flip C.catch (handleExceptions conn) $ do parsedLine <- getParsedChunk (rawConnection . imapState $ conn) (AP.parse parseReply) - if isRight parsedLine - then reactToReply conn $ fromRight' parsedLine - else return () + when (isRight parsedLine) $ reactToReply conn $ fromRight' parsedLine requestWatcher conn @@ -73,9 +73,8 @@ threadId <- atomically . readTVar . serverWatcherThread . imapState $ conn connState <- atomically . readTVar $ connectionState conn - if isDisconnected connState && isJust threadId - then killThread $ fromJust threadId - else return () + when (isDisconnected connState && isJust threadId) $ + killThread $ fromJust threadId dispatchTagged :: (MonadIO m, Universe m) => [ResponseRequest] -> TaggedResult -> m [ResponseRequest] @@ -84,7 +83,7 @@ let pendingRequest = L.find (\r -> respRequestId r == reqId) requests if isJust pendingRequest - then liftIO . atomically $ do + then liftIO . atomically $ writeTQueue (responseQueue . fromJust $ pendingRequest) $ Tagged response else liftIO $ errorM "RequestWatcher" "Received a reply for an unknown request" @@ -164,9 +163,7 @@ } liftIO . atomically $ mapM_ (sendResponse reply) requests - if isJust threadId - then liftIO . killThread $ fromJust threadId - else return () + forM_ threadId $ liftIO . killThread sendResponse :: TaggedResult -> ResponseRequest -> STM () sendResponse response request = writeTQueue (responseQueue request) $ Tagged response diff --git a/src/Network/IMAP/Utils.hs b/src/Network/IMAP/Utils.hs --- a/src/Network/IMAP/Utils.hs +++ b/src/Network/IMAP/Utils.hs @@ -33,12 +33,12 @@ resultRest="Connection timeout" } else retry - readResult = readTQueue $ resultsQueue + readResult = readTQueue resultsQueue nextResult <- liftIO . atomically $ d_wait `orElse` readResult case nextResult of Tagged _ -> return nextResult - Untagged _ -> (return nextResult) `mplus` readResults resultsQueue + Untagged _ -> return nextResult `mplus` readResults resultsQueue escapeText :: T.Text -> T.Text escapeText t = T.replace "{" "\\{" $