diff --git a/HaskellNet.cabal b/HaskellNet.cabal index 88d98e1..657309e 100644 --- a/HaskellNet.cabal +++ b/HaskellNet.cabal @@ -33,7 +33,7 @@ Extra-Source-Files: Source-Repository head type: git - location: git://github.com/qnikst/HaskellNet.git + location: https://github.com/qnikst/HaskellNet.git Flag network-bsd description: Use network-bsd @@ -87,3 +87,13 @@ Library network >=2.7 else Build-Depends: network <2.7 + +Test-suite imap-parsers + Type: exitcode-stdio-1.0 + Hs-Source-Dirs: test + Main-is: IMAPParsersTest.hs + default-language: Haskell2010 + Build-Depends: + base >= 4.3 && < 4.22, + HaskellNet, + HUnit >= 1.6 && < 1.7 diff --git a/src/Network/HaskellNet/IMAP/Parsers.hs b/src/Network/HaskellNet/IMAP/Parsers.hs index 8153621..f0b521f 100644 --- a/src/Network/HaskellNet/IMAP/Parsers.hs +++ b/src/Network/HaskellNet/IMAP/Parsers.hs @@ -259,7 +259,8 @@ pListLine list = pStatusLine :: Parser RespDerivs (Either a [(MailboxStatus, Integer)]) pStatusLine = do string "* STATUS " - _ <- anyChar `manyTill` space + _ <- pMailboxName + space stats <- between (char '(') (char ')') (parseStat `sepBy1` space) crlfP return $ Right stats @@ -274,6 +275,13 @@ pStatusLine = num <- many1 digit >>= return . read return (cons, num) +pMailboxName :: Parser RespDerivs MailboxName +pMailboxName = pQuotedString <|> many1 (noneOf " \r\n") + +pQuotedString :: Parser RespDerivs String +pQuotedString = between (char '"') (char '"') (many quotedChar) + where quotedChar = (char '\\' >> noneOf "\r\n") <|> noneOf "\"\\\r\n" + pSearchLine :: Parser RespDerivs (Either a [UID]) pSearchLine = do string "* SEARCH " nums <- (many1 digit) `sepBy` space diff --git a/test/IMAPParsersTest.hs b/test/IMAPParsersTest.hs index 6819d6c..eb6890e 100644 --- a/test/IMAPParsersTest.hs +++ b/test/IMAPParsersTest.hs @@ -3,6 +3,8 @@ module Main (main) where import Network.HaskellNet.IMAP.Parsers import Network.HaskellNet.IMAP.Types +import System.Exit + import Test.HUnit baseTest = @@ -96,6 +98,27 @@ statusTest = "* STATUS blurdybloop (MESSAGES 231 UIDNEXT 44292)\r\n\ \A042 OK STATUS completed\r\n" +statusQuotedMailboxTest = + [ ( OK Nothing "STATUS completed" + , MboxUpdate Nothing Nothing + , [(MESSAGES, 231), (UIDNEXT, 44292)]) + ~=? eval' pStatus "A042" + "* STATUS \"[Gmail]/Alle Nachrichten\" (MESSAGES 231 UIDNEXT 44292)\r\n\ + \A042 OK STATUS completed\r\n" + , ( OK Nothing "STATUS completed" + , MboxUpdate Nothing Nothing + , [(MESSAGES, 1)]) + ~=? eval' pStatus "A043" + "* STATUS \"foo\\\" bar\" (MESSAGES 1)\r\n\ + \A043 OK STATUS completed\r\n" + , ( OK Nothing "STATUS completed" + , MboxUpdate Nothing Nothing + , [(MESSAGES, 1)]) + ~=? eval' pStatus "A044" + "* STATUS foo (MESSAGES 1)\r\n\ + \A044 OK STATUS completed\r\n" + ] + expungeTest = ( OK Nothing "EXPUNGE completed" , MboxUpdate Nothing Nothing @@ -167,11 +190,15 @@ testData = [ "base" ~: baseTest , "noop" ~: noopTest , "select" ~: selectTest , "list" ~: listTest - , "status" ~: statusTest + , "status" ~: TestList [ statusTest, TestList statusQuotedMailboxTest ] , "expunge" ~: expungeTest , "search" ~: searchTest , "fetch" ~: fetchTest ] -main = runTestTT (test testData) +main = do + counts <- runTestTT (test testData) + if errors counts == 0 && failures counts == 0 + then exitSuccess + else exitFailure