Add exact UID-set fetch API

src/Network/HaskellNet/IMAP.hs

@@ -16,7 +16,7 @@
       -- * fetch commands
     , fetch, fetchHeader, fetchSize, fetchHeaderFields, fetchHeaderFieldsNot
     , fetchFlags, fetchR, fetchByString, fetchByStringR
-    , fetchByByteString, fetchByByteStringR
+    , fetchByByteString, fetchByByteStringR, fetchByByteStringSet
     , fetchPeek, fetchRPeek
       -- * other types
     , Flag(..), Attribute(..), MailboxStatus(..)
@@ -266,7 +266,7 @@
     do (c, num) <- sendCommand' conn $ "AUTHENTICATE " ++ show at
        let challenge =
                if BS.take 2 c == BS.pack "+ "
                then A.b64Decode $ BS.unpack $ head $
                     dropWhile (isSpace . BS.last) $ BS.inits $ BS.drop 2 c
                else ""
        bsPutCrLf (stream conn) $ BS.pack $
@@ -466,6 +466,19 @@
     where proc (n, ps) =
               (maybe (toEnum (fromIntegral n)) (read . BS.unpack) (lookup' "UID" ps), ps)
 
+-- | Fetch arbitrary data items for an exact set of UIDs.
+--
+-- Unlike 'fetchByByteStringR', this does not fetch messages whose UIDs happen
+-- to lie between sparse search results.
+fetchByByteStringSet :: IMAPConnection -> [UID] -> String
+                     -> IO [(UID, [(String, ByteString)])]
+fetchByByteStringSet _ [] _ = return []
+fetchByByteStringSet conn uids command =
+    fetchCommandBS conn
+        ("UID FETCH "++intercalate "," (map show uids)++" "++command) proc
+    where proc (n, ps) =
+              (maybe (toEnum (fromIntegral n)) (read . BS.unpack) (lookup' "UID" ps), ps)
+
 fetchCommand :: IMAPConnection -> String
              -> ((Integer, [(String, String)]) -> b) -> IO [b]
 fetchCommand conn command proc =

test/IMAPParsersTest.hs

@@ -427,6 +427,26 @@ imapFetchTest =
               ]
           fetched <- IMAP.fetchR conn (1, 2)
           [(101, firstBody), (102, secondBody)] @=? fetched
+    , "fetchByByteStringSet fetches an exact sparse UID set" ~: TestCase $ do
+          let firstStructure = BS.pack "(\"TEXT\" \"PLAIN\")"
+              secondStructure = BS.pack "(\"APPLICATION\" \"PDF\")"
+          (conn, written) <- scriptedConnection
+              [ line "* 1 FETCH (BODYSTRUCTURE (\"TEXT\" \"PLAIN\") UID 101)"
+              , line "* 2 FETCH (BODYSTRUCTURE (\"APPLICATION\" \"PDF\") UID 999)"
+              , okLine "FETCH completed"
+              ]
+          fetched <- IMAP.fetchByByteStringSet conn [101, 205, 999] "BODYSTRUCTURE"
+          [ (101, [("BODYSTRUCTURE", firstStructure), ("UID", BS.pack "101")])
+            , (999, [("BODYSTRUCTURE", secondStructure), ("UID", BS.pack "999")])
+            ] @=? fetched
+          actual <- written
+          commandBytes "000000 UID FETCH 101,205,999 BODYSTRUCTURE" @=? actual
+    , "fetchByByteStringSet skips the command for an empty UID set" ~: TestCase $ do
+          (conn, written) <- scriptedConnection []
+          fetched <- IMAP.fetchByByteStringSet conn [] "BODYSTRUCTURE"
+          [] @=? fetched
+          actual <- written
+          B.empty @=? actual
     , "fetchByString keeps scalar and literal values compatible" ~: TestCase $ do
           let headers = BS.pack "hello"
           (conn, _) <- scriptedConnection