From c84ec9eef4f3d6115b5eefda9d6f35dd70267d8d Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Wed, 10 Jun 2026 14:13:44 +0100
Subject: [PATCH] Fix IMAP fetch body lookup

---
 src/Network/HaskellNet/IMAP.hs | 27 ++++++++++++++++++++++++---
 test/IMAPParsersTest.hs        | 20 ++++++++++++++++++--
 2 files changed, 42 insertions(+), 5 deletions(-)

diff --git a/src/Network/HaskellNet/IMAP.hs b/src/Network/HaskellNet/IMAP.hs
index e00af52..66e57b0 100644
--- a/src/Network/HaskellNet/IMAP.hs
+++ b/src/Network/HaskellNet/IMAP.hs
@@ -545,10 +545,31 @@ bsPutCrLf h s = bsPut h s >> bsPut h crlf >> bsFlush h
 
 lookup' :: String -> [(String, b)] -> Maybe b
 lookup' _ [] = Nothing
-lookup' q ((k,v):xs) | q == query k  = return v
+lookup' q ((k,v):xs) | matchesFetchKey q k = return v
                      | otherwise        = lookup' q xs
-    where
-        query = unwords . drop 2 . words
+
+matchesFetchKey :: String -> String -> Bool
+matchesFetchKey expected actual =
+    normalizeFetchKey expected == normalizeFetchKey actual ||
+    normalizeFetchKey expected == normalizeFetchKey (stripUIDPrefix actual)
+
+normalizeFetchKey :: String -> String
+normalizeFetchKey = stripOrigin . stripPeek . map toUpper
+  where
+    stripPeek key =
+        case stripPrefix "BODY.PEEK[" key of
+          Just rest -> "BODY[" ++ rest
+          Nothing -> key
+    stripOrigin key =
+        case break (== '<') key of
+          (bodySection, '<':_) | "BODY[" `isPrefixOf` bodySection -> bodySection
+          _ -> key
+
+stripUIDPrefix :: String -> String
+stripUIDPrefix key =
+    case words key of
+      "UID" : _ : rest -> unwords rest
+      _ -> key
 
 -- TODO: This is just a first trial solution for this stack overflow question:
 --       http://stackoverflow.com/questions/26183675/error-when-fetching-subject-from-email-using-haskellnets-imap
diff --git a/test/IMAPParsersTest.hs b/test/IMAPParsersTest.hs
index dfcf270..51d3da6 100644
--- a/test/IMAPParsersTest.hs
+++ b/test/IMAPParsersTest.hs
@@ -11,8 +11,6 @@ import Network.HaskellNet.IMAP.Parsers
 import Network.HaskellNet.IMAP.Types
 import System.Exit
 
-import System.Exit
-
 import Test.HUnit
 
 data ReadStep = ReadLine ByteString | ReadBytes ByteString
@@ -57,6 +55,9 @@ scriptedConnection steps = do
 line :: String -> ReadStep
 line = ReadLine . BS.pack
 
+bytes :: String -> ReadStep
+bytes = ReadBytes . BS.pack
+
 okLine :: String -> ReadStep
 okLine = line . ("000000 OK " ++)
 
@@ -71,6 +72,7 @@ assertCommand name expected steps action =
         actual <- written
         expected @=? actual
 
+
 baseTest =
     [(OK Nothing "LOGIN Completed", MboxUpdate Nothing Nothing, ())
      ~=? eval' pNone "A001"
@@ -332,6 +334,19 @@ flagTest =
     ]
 
 
+imapFetchTest =
+    [ "fetch works when BODY precedes UID" ~: TestCase $ do
+          (conn, _) <- scriptedConnection
+              [ line "* 12 FETCH (BODY[] {5}"
+              , bytes "hello"
+              , line " UID 999)"
+              , okLine "FETCH completed"
+              ]
+          fetched <- IMAP.fetch conn 999
+          BS.pack "hello" @=? fetched
+    ]
+
+
 testData = [ "base" ~: baseTest
            , "capability" ~: capabilityTest
            , "noop" ~: noopTest
@@ -343,6 +358,7 @@ testData = [ "base" ~: baseTest
            , "fetch" ~: fetchTest
            , "imap commands" ~: imapCommandTest
            , "flags" ~: flagTest
+           , "imap fetch api" ~: imapFetchTest
            ]