HaskellNet 0.6.0.2 → 0.6.1.2

raw patch · 5 files changed

+95/−47 lines, 5 filesdep ~arraydep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: array, base, bytestring, cryptohash-md5, mime-mail, mtl, old-time, pretty, text

API changes (from Hackage documentation)

Files

• CHANGELOG +6/−0
• HaskellNet.cabal +12/−13
• src/Network/HaskellNet/Auth.hs +3/−0
• src/Network/HaskellNet/IMAP.hs +72/−34
• src/Network/HaskellNet/IMAP/Types.hs +2/−0

@@ -1,3 +1,9 @@+0.6.1.0 (2023-06-27)+  - fixed bug with wrong IMAP header decoding ([Issue 89](https://github.com/qnikst/HaskellNet/issues/89))+    Thanks to William Arteroi (@wwmoraes) and Nathan Collins (@ntc2)+  - added support for OAuth2 authorization+    Thanks to @paumr.+ 0.6.0.1 (2022-05-17)   - GHC 9.0+ support 

@@ -6,7 +6,7 @@                 Full examples can be found in the <https://github.com/qnikst/HaskellNet/tree/master/example repository>.                 Additional documentation on the major updates can be found in the                 <https://github.com/qnikst/HaskellNet/blob/master/Updating.md Updating.md> file-Version:        0.6.0.2+Version:        0.6.1.2 Copyright:      (c) 2006 Jun Mukai Author:         Jun Mukai Maintainer:     Alexander Vershilov <alexander.vershilov@sirius.online>,@@ -19,12 +19,11 @@ Cabal-version:  1.22 Build-type:     Simple Tested-with:-  GHC ==8.4.4-   || ==8.6.5-   || ==8.8.4+  GHC ==8.8.4    || ==8.10.7    || ==9.0.2-   || ==9.2.2+   || ==9.2.5+   || ==9.4.4  Extra-Source-Files:   CHANGELOG@@ -70,15 +69,15 @@   Build-Depends:     base >= 4.3 && < 4.18,     network >= 2.6.3.1 && < 3.2,-    mtl,-    bytestring >=0.10.2,-    pretty,-    array,-    cryptohash-md5,+    mtl >= 2.2.2 && < 2.3,+    bytestring >=0.10.2 && < 0.12,+    pretty >= 1.1.3 && < 1.2,+    array >= 0.5 && < 0.6,+    cryptohash-md5  >= 0.11 && < 0.12,     base64 < 0.5,-    old-time,-    mime-mail >= 0.4.7 && < 0.6,-    text+    old-time  >= 1.0 && < 1.2,+    mime-mail >= 0.4 && < 0.6,+    text  >= 1.0 && < 3    if !impl(ghc >= 8.0)     Build-depends: fail >= 4.9.0.0 && <4.10

@@ -24,6 +24,7 @@ data AuthType = PLAIN               | LOGIN               | CRAM_MD5+              | XOAUTH2                 deriving Eq  instance Show AuthType where@@ -32,6 +33,7 @@               showMain PLAIN    = "PLAIN"               showMain LOGIN    = "LOGIN"               showMain CRAM_MD5 = "CRAM-MD5"+              showMain XOAUTH2  = "XOAUTH2"  b64Encode :: String -> String b64Encode = T.unpack . encode . T.pack@@ -86,3 +88,4 @@ auth PLAIN    _ u p = plain u p auth LOGIN    _ u p = let (u', p') = login u p in unwords [u', p'] auth CRAM_MD5 c u p = cramMD5 c u p+auth XOAUTH2  _ u p = b64Encode $ "user=" ++ u ++ "\001auth=" ++ p ++ "\001\001"

@@ -8,7 +8,7 @@       -- ** autenticated state commands     , select, examine, create, delete, rename     , subscribe, unsubscribe-    , list, lsub, status, append+    , list, lsub, status, append, appendFull       -- ** selected state commands     , check, close, expunge     , search, store, copy@@ -70,6 +70,7 @@                  | SUBJECTs String                  | TEXTs String                  | TOs String+                 | XGMRAW String                  | UIDs [UID]  @@ -99,6 +100,7 @@               showQuery (SUBJECTs s)    = "SUBJECT " ++ s               showQuery (TEXTs s)       = "TEXT " ++ s               showQuery (TOs addr)      = "TO " ++ addr+              showQuery (XGMRAW s)      = "X-GM-RAW " ++ s               showQuery (UIDs uids)     = concat $ intersperse "," $                                           map show uids               showFlag Seen        = "SEEN"@@ -112,6 +114,9 @@ data FlagsQuery = ReplaceFlags [Flag]                 | PlusFlags [Flag]                 | MinusFlags [Flag]+                | ReplaceGmailLabels [GmailLabel]+                | PlusGmailLabels [GmailLabel]+                | MinusGmailLabels [GmailLabel]  ---------------------------------------------------------------------- -- establish connection@@ -213,10 +218,10 @@                     return buf'         let (resp, mboxUp, value) = eval pNone (show6 num) buf         case resp of-         OK _ _        -> do mboxUpdate conn mboxUp-                             return value-         NO _ msg      -> fail ("NO: " ++ msg)-         BAD _ msg     -> fail ("BAD: " ++ msg)+         OK _ _ -> do mboxUpdate conn mboxUp+                      return value+         NO _ msg -> fail ("NO: " ++ msg)+         BAD _ msg -> fail ("BAD: " ++ msg)          PREAUTH _ msg -> fail ("preauth: " ++ msg)  noop :: IMAPConnection -> IO ()@@ -332,13 +337,13 @@        buf2 <- getResponse $ stream conn        let (resp, mboxUp, ()) = eval pNone (show6 num) buf2        case resp of-         OK _ _ -> mboxUpdate conn mboxUp-         NO _ msg -> fail ("NO: "++msg)-         BAD _ msg -> fail ("BAD: "++msg)+         OK _ _        -> mboxUpdate conn mboxUp+         NO _ msg      -> fail ("NO: "++msg)+         BAD _ msg     -> fail ("BAD: "++msg)          PREAUTH _ msg -> fail ("PREAUTH: "++msg)     where mailLines = BS.lines mailData           len       = sum $ map ((2+) . BS.length) mailLines-          tstr      = maybe "" ((" "++) . show) time+          tstr      = maybe "" ((" "++) . datetimeToStringIMAP) time           fstr      = maybe "" ((" ("++) . (++")") . unwords . map show) flags'  check :: IMAPConnection -> IO ()@@ -377,26 +382,26 @@ fetchSize :: IMAPConnection -> UID -> IO Int fetchSize conn uid =     do lst <- fetchByString conn uid "RFC822.SIZE"-       return $ maybe 0 read $ lookup' "RFC822.SIZE" lst+       return $ maybe 0 read $ lookup "RFC822.SIZE" lst  fetchHeaderFields :: IMAPConnection                   -> UID -> [String] -> IO ByteString fetchHeaderFields conn uid hs =-    do lst <- fetchByString conn uid ("BODY[HEADER.FIELDS "++unwords hs++"]")-       return $ maybe BS.empty BS.pack $-              lookup' ("BODY[HEADER.FIELDS "++unwords hs++"]") lst+    do let fetchCmd = "BODY[HEADER.FIELDS ("++unwords hs++")]"+       lst <- fetchByString conn uid fetchCmd+       return $ maybe BS.empty BS.pack $ lookup' fetchCmd lst  fetchHeaderFieldsNot :: IMAPConnection                      -> UID -> [String] -> IO ByteString fetchHeaderFieldsNot conn uid hs =-    do let fetchCmd = "BODY[HEADER.FIELDS.NOT "++unwords hs++"]"+    do let fetchCmd = "BODY[HEADER.FIELDS.NOT ("++unwords hs++")]"        lst <- fetchByString conn uid fetchCmd        return $ maybe BS.empty BS.pack $ lookup' fetchCmd lst  fetchFlags :: IMAPConnection -> UID -> IO [Flag] fetchFlags conn uid =     do lst <- fetchByString conn uid "FLAGS"-       return $ getFlags $ lookup' "FLAGS" lst+       return $ getFlags $ lookup "FLAGS" lst     where getFlags Nothing  = []           getFlags (Just s) = eval' dvFlags "" s @@ -431,9 +436,12 @@     where fstrs fs = "(" ++ (concat $ intersperse " " $ map show fs) ++ ")"           toFStr s fstrs' =               s ++ (if isSilent then ".SILENT" else "") ++ " " ++ fstrs'-          flgs (ReplaceFlags fs) = toFStr "FLAGS" $ fstrs fs-          flgs (PlusFlags fs)    = toFStr "+FLAGS" $ fstrs fs-          flgs (MinusFlags fs)   = toFStr "-FLAGS" $ fstrs fs+          flgs (ReplaceGmailLabels ls) = toFStr "X-GM-LABELS" $ fstrs ls+          flgs (PlusGmailLabels ls)    = toFStr "+X-GM-LABELS" $ fstrs ls+          flgs (MinusGmailLabels ls)   = toFStr "-X-GM-LABELS" $ fstrs ls+          flgs (ReplaceFlags fs)       = toFStr "FLAGS" $ fstrs fs+          flgs (PlusFlags fs)          = toFStr "+FLAGS" $ fstrs fs+          flgs (MinusFlags fs)         = toFStr "-FLAGS" $ fstrs fs           procStore (n, ps) = (maybe (toEnum (fromIntegral n)) read                                          (lookup' "UID" ps)                               ,maybe [] (eval' dvFlags "") (lookup' "FLAG" ps))@@ -452,25 +460,55 @@ ---------------------------------------------------------------------- -- auxialiary functions +showMonth :: Month -> String+showMonth January   = "Jan"+showMonth February  = "Feb"+showMonth March     = "Mar"+showMonth April     = "Apr"+showMonth May       = "May"+showMonth June      = "Jun"+showMonth July      = "Jul"+showMonth August    = "Aug"+showMonth September = "Sep"+showMonth October   = "Oct"+showMonth November  = "Nov"+showMonth December  = "Dec"++show2 :: Int -> String+show2 n | n < 10    = '0' : show n+        | otherwise = show n+++show4 :: (Ord a, Num a, Show a) => a -> String+show4 n | n > 1000 = show n+        | n > 100  = '0' : show n+        | n > 10   = "00" ++ show n+        | otherwise  = "000" ++ show n+ dateToStringIMAP :: CalendarTime -> String dateToStringIMAP date = concat $ intersperse "-" [show2 $ ctDay date                                                  , showMonth $ ctMonth date                                                  , show $ ctYear date]-    where show2 n | n < 10    = '0' : show n-                  | otherwise = show n-          showMonth January   = "Jan"-          showMonth February  = "Feb"-          showMonth March     = "Mar"-          showMonth April     = "Apr"-          showMonth May       = "May"-          showMonth June      = "Jun"-          showMonth July      = "Jul"-          showMonth August    = "Aug"-          showMonth September = "Sep"-          showMonth October   = "Oct"-          showMonth November  = "Nov"-          showMonth December  = "Dec"+timeToStringIMAP :: CalendarTime -> String+timeToStringIMAP c = concat+                     $ intersperse ":"+                     $ fmap show2 [ctHour c, ctMin c, ctSec c] +-- Convert CalenarTime to "date-time" string per RFC3501+datetimeToStringIMAP :: CalendarTime -> String+datetimeToStringIMAP c =+  "\""+  ++ dateToStringIMAP c+  ++ " "+  ++ timeToStringIMAP c+  ++ " "+  ++ zone (ctTZ c)+  ++ "\""+  where+    zone s =+      (if s>=0 then "+" else "-") +++      show4 (s `div` 3600)+ strip :: ByteString -> ByteString strip = fst . BS.spanEnd isSpace . BS.dropWhile isSpace @@ -482,10 +520,10 @@  lookup' :: String -> [(String, b)] -> Maybe b lookup' _ [] = Nothing-lookup' q ((k,v):xs) | q == lastWord k  = return v+lookup' q ((k,v):xs) | q == query k  = return v                      | otherwise        = lookup' q xs     where-        lastWord = last . words+        query = unwords . drop 2 . words  -- 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

@@ -1,5 +1,6 @@ module Network.HaskellNet.IMAP.Types     ( MailboxName+    , GmailLabel     , UID     , Charset     , MailboxInfo(..)@@ -28,6 +29,7 @@ type MailboxName = String type UID = Word64 type Charset = String+type GmailLabel = String  data MailboxInfo = MboxInfo { _mailbox :: MailboxName                             , _exists :: Integer