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.3.0.0 +version: 0.3.0.2 synopsis: An efficient IMAP client library, with SSL and streaming license: BSD3 license-file: LICENSE @@ -119,10 +119,10 @@ hslogger == 1.2.*, transformers == 0.5.*, list-t == 1, - derive == 2.5.*, + derive == 2.6.*, stm-delay == 0.1.*, exceptions == 0.8.*, - pipes == 4.1.*, + pipes == 4.3.*, containers == 0.5.*, network == 2.6.* hs-source-dirs: src @@ -155,16 +155,16 @@ hslogger == 1.2.*, transformers == 0.5.*, list-t == 1, - derive == 2.5.*, + derive == 2.6.*, stm-delay == 0.1.*, exceptions == 0.8.*, - pipes == 4.1.*, + pipes == 4.3.*, containers == 0.5.*, network == 2.6.*, tasty == 0.11.*, - HUnit == 1.3.*, - QuickCheck == 2.8.*, + HUnit == 1.5.*, + QuickCheck == 2.9.*, tasty-hunit == 0.9.*, tasty-quickcheck == 0.8.*, monadIO == 0.10.*, diff --git a/src/Network/IMAP.hs b/src/Network/IMAP.hs --- a/src/Network/IMAP.hs +++ b/src/Network/IMAP.hs @@ -56,7 +56,7 @@ import Network.Connection import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8, decodeUtf8) +import Data.Text.Encoding (encodeUtf8) import qualified Data.ByteString.Char8 as BSC import qualified Data.STM.RollingQueue as RQ @@ -75,7 +75,6 @@ import Control.Monad.IO.Class (MonadIO(..)) import ListT (toList, ListT) import qualified Data.List as L -import qualified Debug.Trace as DT -- |Connects to the server and gives you a connection object -- that needs to be passed to any other command. You should only call it once @@ -329,7 +328,7 @@ -- is of type NO or BAD. Also return all untagged replies received if -- replies list contains a BYE response -- (when the server decided to cleanly disconnect) -simpleFormat :: (MonadIO m, Universe m) => +simpleFormat :: (MonadIO m) => ListT m CommandResult -> m SimpleResult simpleFormat action = do results <- toList action @@ -349,4 +348,5 @@ oneParamCommand :: (MonadPlus m, MonadIO m, Universe m) => T.Text -> IMAPConnection -> T.Text -> m CommandResult oneParamCommand commandName conn mailboxName = sendCommand conn wholeCommand - where wholeCommand = encodeUtf8 $ T.intercalate " " [commandName, mailboxName] + where wholeCommand = encodeUtf8 $ T.intercalate " " [commandName, escapedMailbox] + escapedMailbox = T.concat ["\"", mailboxName, "\""] diff --git a/src/Network/IMAP/Parsers/Fetch.hs b/src/Network/IMAP/Parsers/Fetch.hs --- a/src/Network/IMAP/Parsers/Fetch.hs +++ b/src/Network/IMAP/Parsers/Fetch.hs @@ -1,18 +1,17 @@ module Network.IMAP.Parsers.Fetch where -import Network.IMAP.Types -import Network.IMAP.Parsers.Utils -import Network.IMAP.Parsers.Untagged (parseFlags) +import Network.IMAP.Types +import Network.IMAP.Parsers.Utils +import Network.IMAP.Parsers.Untagged (parseFlags) -import Data.Attoparsec.ByteString +import Data.Attoparsec.ByteString import qualified Data.Attoparsec.ByteString as AP -import Data.Word8 +import Data.Word8 import qualified Data.ByteString.Char8 as BSC -import Data.Maybe (fromJust, isNothing) -import Data.Either.Combinators (isRight, fromRight', fromLeft') +import Data.Maybe (fromJust, isNothing) -import Control.Applicative -import Control.Monad (liftM) +import Control.Applicative +import Control.Monad (liftM) parseFetch :: Parser (Either ErrorMessage CommandResult) @@ -54,12 +53,11 @@ size <- AP.takeWhile1 isDigit string "}\r\n" - let parsedSize = toInt size - if isRight parsedSize - then do - msg <- AP.take (fromRight' parsedSize) + case toInt size of + Right parsedSize -> do + msg <- AP.take $ fromIntegral parsedSize return . Right . Body $ msg - else return . Left $ fromLeft' parsedSize + Left e -> return $ Left e parseBodyStructure :: Parser UntaggedResult parseBodyStructure = do diff --git a/src/Network/IMAP/Parsers/Utils.hs b/src/Network/IMAP/Parsers/Utils.hs --- a/src/Network/IMAP/Parsers/Utils.hs +++ b/src/Network/IMAP/Parsers/Utils.hs @@ -2,28 +2,27 @@ import Network.IMAP.Types -import Data.Attoparsec.ByteString.Char8 +import Data.Attoparsec.ByteString.Char8 import qualified Data.Attoparsec.ByteString.Char8 as AP import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8) +import Data.Text.Encoding (decodeUtf8) import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString as BS -import Data.Either.Combinators (rightToMaybe) -import Control.Monad (liftM) +import Data.Either.Combinators (rightToMaybe) +import Control.Monad (liftM) -import Data.Set (Set) +import Data.Set (Set) import qualified Data.Set as Set eatUntilClosingParen :: Parser BSC.ByteString eatUntilClosingParen = scan 0 hadClosedAllParens <* char ')' hadClosedAllParens :: Int -> Char -> Maybe Int -hadClosedAllParens openingParenCount char - | char == ')' = +hadClosedAllParens openingParenCount character + | character == ')' = if openingParenCount == 1 then Nothing else Just $ openingParenCount - 1 - | char == '(' = Just $ openingParenCount + 1 + | character == '(' = Just $ openingParenCount + 1 | otherwise = Just openingParenCount @@ -45,12 +44,12 @@ route <- nilOrValue $ parseNString char ' ' - emailUsername <- nilOrValue $ parseNString + username <- nilOrValue $ parseNString char ' ' - emailDomain <- nilOrValue $ parseNString + domain <- nilOrValue $ parseNString char ')' - return $ EmailAddress label route emailUsername emailDomain + return $ EmailAddress label route username domain nilOrValue :: Parser a -> Parser (Maybe a) nilOrValue parser = rightToMaybe <$> AP.eitherP (string "NIL") parser @@ -95,22 +94,22 @@ isAtomChar :: Char -> Bool isAtomChar = flip Set.notMember atomSpecials -toInt :: BSC.ByteString -> Either ErrorMessage Int +toInt :: BSC.ByteString -> Either ErrorMessage Integer toInt bs = if null parsed then Left errorMsg else Right . fst . head $ parsed where parsed = reads $ BSC.unpack bs errorMsg = T.concat ["Count not parse '", decodeUtf8 bs, "' as an integer"] -parseNumber :: (Int -> a) -> BSC.ByteString -> +parseNumber :: (Integer -> a) -> BSC.ByteString -> BSC.ByteString -> Parser (Either ErrorMessage a) parseNumber constructor prefix postfix = do if not . BSC.null $ prefix then string prefix <* char ' ' else return BSC.empty - number <- takeWhile1 isDigit + parsedNumber <- takeWhile1 isDigit if not . BSC.null $ postfix then char ' ' *> string postfix else return BSC.empty - return $ liftM constructor (toInt number) + return $ liftM constructor (toInt parsedNumber) 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 @@ -3,8 +3,6 @@ import Network.IMAP.Types import Network.IMAP.Parsers -import Data.Either (isRight) -import Data.Either.Combinators (fromRight') import Data.Maybe (isJust, fromJust) import Network.Connection @@ -15,7 +13,6 @@ import qualified Data.List as L import qualified Data.Text as T -import qualified Data.Text.Encoding as T import qualified Data.STM.RollingQueue as RQ import Control.Concurrent.STM.TQueue @@ -39,7 +36,7 @@ requestWatcher conn -reactToReply :: (MonadIO m, Universe m, MonadCatch m) => +reactToReply :: (MonadIO m) => IMAPConnection -> ParseResult -> m () @@ -61,7 +58,7 @@ liftIO . atomically $ writeTVar (outstandingReqs state) pendingReqs shouldIDie conn -updateConnState :: (MonadIO m, Universe m) => IMAPConnection -> CommandResult -> m () +updateConnState :: (MonadIO m) => IMAPConnection -> CommandResult -> m () updateConnState conn command = do let connState = connectionState conn @@ -69,11 +66,10 @@ Untagged u -> case u of OKResult _ -> liftIO . atomically $ writeTVar connState Connected Bye -> liftIO . atomically $ writeTVar connState Disconnected - _ -> return () _ -> return () -shouldIDie :: (MonadIO m, Universe m) => IMAPConnection -> m () +shouldIDie :: (MonadIO m) => IMAPConnection -> m () shouldIDie conn = liftIO $ do threadId <- atomically . readTVar . serverWatcherThread . imapState $ conn connState <- atomically . readTVar $ connectionState conn @@ -81,7 +77,7 @@ when (isDisconnected connState && isJust threadId) $ killThread $ fromJust threadId -dispatchError :: (MonadIO m, Universe m) => [ResponseRequest] -> +dispatchError :: (MonadIO m) => [ResponseRequest] -> ErrorMessage -> m [ResponseRequest] dispatchError requests errorMessage = do case requests of @@ -98,7 +94,7 @@ \without an outstanding request" return [] -dispatchTagged :: (MonadIO m, Universe m) => [ResponseRequest] -> +dispatchTagged :: (MonadIO m) => [ResponseRequest] -> TaggedResult -> m [ResponseRequest] dispatchTagged requests response = do let reqId = commandId response @@ -112,7 +108,7 @@ then filter (/= fromJust pendingRequest) requests else requests -dispatchUntagged :: (MonadIO m, Universe m) => IMAPConnection -> +dispatchUntagged :: (MonadIO m) => IMAPConnection -> [ResponseRequest] -> UntaggedResult -> m [ResponseRequest] @@ -167,9 +163,9 @@ Nothing -> return . fromJust $ parsed -- |Reject all outstanding requests with the exception handler, close the watcher -handleExceptions :: (MonadIO m, Universe m, MonadCatch m) => IMAPConnection -> - SomeException -> - m () +handleExceptions :: (MonadIO m) => IMAPConnection -> + SomeException -> + m () handleExceptions conn e = do let state = imapState conn diff --git a/src/Network/IMAP/Types.hs b/src/Network/IMAP/Types.hs --- a/src/Network/IMAP/Types.hs +++ b/src/Network/IMAP/Types.hs @@ -127,21 +127,21 @@ -- |Untagged replies are the actual data returned in response to the commands. data UntaggedResult = Flags [Flag] -- ^ A list of flags a mailbox has - | Exists Int -- ^ How many messages exist in a mailbox - | Expunge Int -- ^ Sequence id of a deleted message + | Exists Integer -- ^ How many messages exist in a mailbox + | Expunge Integer -- ^ Sequence id of a deleted message | Bye -- ^ Returned by the server when it cleanly disconnects - | HighestModSeq Int - | Recent Int -- ^ Number of recent messages - | Messages Int -- ^ Number of messages in a mailbox - | Unseen Int -- ^ Number of unseen messages + | HighestModSeq Integer + | Recent Integer -- ^ Number of recent messages + | Messages Integer -- ^ Number of messages in a mailbox + | Unseen Integer -- ^ Number of unseen messages | PermanentFlags [Flag] - | UID Int -- ^ UID of a message - | MessageId Int -- ^ A sequence id of a message + | UID Integer -- ^ UID of a message + | MessageId Integer -- ^ A sequence id of a message -- |UID that will be given to the next message added to this mailbox - | UIDNext Int + | UIDNext Integer -- |A triple of mailbox name, it's UIDValidity value and message UID -- is always unique for a given message - | UIDValidity Int + | UIDValidity Integer | OKResult T.Text -- ^ Result of an OK response | Capabilities [Capability] -- ^ What server advertises that it supports -- |Response to the `LIST` command @@ -157,7 +157,7 @@ -- |Status of a mailbox, will contain many different responses inside | StatusR T.Text [UntaggedResult] -- |A list of message IDs or UIDs fullfilling the search criterions - | Search [Int] + | Search [Integer] -- |A parsed ENVELOPE reply, prefixed to avoid name clashes | Envelope { eDate :: Maybe T.Text, @@ -172,7 +172,7 @@ eMessageId :: Maybe T.Text } | InternalDate T.Text - | Size Int -- ^ Message size + | Size Integer -- ^ Message size | Unknown BSC.ByteString -- ^ An unsupported value | Body BSC.ByteString -- ^ Message body, or headers | BodyStructure BSC.ByteString -- ^ An unparsed bodystructure @@ -214,6 +214,7 @@ connectionPut' c d = liftIO $ connectionPut c d connectionGetChunk'' c cont = liftIO $ connectionGetChunk' c cont +defaultImapSettings :: IMAPSettings defaultImapSettings = IMAPSettings 30 10 $(derive makeIs ''Flag) 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 @@ -54,7 +54,7 @@ T.replace "\\" "\\\\" t -ifNotDisconnected :: (MonadPlus m, MonadIO m, Universe m) => +ifNotDisconnected :: (MonadPlus m, MonadIO m) => IMAPConnection -> m CommandResult -> m CommandResult ifNotDisconnected conn action = do connState <- liftIO . atomically . readTVar $ connectionState conn