diff --git a/src/Network/HaskellNet/IMAP.hs b/src/Network/HaskellNet/IMAP.hs
index 29c704c..d413280 100644
--- a/src/Network/HaskellNet/IMAP.hs
+++ b/src/Network/HaskellNet/IMAP.hs
@@ -14,7 +14,7 @@ module Network.HaskellNet.IMAP
     , search, store, copy, move
     , idle
       -- * fetch commands
-    , fetch, fetchHeader, fetchSize, fetchHeaderFields, fetchHeaderFieldsNot
+    , fetch, fetchHeader, fetchPeekHeader, fetchSize, fetchHeaderFields, fetchHeaderFieldsNot
     , fetchFlags, fetchR, fetchByString, fetchByStringR
     , fetchByByteString, fetchByByteStringR
     , fetchPeek, fetchRPeek
@@ -390,6 +390,12 @@ fetchHeader conn uid =
     do lst <- fetchByByteString conn uid "BODY[HEADER]"
        return $ fromMaybe BS.empty $ lookup' "BODY[HEADER]" lst
 
+-- | Like 'fetchHeader' but without marking the email as seen/read.
+fetchPeekHeader :: IMAPConnection -> UID -> IO ByteString
+fetchPeekHeader conn uid =
+    do lst <- fetchByByteString conn uid "BODY.PEEK[HEADER]"
+       return $ fromMaybe BS.empty $ lookup' "BODY[HEADER]" lst
+
 fetchSize :: IMAPConnection -> UID -> IO Int
 fetchSize conn uid =
     do lst <- fetchByByteString conn uid "RFC822.SIZE"
diff --git a/test/IMAPParsersTest.hs b/test/IMAPParsersTest.hs
index 281102d..f396b8a 100644
--- a/test/IMAPParsersTest.hs
+++ b/test/IMAPParsersTest.hs
@@ -325,6 +325,14 @@ imapCommandTest =
           (commandBytes "000000 UID COPY 42 \"foo bar\"")
           [okLine "COPY completed"]
           (\conn -> IMAP.copy conn 42 "foo bar")
+    , assertCommand "fetchPeekHeader uses BODY.PEEK[HEADER]"
+          (commandBytes "000000 UID FETCH 42 BODY.PEEK[HEADER]")
+          [ line "* 12 FETCH (BODY[HEADER] {4}"
+          , ReadBytes (BS.pack "head")
+          , line " UID 42)"
+          , okLine "FETCH completed"
+          ]
+          (\conn -> IMAP.fetchPeekHeader conn 42)
     , assertCommand "move quotes mailbox"
           (commandBytes "000000 UID MOVE 42 \"foo bar\"")
           [okLine "MOVE completed"]
@@ -388,6 +396,28 @@ imapFetchTest =
               ]
           fetched <- IMAP.fetchPeek conn 42
           body @=? fetched
+    , "fetchPeekHeader reads headers without setting Seen" ~: TestCase $ do
+          let headers = BS.pack "Subject: Hi\r\nFrom: a@example.com\r\n\r\n"
+          (conn, _) <- scriptedConnection
+              [ line ("* 12 FETCH (BODY[HEADER] {"
+                       ++ show (BS.length headers) ++ "}")
+              , ReadBytes headers
+              , line " UID 42)"
+              , okLine "FETCH completed"
+              ]
+          fetched <- IMAP.fetchPeekHeader conn 42
+          headers @=? fetched
+    , "fetchPeekHeader accepts BODY.PEEK response keys" ~: TestCase $ do
+          let headers = BS.pack "Subject: Peek\r\n\r\n"
+          (conn, _) <- scriptedConnection
+              [ line ("* 12 FETCH (BODY.PEEK[HEADER] {"
+                       ++ show (BS.length headers) ++ "}")
+              , ReadBytes headers
+              , line " UID 42)"
+              , okLine "FETCH completed"
+              ]
+          fetched <- IMAP.fetchPeekHeader conn 42
+          headers @=? fetched
     , "fetchSize parses scalar size responses" ~: TestCase $ do
           (conn, _) <- scriptedConnection
               [ line "* 12 FETCH (RFC822.SIZE 12345 UID 42)"