module Network.HaskellNet.IMAP
    ( connectIMAP, connectIMAPPort, connectStream
      -- * IMAP commands
      -- ** any state commands
    , noop, capability, logout
      -- ** not authenticated state commands
    , login, authenticate
      -- ** autenticated state commands
    , select, examine, create, delete, rename
    , subscribe, unsubscribe
    , list, lsub, status, append, appendFull
      -- ** selected state commands
    , check, close, expunge
    , search, store, copy
    , idle
      -- * fetch commands
    , fetch, fetchHeader, fetchSize, fetchHeaderFields, fetchHeaderFieldsNot
    , fetchFlags, fetchR, fetchByString, fetchByStringR
      -- * other types
    , Flag(..), Attribute(..), MailboxStatus(..)
    , SearchQuery(..), FlagsQuery(..)
    , A.AuthType(..)
    )
where

import Network.Socket (PortNumber)
import Network.Compat
import Network.HaskellNet.BSStream
import Network.HaskellNet.IMAP.Connection
import Network.HaskellNet.IMAP.Types
import Network.HaskellNet.IMAP.Parsers
import qualified Network.HaskellNet.Auth as A

import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS

import Control.Monad

import System.Time

import Data.Maybe
import Data.List hiding (delete)
import Data.Char

import Text.Packrat.Parse (Result)
import Control.Applicative -- support old toolchains
import Prelude

-- suffixed by `s'
data SearchQuery = ALLs
                 | FLAG Flag
                 | UNFLAG Flag
                 | BCCs String
                 | BEFOREs CalendarTime
                 | BODYs String
                 | CCs String
                 | FROMs String
                 | HEADERs String String
                 | LARGERs Integer
                 | NEWs
                 | NOTs SearchQuery
                 | OLDs
                 | ONs CalendarTime
                 | ORs SearchQuery SearchQuery
                 | SENTBEFOREs CalendarTime
                 | SENTONs CalendarTime
                 | SENTSINCEs CalendarTime
                 | SINCEs CalendarTime
                 | SMALLERs Integer
                 | SUBJECTs String
                 | TEXTs String
                 | TOs String
                 | XGMRAW String
                 | UIDs [UID]


instance Show SearchQuery where
    showsPrec :: Int -> SearchQuery -> ShowS
showsPrec Int
d SearchQuery
q = Bool -> ShowS -> ShowS
showParen (Int
dforall a. Ord a => a -> a -> Bool
>Int
app_prec) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString forall a b. (a -> b) -> a -> b
$ SearchQuery -> String
showQuery SearchQuery
q
        where app_prec :: Int
app_prec = Int
10
              showQuery :: SearchQuery -> String
showQuery SearchQuery
ALLs            = String
"ALL"
              showQuery (FLAG Flag
f)        = Flag -> String
showFlag Flag
f
              showQuery (UNFLAG Flag
f)      = String
"UN" forall a. [a] -> [a] -> [a]
++ Flag -> String
showFlag Flag
f
              showQuery (BCCs String
addr)     = String
"BCC " forall a. [a] -> [a] -> [a]
++ String
addr
              showQuery (BEFOREs CalendarTime
t)     = String
"BEFORE " forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
dateToStringIMAP CalendarTime
t
              showQuery (BODYs String
s)       = String
"BODY " forall a. [a] -> [a] -> [a]
++ String
s
              showQuery (CCs String
addr)      = String
"CC " forall a. [a] -> [a] -> [a]
++ String
addr
              showQuery (FROMs String
addr)    = String
"FROM " forall a. [a] -> [a] -> [a]
++ String
addr
              showQuery (HEADERs String
f String
v)   = String
"HEADER " forall a. [a] -> [a] -> [a]
++ String
f forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
v
              showQuery (LARGERs Integer
siz)   = String
"LARGER {" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
siz forall a. [a] -> [a] -> [a]
++ String
"}"
              showQuery SearchQuery
NEWs            = String
"NEW"
              showQuery (NOTs SearchQuery
qry)      = String
"NOT " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SearchQuery
qry
              showQuery SearchQuery
OLDs            = String
"OLD"
              showQuery (ONs CalendarTime
t)         = String
"ON " forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
dateToStringIMAP CalendarTime
t
              showQuery (ORs SearchQuery
q1 SearchQuery
q2)     = String
"OR " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SearchQuery
q1 forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SearchQuery
q2
              showQuery (SENTBEFOREs CalendarTime
t) = String
"SENTBEFORE " forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
dateToStringIMAP CalendarTime
t
              showQuery (SENTONs CalendarTime
t)     = String
"SENTON " forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
dateToStringIMAP CalendarTime
t
              showQuery (SENTSINCEs CalendarTime
t)  = String
"SENTSINCE " forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
dateToStringIMAP CalendarTime
t
              showQuery (SINCEs CalendarTime
t)      = String
"SINCE " forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
dateToStringIMAP CalendarTime
t
              showQuery (SMALLERs Integer
siz)  = String
"SMALLER {" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
siz forall a. [a] -> [a] -> [a]
++ String
"}"
              showQuery (SUBJECTs String
s)    = String
"SUBJECT " forall a. [a] -> [a] -> [a]
++ String
s
              showQuery (TEXTs String
s)       = String
"TEXT " forall a. [a] -> [a] -> [a]
++ String
s
              showQuery (TOs String
addr)      = String
"TO " forall a. [a] -> [a] -> [a]
++ String
addr
              showQuery (XGMRAW String
s)      = String
"X-GM-RAW " forall a. [a] -> [a] -> [a]
++ String
s
              showQuery (UIDs [UID]
uids)     = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse String
"," forall a b. (a -> b) -> a -> b
$
                                          forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [UID]
uids
              showFlag :: Flag -> String
showFlag Flag
Seen        = String
"SEEN"
              showFlag Flag
Answered    = String
"ANSWERED"
              showFlag Flag
Flagged     = String
"FLAGGED"
              showFlag Flag
Deleted     = String
"DELETED"
              showFlag Flag
Draft       = String
"DRAFT"
              showFlag Flag
Recent      = String
"RECENT"
              showFlag (Keyword String
s) = String
"KEYWORD " forall a. [a] -> [a] -> [a]
++ String
s

data FlagsQuery = ReplaceFlags [Flag]
                | PlusFlags [Flag]
                | MinusFlags [Flag]
                | ReplaceGmailLabels [GmailLabel]
                | PlusGmailLabels [GmailLabel]
                | MinusGmailLabels [GmailLabel]

----------------------------------------------------------------------
-- establish connection

connectIMAPPort :: String -> PortNumber -> IO IMAPConnection
connectIMAPPort :: String -> PortNumber -> IO IMAPConnection
connectIMAPPort String
hostname PortNumber
port =
    Handle -> BSStream
handleToStream forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> PortNumber -> IO Handle
connectTo String
hostname PortNumber
port
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BSStream -> IO IMAPConnection
connectStream

connectIMAP :: String -> IO IMAPConnection
connectIMAP :: String -> IO IMAPConnection
connectIMAP String
hostname = String -> PortNumber -> IO IMAPConnection
connectIMAPPort String
hostname PortNumber
143

connectStream :: BSStream -> IO IMAPConnection
connectStream :: BSStream -> IO IMAPConnection
connectStream BSStream
s =
    do ByteString
msg <- BSStream -> IO ByteString
bsGetLine BSStream
s
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a. (Char -> Char -> a) -> ByteString -> ByteString -> [a]
BS.zipWith forall a. Eq a => a -> a -> Bool
(==) ByteString
msg (String -> ByteString
BS.pack String
"* OK")) forall a b. (a -> b) -> a -> b
$
              forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot connect to the server"
       BSStream -> IO IMAPConnection
newConnection BSStream
s

----------------------------------------------------------------------
-- normal send commands
sendCommand' :: IMAPConnection -> String -> IO (ByteString, Int)
sendCommand' :: IMAPConnection -> String -> IO (ByteString, Int)
sendCommand' IMAPConnection
c String
cmdstr = do
  (()
_, Int
num) <- forall a. IMAPConnection -> (Int -> IO a) -> IO (a, Int)
withNextCommandNum IMAPConnection
c forall a b. (a -> b) -> a -> b
$ \Int
num -> BSStream -> ByteString -> IO ()
bsPutCrLf (IMAPConnection -> BSStream
stream IMAPConnection
c) forall a b. (a -> b) -> a -> b
$
              String -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ forall a. (Ord a, Num a, Show a) => a -> String
show6 Int
num forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
cmdstr
  ByteString
resp <- BSStream -> IO ByteString
getResponse (IMAPConnection -> BSStream
stream IMAPConnection
c)
  forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
resp, Int
num)

show6 :: (Ord a, Num a, Show a) => a -> String
show6 :: forall a. (Ord a, Num a, Show a) => a -> String
show6 a
n | a
n forall a. Ord a => a -> a -> Bool
> a
100000 = forall a. Show a => a -> String
show a
n
        | a
n forall a. Ord a => a -> a -> Bool
> a
10000  = Char
'0' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show a
n
        | a
n forall a. Ord a => a -> a -> Bool
> a
1000   = String
"00" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
n
        | a
n forall a. Ord a => a -> a -> Bool
> a
100    = String
"000" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
n
        | a
n forall a. Ord a => a -> a -> Bool
> a
10     = String
"0000" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
n
        | Bool
otherwise  = String
"00000" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
n

sendCommand :: IMAPConnection -> String
            -> (RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, v))
            -> IO v
sendCommand :: forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
imapc String
cmdstr RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, v)
pFunc =
    do (ByteString
buf, Int
num) <- IMAPConnection -> String -> IO (ByteString, Int)
sendCommand' IMAPConnection
imapc String
cmdstr
       let (ServerResponse
resp, MboxUpdate
mboxUp, v
value) = forall r.
(RespDerivs -> Result RespDerivs r) -> String -> ByteString -> r
eval RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, v)
pFunc (forall a. (Ord a, Num a, Show a) => a -> String
show6 Int
num) ByteString
buf
       case ServerResponse
resp of
         OK Maybe StatusCode
_ String
_        -> do IMAPConnection -> MboxUpdate -> IO ()
mboxUpdate IMAPConnection
imapc MboxUpdate
mboxUp
                             forall (m :: * -> *) a. Monad m => a -> m a
return v
value
         NO Maybe StatusCode
_ String
msg      -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"NO: " forall a. [a] -> [a] -> [a]
++ String
msg)
         BAD Maybe StatusCode
_ String
msg     -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"BAD: " forall a. [a] -> [a] -> [a]
++ String
msg)
         PREAUTH Maybe StatusCode
_ String
msg -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"preauth: " forall a. [a] -> [a] -> [a]
++ String
msg)

getResponse :: BSStream -> IO ByteString
getResponse :: BSStream -> IO ByteString
getResponse BSStream
s = [ByteString] -> ByteString
unlinesCRLF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ByteString]
getLs
    where unlinesCRLF :: [ByteString] -> ByteString
unlinesCRLF = [ByteString] -> ByteString
BS.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. a -> [a] -> [a]
:[ByteString
crlfStr])
          getLs :: IO [ByteString]
getLs =
              do ByteString
l <- ByteString -> ByteString
strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BSStream -> IO ByteString
bsGetLine BSStream
s
                 case () of
                   ()
_ | ByteString -> Bool
BS.null ByteString
l -> forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString
l]
                     | ByteString -> Bool
isLiteral ByteString
l ->  do ByteString
l' <- ByteString -> Int -> IO ByteString
getLiteral ByteString
l (ByteString -> Int
getLitLen ByteString
l)
                                          [ByteString]
ls <- IO [ByteString]
getLs
                                          forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
l' forall a. a -> [a] -> [a]
: [ByteString]
ls)
                     | ByteString -> Bool
isTagged ByteString
l -> (ByteString
lforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ByteString]
getLs
                     | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString
l]
          getLiteral :: ByteString -> Int -> IO ByteString
getLiteral ByteString
l Int
len =
              do ByteString
lit <- BSStream -> Int -> IO ByteString
bsGet BSStream
s Int
len
                 ByteString
l2 <- ByteString -> ByteString
strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BSStream -> IO ByteString
bsGetLine BSStream
s
                 let l' :: ByteString
l' = [ByteString] -> ByteString
BS.concat [ByteString
l, ByteString
crlfStr, ByteString
lit, ByteString
l2]
                 if ByteString -> Bool
isLiteral ByteString
l2
                   then ByteString -> Int -> IO ByteString
getLiteral ByteString
l' (ByteString -> Int
getLitLen ByteString
l2)
                   else forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
l'
          crlfStr :: ByteString
crlfStr = String -> ByteString
BS.pack String
"\r\n"
          isLiteral :: ByteString -> Bool
isLiteral ByteString
l = Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
l) Bool -> Bool -> Bool
&&
                        ByteString -> Char
BS.last ByteString
l forall a. Eq a => a -> a -> Bool
== Char
'}' Bool -> Bool -> Bool
&&
                        ByteString -> Char
BS.last (forall a b. (a, b) -> a
fst ((Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd Char -> Bool
isDigit (HasCallStack => ByteString -> ByteString
BS.init ByteString
l))) forall a. Eq a => a -> a -> Bool
== Char
'{'
          getLitLen :: ByteString -> Int
getLitLen = forall a. Read a => String -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd Char -> Bool
isDigit forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ByteString -> ByteString
BS.init
          isTagged :: ByteString -> Bool
isTagged ByteString
l = ByteString -> Char
BS.head ByteString
l forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
&& ByteString -> Char
BS.head (HasCallStack => ByteString -> ByteString
BS.tail ByteString
l) forall a. Eq a => a -> a -> Bool
== Char
' '

mboxUpdate :: IMAPConnection -> MboxUpdate -> IO ()
mboxUpdate :: IMAPConnection -> MboxUpdate -> IO ()
mboxUpdate IMAPConnection
conn (MboxUpdate Maybe Integer
exists' Maybe Integer
recent') = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe Integer
exists') forall a b. (a -> b) -> a -> b
$
       IMAPConnection -> (MailboxInfo -> MailboxInfo) -> IO ()
modifyMailboxInfo IMAPConnection
conn forall a b. (a -> b) -> a -> b
$ \MailboxInfo
mbox -> MailboxInfo
mbox { _exists :: Integer
_exists = forall a. HasCallStack => Maybe a -> a
fromJust Maybe Integer
exists' }

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe Integer
recent') forall a b. (a -> b) -> a -> b
$
       IMAPConnection -> (MailboxInfo -> MailboxInfo) -> IO ()
modifyMailboxInfo IMAPConnection
conn forall a b. (a -> b) -> a -> b
$ \MailboxInfo
mbox -> MailboxInfo
mbox { _recent :: Integer
_recent = forall a. HasCallStack => Maybe a -> a
fromJust Maybe Integer
recent' }

----------------------------------------------------------------------
-- IMAP commands
--

idle :: IMAPConnection -> Int -> IO ()
idle :: IMAPConnection -> Int -> IO ()
idle IMAPConnection
conn Int
timeout =
    do
        (ByteString
buf',Int
num) <- IMAPConnection -> String -> IO (ByteString, Int)
sendCommand' IMAPConnection
conn String
"IDLE"
        ByteString
buf <-
            if Int -> ByteString -> ByteString
BS.take Int
2 ByteString
buf' forall a. Eq a => a -> a -> Bool
== String -> ByteString
BS.pack String
"+ "
                then do
                    Bool
_ <- BSStream -> Int -> IO Bool
bsWaitForInput (IMAPConnection -> BSStream
stream IMAPConnection
conn) Int
timeout
                    BSStream -> ByteString -> IO ()
bsPutCrLf (IMAPConnection -> BSStream
stream IMAPConnection
conn) forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
"DONE"
                    BSStream -> IO ByteString
getResponse forall a b. (a -> b) -> a -> b
$ IMAPConnection -> BSStream
stream IMAPConnection
conn
                else
                    forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
buf'
        let (ServerResponse
resp, MboxUpdate
mboxUp, ()
value) = forall r.
(RespDerivs -> Result RespDerivs r) -> String -> ByteString -> r
eval RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone (forall a. (Ord a, Num a, Show a) => a -> String
show6 Int
num) ByteString
buf
        case ServerResponse
resp of
         OK Maybe StatusCode
_ String
_ -> do IMAPConnection -> MboxUpdate -> IO ()
mboxUpdate IMAPConnection
conn MboxUpdate
mboxUp
                      forall (m :: * -> *) a. Monad m => a -> m a
return ()
value
         NO Maybe StatusCode
_ String
msg -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"NO: " forall a. [a] -> [a] -> [a]
++ String
msg)
         BAD Maybe StatusCode
_ String
msg -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"BAD: " forall a. [a] -> [a] -> [a]
++ String
msg)
         PREAUTH Maybe StatusCode
_ String
msg -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"preauth: " forall a. [a] -> [a] -> [a]
++ String
msg)

noop :: IMAPConnection -> IO ()
noop :: IMAPConnection -> IO ()
noop IMAPConnection
conn = forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn String
"NOOP" RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone

capability :: IMAPConnection -> IO [String]
capability :: IMAPConnection -> IO [String]
capability IMAPConnection
conn = forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn String
"CAPABILITY" RespDerivs
-> Result RespDerivs (ServerResponse, MboxUpdate, [String])
pCapability

logout :: IMAPConnection -> IO ()
logout :: IMAPConnection -> IO ()
logout IMAPConnection
c = do BSStream -> ByteString -> IO ()
bsPutCrLf (IMAPConnection -> BSStream
stream IMAPConnection
c) forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
"a0001 LOGOUT"
              BSStream -> IO ()
bsClose (IMAPConnection -> BSStream
stream IMAPConnection
c)

login :: IMAPConnection -> A.UserName -> A.Password -> IO ()
login :: IMAPConnection -> String -> String -> IO ()
login IMAPConnection
conn String
username String
password = forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"LOGIN " forall a. [a] -> [a] -> [a]
++ (ShowS
escapeLogin String
username) forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ (ShowS
escapeLogin String
password))
                               RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone

authenticate :: IMAPConnection -> A.AuthType
             -> A.UserName -> A.Password -> IO ()
authenticate :: IMAPConnection -> AuthType -> String -> String -> IO ()
authenticate IMAPConnection
conn AuthType
A.LOGIN String
username String
password =
    do (ByteString
_, Int
num) <- IMAPConnection -> String -> IO (ByteString, Int)
sendCommand' IMAPConnection
conn String
"AUTHENTICATE LOGIN"
       BSStream -> ByteString -> IO ()
bsPutCrLf (IMAPConnection -> BSStream
stream IMAPConnection
conn) forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
userB64
       BSStream -> IO ByteString
bsGetLine (IMAPConnection -> BSStream
stream IMAPConnection
conn)
       BSStream -> ByteString -> IO ()
bsPutCrLf (IMAPConnection -> BSStream
stream IMAPConnection
conn) forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
passB64
       ByteString
buf <- BSStream -> IO ByteString
getResponse forall a b. (a -> b) -> a -> b
$ IMAPConnection -> BSStream
stream IMAPConnection
conn
       let (ServerResponse
resp, MboxUpdate
mboxUp, ()
value) = forall r.
(RespDerivs -> Result RespDerivs r) -> String -> ByteString -> r
eval RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone (forall a. (Ord a, Num a, Show a) => a -> String
show6 Int
num) ByteString
buf
       case ServerResponse
resp of
         OK Maybe StatusCode
_ String
_        -> do IMAPConnection -> MboxUpdate -> IO ()
mboxUpdate IMAPConnection
conn forall a b. (a -> b) -> a -> b
$ MboxUpdate
mboxUp
                             forall (m :: * -> *) a. Monad m => a -> m a
return ()
value
         NO Maybe StatusCode
_ String
msg      -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"NO: " forall a. [a] -> [a] -> [a]
++ String
msg)
         BAD Maybe StatusCode
_ String
msg     -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"BAD: " forall a. [a] -> [a] -> [a]
++ String
msg)
         PREAUTH Maybe StatusCode
_ String
msg -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"preauth: " forall a. [a] -> [a] -> [a]
++ String
msg)
    where (String
userB64, String
passB64) = String -> String -> (String, String)
A.login String
username String
password
authenticate IMAPConnection
conn AuthType
at String
username String
password =
    do (ByteString
c, Int
num) <- IMAPConnection -> String -> IO (ByteString, Int)
sendCommand' IMAPConnection
conn forall a b. (a -> b) -> a -> b
$ String
"AUTHENTICATE " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show AuthType
at
       let challenge :: String
challenge =
               if Int -> ByteString -> ByteString
BS.take Int
2 ByteString
c forall a. Eq a => a -> a -> Bool
== String -> ByteString
BS.pack String
"+ "
               then ShowS
A.b64Decode forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS.unpack forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$
                    forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Char
BS.last) forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BS.inits forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
c
               else String
""
       BSStream -> ByteString -> IO ()
bsPutCrLf (IMAPConnection -> BSStream
stream IMAPConnection
conn) forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$
                 AuthType -> String -> String -> ShowS
A.auth AuthType
at String
challenge String
username String
password
       ByteString
buf <- BSStream -> IO ByteString
getResponse forall a b. (a -> b) -> a -> b
$ IMAPConnection -> BSStream
stream IMAPConnection
conn
       let (ServerResponse
resp, MboxUpdate
mboxUp, ()
value) = forall r.
(RespDerivs -> Result RespDerivs r) -> String -> ByteString -> r
eval RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone (forall a. (Ord a, Num a, Show a) => a -> String
show6 Int
num) ByteString
buf
       case ServerResponse
resp of
         OK Maybe StatusCode
_ String
_        -> do IMAPConnection -> MboxUpdate -> IO ()
mboxUpdate IMAPConnection
conn forall a b. (a -> b) -> a -> b
$ MboxUpdate
mboxUp
                             forall (m :: * -> *) a. Monad m => a -> m a
return ()
value
         NO Maybe StatusCode
_ String
msg      -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"NO: " forall a. [a] -> [a] -> [a]
++ String
msg)
         BAD Maybe StatusCode
_ String
msg     -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"BAD: " forall a. [a] -> [a] -> [a]
++ String
msg)
         PREAUTH Maybe StatusCode
_ String
msg -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"preauth: " forall a. [a] -> [a] -> [a]
++ String
msg)

_select :: String -> IMAPConnection -> String -> IO ()
_select :: String -> IMAPConnection -> String -> IO ()
_select String
cmd IMAPConnection
conn String
mboxName =
    do MailboxInfo
mbox' <- forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
cmd forall a. [a] -> [a] -> [a]
++ ShowS
quoted String
mboxName) RespDerivs
-> Result RespDerivs (ServerResponse, MboxUpdate, MailboxInfo)
pSelect
       IMAPConnection -> MailboxInfo -> IO ()
setMailboxInfo IMAPConnection
conn forall a b. (a -> b) -> a -> b
$ MailboxInfo
mbox' { _mailbox :: String
_mailbox = String
mboxName }
    where
       quoted :: ShowS
quoted String
s = String
"\"" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"\""

select :: IMAPConnection -> MailboxName -> IO ()
select :: IMAPConnection -> String -> IO ()
select = String -> IMAPConnection -> String -> IO ()
_select String
"SELECT "

examine :: IMAPConnection -> MailboxName -> IO ()
examine :: IMAPConnection -> String -> IO ()
examine = String -> IMAPConnection -> String -> IO ()
_select String
"EXAMINE "

create :: IMAPConnection -> MailboxName -> IO ()
create :: IMAPConnection -> String -> IO ()
create IMAPConnection
conn String
mboxname = forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"CREATE " forall a. [a] -> [a] -> [a]
++ String
mboxname) RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone

delete :: IMAPConnection -> MailboxName -> IO ()
delete :: IMAPConnection -> String -> IO ()
delete IMAPConnection
conn String
mboxname = forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"DELETE " forall a. [a] -> [a] -> [a]
++ String
mboxname) RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone

rename :: IMAPConnection -> MailboxName -> MailboxName -> IO ()
rename :: IMAPConnection -> String -> String -> IO ()
rename IMAPConnection
conn String
mboxorg String
mboxnew =
    forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"RENAME " forall a. [a] -> [a] -> [a]
++ String
mboxorg forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
mboxnew) RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone

subscribe :: IMAPConnection -> MailboxName -> IO ()
subscribe :: IMAPConnection -> String -> IO ()
subscribe IMAPConnection
conn String
mboxname = forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"SUBSCRIBE " forall a. [a] -> [a] -> [a]
++ String
mboxname) RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone

unsubscribe :: IMAPConnection -> MailboxName -> IO ()
unsubscribe :: IMAPConnection -> String -> IO ()
unsubscribe IMAPConnection
conn String
mboxname = forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"UNSUBSCRIBE " forall a. [a] -> [a] -> [a]
++ String
mboxname) RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone

list :: IMAPConnection -> IO [([Attribute], MailboxName)]
list :: IMAPConnection -> IO [([Attribute], String)]
list IMAPConnection
conn = (forall a b. (a -> b) -> [a] -> [b]
map (\([Attribute]
a, String
_, String
m) -> ([Attribute]
a, String
m))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IMAPConnection
-> String -> String -> IO [([Attribute], String, String)]
listFull IMAPConnection
conn String
"\"\"" String
"*"

lsub :: IMAPConnection -> IO [([Attribute], MailboxName)]
lsub :: IMAPConnection -> IO [([Attribute], String)]
lsub IMAPConnection
conn = (forall a b. (a -> b) -> [a] -> [b]
map (\([Attribute]
a, String
_, String
m) -> ([Attribute]
a, String
m))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IMAPConnection
-> String -> String -> IO [([Attribute], String, String)]
lsubFull IMAPConnection
conn String
"\"\"" String
"*"

listFull :: IMAPConnection -> String -> String
         -> IO [([Attribute], String, MailboxName)]
listFull :: IMAPConnection
-> String -> String -> IO [([Attribute], String, String)]
listFull IMAPConnection
conn String
ref String
pat = forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn ([String] -> String
unwords [String
"LIST", String
ref, String
pat]) RespDerivs
-> Result
     RespDerivs
     (ServerResponse, MboxUpdate, [([Attribute], String, String)])
pList

lsubFull :: IMAPConnection -> String -> String
         -> IO [([Attribute], String, MailboxName)]
lsubFull :: IMAPConnection
-> String -> String -> IO [([Attribute], String, String)]
lsubFull IMAPConnection
conn String
ref String
pat = forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn ([String] -> String
unwords [String
"LSUB", String
ref, String
pat]) RespDerivs
-> Result
     RespDerivs
     (ServerResponse, MboxUpdate, [([Attribute], String, String)])
pLsub

status :: IMAPConnection -> MailboxName -> [MailboxStatus]
       -> IO [(MailboxStatus, Integer)]
status :: IMAPConnection
-> String -> [MailboxStatus] -> IO [(MailboxStatus, Integer)]
status IMAPConnection
conn String
mbox [MailboxStatus]
stats =
    let cmd :: String
cmd = String
"STATUS " forall a. [a] -> [a] -> [a]
++ String
mbox forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ ([String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [MailboxStatus]
stats) forall a. [a] -> [a] -> [a]
++ String
")"
    in forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn String
cmd RespDerivs
-> Result
     RespDerivs (ServerResponse, MboxUpdate, [(MailboxStatus, Integer)])
pStatus

append :: IMAPConnection -> MailboxName -> ByteString -> IO ()
append :: IMAPConnection -> String -> ByteString -> IO ()
append IMAPConnection
conn String
mbox ByteString
mailData = IMAPConnection
-> String
-> ByteString
-> Maybe [Flag]
-> Maybe CalendarTime
-> IO ()
appendFull IMAPConnection
conn String
mbox ByteString
mailData forall a. Maybe a
Nothing forall a. Maybe a
Nothing

appendFull :: IMAPConnection -> MailboxName -> ByteString
           -> Maybe [Flag] -> Maybe CalendarTime -> IO ()
appendFull :: IMAPConnection
-> String
-> ByteString
-> Maybe [Flag]
-> Maybe CalendarTime
-> IO ()
appendFull IMAPConnection
conn String
mbox ByteString
mailData Maybe [Flag]
flags' Maybe CalendarTime
time =
    do (ByteString
buf, Int
num) <- IMAPConnection -> String -> IO (ByteString, Int)
sendCommand' IMAPConnection
conn
                (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"APPEND ", String
mbox
                        , String
fstr, String
tstr, String
" {" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
len forall a. [a] -> [a] -> [a]
++ String
"}"])
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
BS.null ByteString
buf Bool -> Bool -> Bool
|| (ByteString -> Char
BS.head ByteString
buf forall a. Eq a => a -> a -> Bool
/= Char
'+')) forall a b. (a -> b) -> a -> b
$
              forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal server response"
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (BSStream -> ByteString -> IO ()
bsPutCrLf forall a b. (a -> b) -> a -> b
$ IMAPConnection -> BSStream
stream IMAPConnection
conn) [ByteString]
mailLines
       BSStream -> ByteString -> IO ()
bsPutCrLf (IMAPConnection -> BSStream
stream IMAPConnection
conn) ByteString
BS.empty
       ByteString
buf2 <- BSStream -> IO ByteString
getResponse forall a b. (a -> b) -> a -> b
$ IMAPConnection -> BSStream
stream IMAPConnection
conn
       let (ServerResponse
resp, MboxUpdate
mboxUp, ()) = forall r.
(RespDerivs -> Result RespDerivs r) -> String -> ByteString -> r
eval RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone (forall a. (Ord a, Num a, Show a) => a -> String
show6 Int
num) ByteString
buf2
       case ServerResponse
resp of
         OK Maybe StatusCode
_ String
_        -> IMAPConnection -> MboxUpdate -> IO ()
mboxUpdate IMAPConnection
conn MboxUpdate
mboxUp
         NO Maybe StatusCode
_ String
msg      -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"NO: "forall a. [a] -> [a] -> [a]
++String
msg)
         BAD Maybe StatusCode
_ String
msg     -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"BAD: "forall a. [a] -> [a] -> [a]
++String
msg)
         PREAUTH Maybe StatusCode
_ String
msg -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"PREAUTH: "forall a. [a] -> [a] -> [a]
++String
msg)
    where mailLines :: [ByteString]
mailLines = ByteString -> [ByteString]
BS.lines ByteString
mailData
          len :: Int
len       = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((Int
2forall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length) [ByteString]
mailLines
          tstr :: String
tstr      = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
" "forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> String
datetimeToStringIMAP) Maybe CalendarTime
time
          fstr :: String
fstr      = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
" ("forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++String
")") forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show) Maybe [Flag]
flags'

check :: IMAPConnection -> IO ()
check :: IMAPConnection -> IO ()
check IMAPConnection
conn = forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn String
"CHECK" RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone

close :: IMAPConnection -> IO ()
close :: IMAPConnection -> IO ()
close IMAPConnection
conn =
    do forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn String
"CLOSE" RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone
       IMAPConnection -> MailboxInfo -> IO ()
setMailboxInfo IMAPConnection
conn MailboxInfo
emptyMboxInfo

expunge :: IMAPConnection -> IO [Integer]
expunge :: IMAPConnection -> IO [Integer]
expunge IMAPConnection
conn = forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn String
"EXPUNGE" RespDerivs
-> Result RespDerivs (ServerResponse, MboxUpdate, [Integer])
pExpunge

search :: IMAPConnection -> [SearchQuery] -> IO [UID]
search :: IMAPConnection -> [SearchQuery] -> IO [UID]
search IMAPConnection
conn [SearchQuery]
queries = IMAPConnection -> String -> [SearchQuery] -> IO [UID]
searchCharset IMAPConnection
conn String
"" [SearchQuery]
queries

searchCharset :: IMAPConnection -> Charset -> [SearchQuery]
              -> IO [UID]
searchCharset :: IMAPConnection -> String -> [SearchQuery] -> IO [UID]
searchCharset IMAPConnection
conn String
charset [SearchQuery]
queries =
    forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"UID SEARCH "
                    forall a. [a] -> [a] -> [a]
++ (if Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ String
charset
                           then String
charset forall a. [a] -> [a] -> [a]
++ String
" "
                           else String
"")
                    forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [SearchQuery]
queries)) RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, [UID])
pSearch

fetch :: IMAPConnection -> UID -> IO ByteString
fetch :: IMAPConnection -> UID -> IO ByteString
fetch IMAPConnection
conn UID
uid =
    do [(String, String)]
lst <- IMAPConnection -> UID -> String -> IO [(String, String)]
fetchByString IMAPConnection
conn UID
uid String
"BODY[]"
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
BS.empty String -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ forall b. String -> [(String, b)] -> Maybe b
lookup' String
"BODY[]" [(String, String)]
lst

fetchHeader :: IMAPConnection -> UID -> IO ByteString
fetchHeader :: IMAPConnection -> UID -> IO ByteString
fetchHeader IMAPConnection
conn UID
uid =
    do [(String, String)]
lst <- IMAPConnection -> UID -> String -> IO [(String, String)]
fetchByString IMAPConnection
conn UID
uid String
"BODY[HEADER]"
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
BS.empty String -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ forall b. String -> [(String, b)] -> Maybe b
lookup' String
"BODY[HEADER]" [(String, String)]
lst

fetchSize :: IMAPConnection -> UID -> IO Int
fetchSize :: IMAPConnection -> UID -> IO Int
fetchSize IMAPConnection
conn UID
uid =
    do [(String, String)]
lst <- IMAPConnection -> UID -> String -> IO [(String, String)]
fetchByString IMAPConnection
conn UID
uid String
"RFC822.SIZE"
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"RFC822.SIZE" [(String, String)]
lst

fetchHeaderFields :: IMAPConnection
                  -> UID -> [String] -> IO ByteString
fetchHeaderFields :: IMAPConnection -> UID -> [String] -> IO ByteString
fetchHeaderFields IMAPConnection
conn UID
uid [String]
hs =
    do let fetchCmd :: String
fetchCmd = String
"BODY[HEADER.FIELDS ("forall a. [a] -> [a] -> [a]
++[String] -> String
unwords [String]
hsforall a. [a] -> [a] -> [a]
++String
")]"
       [(String, String)]
lst <- IMAPConnection -> UID -> String -> IO [(String, String)]
fetchByString IMAPConnection
conn UID
uid String
fetchCmd
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
BS.empty String -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ forall b. String -> [(String, b)] -> Maybe b
lookup' String
fetchCmd [(String, String)]
lst

fetchHeaderFieldsNot :: IMAPConnection
                     -> UID -> [String] -> IO ByteString
fetchHeaderFieldsNot :: IMAPConnection -> UID -> [String] -> IO ByteString
fetchHeaderFieldsNot IMAPConnection
conn UID
uid [String]
hs =
    do let fetchCmd :: String
fetchCmd = String
"BODY[HEADER.FIELDS.NOT ("forall a. [a] -> [a] -> [a]
++[String] -> String
unwords [String]
hsforall a. [a] -> [a] -> [a]
++String
")]"
       [(String, String)]
lst <- IMAPConnection -> UID -> String -> IO [(String, String)]
fetchByString IMAPConnection
conn UID
uid String
fetchCmd
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
BS.empty String -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ forall b. String -> [(String, b)] -> Maybe b
lookup' String
fetchCmd [(String, String)]
lst

fetchFlags :: IMAPConnection -> UID -> IO [Flag]
fetchFlags :: IMAPConnection -> UID -> IO [Flag]
fetchFlags IMAPConnection
conn UID
uid =
    do [(String, String)]
lst <- IMAPConnection -> UID -> String -> IO [(String, String)]
fetchByString IMAPConnection
conn UID
uid String
"FLAGS"
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe String -> [Flag]
getFlags forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"FLAGS" [(String, String)]
lst
    where getFlags :: Maybe String -> [Flag]
getFlags Maybe String
Nothing  = []
          getFlags (Just String
s) = forall r.
(RespDerivs -> Result RespDerivs r) -> String -> String -> r
eval' RespDerivs -> Result RespDerivs [Flag]
dvFlags String
"" String
s

fetchR :: IMAPConnection -> (UID, UID)
       -> IO [(UID, ByteString)]
fetchR :: IMAPConnection -> (UID, UID) -> IO [(UID, ByteString)]
fetchR IMAPConnection
conn (UID, UID)
r =
    do [(UID, [(String, String)])]
lst <- IMAPConnection
-> (UID, UID) -> String -> IO [(UID, [(String, String)])]
fetchByStringR IMAPConnection
conn (UID, UID)
r String
"BODY[]"
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(UID
uid, [(String, String)]
vs) -> (UID
uid, forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
BS.empty String -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$
                                       forall b. String -> [(String, b)] -> Maybe b
lookup' String
"BODY[]" [(String, String)]
vs)) [(UID, [(String, String)])]
lst
fetchByString :: IMAPConnection -> UID -> String
              -> IO [(String, String)]
fetchByString :: IMAPConnection -> UID -> String -> IO [(String, String)]
fetchByString IMAPConnection
conn UID
uid String
command =
    do [(Integer, [(String, String)])]
lst <- forall b.
IMAPConnection
-> String -> ((Integer, [(String, String)]) -> b) -> IO [b]
fetchCommand IMAPConnection
conn (String
"UID FETCH "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show UID
uidforall a. [a] -> [a] -> [a]
++String
" "forall a. [a] -> [a] -> [a]
++String
command) forall a. a -> a
id
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Integer, [(String, String)])]
lst

fetchByStringR :: IMAPConnection -> (UID, UID) -> String
               -> IO [(UID, [(String, String)])]
fetchByStringR :: IMAPConnection
-> (UID, UID) -> String -> IO [(UID, [(String, String)])]
fetchByStringR IMAPConnection
conn (UID
s, UID
e) String
command =
    forall b.
IMAPConnection
-> String -> ((Integer, [(String, String)]) -> b) -> IO [b]
fetchCommand IMAPConnection
conn (String
"UID FETCH "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show UID
sforall a. [a] -> [a] -> [a]
++String
":"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show UID
eforall a. [a] -> [a] -> [a]
++String
" "forall a. [a] -> [a] -> [a]
++String
command) forall {a} {a}.
(Integral a, Read a, Enum a) =>
(a, [(String, String)]) -> (a, [(String, String)])
proc
    where proc :: (a, [(String, String)]) -> (a, [(String, String)])
proc (a
n, [(String, String)]
ps) =
              (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)) forall a. Read a => String -> a
read (forall b. String -> [(String, b)] -> Maybe b
lookup' String
"UID" [(String, String)]
ps), [(String, String)]
ps)

fetchCommand :: IMAPConnection -> String
             -> ((Integer, [(String, String)]) -> b) -> IO [b]
fetchCommand :: forall b.
IMAPConnection
-> String -> ((Integer, [(String, String)]) -> b) -> IO [b]
fetchCommand IMAPConnection
conn String
command (Integer, [(String, String)]) -> b
proc =
    (forall a b. (a -> b) -> [a] -> [b]
map (Integer, [(String, String)]) -> b
proc) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn String
command RespDerivs
-> Result
     RespDerivs
     (ServerResponse, MboxUpdate, [(Integer, [(String, String)])])
pFetch

storeFull :: IMAPConnection -> String -> FlagsQuery -> Bool
          -> IO [(UID, [Flag])]
storeFull :: IMAPConnection
-> String -> FlagsQuery -> Bool -> IO [(UID, [Flag])]
storeFull IMAPConnection
conn String
uidstr FlagsQuery
query Bool
isSilent =
    forall b.
IMAPConnection
-> String -> ((Integer, [(String, String)]) -> b) -> IO [b]
fetchCommand IMAPConnection
conn (String
"UID STORE " forall a. [a] -> [a] -> [a]
++ String
uidstr forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ FlagsQuery -> String
flgs FlagsQuery
query) forall {a} {a}.
(Integral a, Read a, Enum a) =>
(a, [(String, String)]) -> (a, [Flag])
procStore
    where fstrs :: [a] -> String
fstrs [a]
fs = String
"(" forall a. [a] -> [a] -> [a]
++ (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse String
" " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [a]
fs) forall a. [a] -> [a] -> [a]
++ String
")"
          toFStr :: String -> ShowS
toFStr String
s String
fstrs' =
              String
s forall a. [a] -> [a] -> [a]
++ (if Bool
isSilent then String
".SILENT" else String
"") forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
fstrs'
          flgs :: FlagsQuery -> String
flgs (ReplaceGmailLabels [String]
ls) = String -> ShowS
toFStr String
"X-GM-LABELS" forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => [a] -> String
fstrs [String]
ls
          flgs (PlusGmailLabels [String]
ls)    = String -> ShowS
toFStr String
"+X-GM-LABELS" forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => [a] -> String
fstrs [String]
ls
          flgs (MinusGmailLabels [String]
ls)   = String -> ShowS
toFStr String
"-X-GM-LABELS" forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => [a] -> String
fstrs [String]
ls
          flgs (ReplaceFlags [Flag]
fs)       = String -> ShowS
toFStr String
"FLAGS" forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => [a] -> String
fstrs [Flag]
fs
          flgs (PlusFlags [Flag]
fs)          = String -> ShowS
toFStr String
"+FLAGS" forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => [a] -> String
fstrs [Flag]
fs
          flgs (MinusFlags [Flag]
fs)         = String -> ShowS
toFStr String
"-FLAGS" forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => [a] -> String
fstrs [Flag]
fs
          procStore :: (a, [(String, String)]) -> (a, [Flag])
procStore (a
n, [(String, String)]
ps) = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)) forall a. Read a => String -> a
read
                                         (forall b. String -> [(String, b)] -> Maybe b
lookup' String
"UID" [(String, String)]
ps)
                              ,forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall r.
(RespDerivs -> Result RespDerivs r) -> String -> String -> r
eval' RespDerivs -> Result RespDerivs [Flag]
dvFlags String
"") (forall b. String -> [(String, b)] -> Maybe b
lookup' String
"FLAG" [(String, String)]
ps))


store :: IMAPConnection -> UID -> FlagsQuery -> IO ()
store :: IMAPConnection -> UID -> FlagsQuery -> IO ()
store IMAPConnection
conn UID
i FlagsQuery
q = IMAPConnection
-> String -> FlagsQuery -> Bool -> IO [(UID, [Flag])]
storeFull IMAPConnection
conn (forall a. Show a => a -> String
show UID
i) FlagsQuery
q Bool
True forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

copyFull :: IMAPConnection -> String -> String -> IO ()
copyFull :: IMAPConnection -> String -> String -> IO ()
copyFull IMAPConnection
conn String
uidStr String
mbox =
    forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"UID COPY " forall a. [a] -> [a] -> [a]
++ String
uidStr forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
mbox) RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone

copy :: IMAPConnection -> UID -> MailboxName -> IO ()
copy :: IMAPConnection -> UID -> String -> IO ()
copy IMAPConnection
conn UID
uid String
mbox     = IMAPConnection -> String -> String -> IO ()
copyFull IMAPConnection
conn (forall a. Show a => a -> String
show UID
uid) String
mbox

----------------------------------------------------------------------
-- auxialiary functions

showMonth :: Month -> String
showMonth :: Month -> String
showMonth Month
January   = String
"Jan"
showMonth Month
February  = String
"Feb"
showMonth Month
March     = String
"Mar"
showMonth Month
April     = String
"Apr"
showMonth Month
May       = String
"May"
showMonth Month
June      = String
"Jun"
showMonth Month
July      = String
"Jul"
showMonth Month
August    = String
"Aug"
showMonth Month
September = String
"Sep"
showMonth Month
October   = String
"Oct"
showMonth Month
November  = String
"Nov"
showMonth Month
December  = String
"Dec"

show2 :: Int -> String
show2 :: Int -> String
show2 Int
n | Int
n forall a. Ord a => a -> a -> Bool
< Int
10    = Char
'0' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
n
        | Bool
otherwise = forall a. Show a => a -> String
show Int
n


show4 :: (Ord a, Num a, Show a) => a -> String
show4 :: forall a. (Ord a, Num a, Show a) => a -> String
show4 a
n | a
n forall a. Ord a => a -> a -> Bool
> a
1000 = forall a. Show a => a -> String
show a
n
        | a
n forall a. Ord a => a -> a -> Bool
> a
100  = Char
'0' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show a
n
        | a
n forall a. Ord a => a -> a -> Bool
> a
10   = String
"00" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
n
        | Bool
otherwise  = String
"000" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
n

dateToStringIMAP :: CalendarTime -> String
dateToStringIMAP :: CalendarTime -> String
dateToStringIMAP CalendarTime
date = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse String
"-" [Int -> String
show2 forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctDay CalendarTime
date
                                                 , Month -> String
showMonth forall a b. (a -> b) -> a -> b
$ CalendarTime -> Month
ctMonth CalendarTime
date
                                                 , forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctYear CalendarTime
date]
timeToStringIMAP :: CalendarTime -> String
timeToStringIMAP :: CalendarTime -> String
timeToStringIMAP CalendarTime
c = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                     forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse String
":"
                     forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> String
show2 [CalendarTime -> Int
ctHour CalendarTime
c, CalendarTime -> Int
ctMin CalendarTime
c, CalendarTime -> Int
ctSec CalendarTime
c]

-- Convert CalenarTime to "date-time" string per RFC3501
datetimeToStringIMAP :: CalendarTime -> String
datetimeToStringIMAP :: CalendarTime -> String
datetimeToStringIMAP CalendarTime
c =
  String
"\""
  forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
dateToStringIMAP CalendarTime
c
  forall a. [a] -> [a] -> [a]
++ String
" "
  forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
timeToStringIMAP CalendarTime
c
  forall a. [a] -> [a] -> [a]
++ String
" "
  forall a. [a] -> [a] -> [a]
++ forall {a}. (Show a, Integral a) => a -> String
zone (CalendarTime -> Int
ctTZ CalendarTime
c)
  forall a. [a] -> [a] -> [a]
++ String
"\""
  where
    zone :: a -> String
zone a
s =
      (if a
sforall a. Ord a => a -> a -> Bool
>=a
0 then String
"+" else String
"-") forall a. [a] -> [a] -> [a]
++
      forall a. (Ord a, Num a, Show a) => a -> String
show4 (a
s forall a. Integral a => a -> a -> a
`div` a
3600)

strip :: ByteString -> ByteString
strip :: ByteString -> ByteString
strip = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile Char -> Bool
isSpace

crlf :: BS.ByteString
crlf :: ByteString
crlf = String -> ByteString
BS.pack String
"\r\n"

bsPutCrLf :: BSStream -> ByteString -> IO ()
bsPutCrLf :: BSStream -> ByteString -> IO ()
bsPutCrLf BSStream
h ByteString
s = BSStream -> ByteString -> IO ()
bsPut BSStream
h ByteString
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BSStream -> ByteString -> IO ()
bsPut BSStream
h ByteString
crlf forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BSStream -> IO ()
bsFlush BSStream
h

lookup' :: String -> [(String, b)] -> Maybe b
lookup' :: forall b. String -> [(String, b)] -> Maybe b
lookup' String
_ [] = forall a. Maybe a
Nothing
lookup' String
q ((String
k,b
v):[(String, b)]
xs) | String
q forall a. Eq a => a -> a -> Bool
== ShowS
query String
k  = forall (m :: * -> *) a. Monad m => a -> m a
return b
v
                     | Bool
otherwise        = forall b. String -> [(String, b)] -> Maybe b
lookup' String
q [(String, b)]
xs
    where
        query :: ShowS
query = [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
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
--       It must be reviewed. References: rfc3501#6.2.3, rfc2683#3.4.2.
--       This function was tested against the password: `~1!2@3#4$5%6^7&8*9(0)-_=+[{]}\|;:'",<.>/? (with spaces in the laterals).
escapeLogin :: String -> String
escapeLogin :: ShowS
escapeLogin String
x = String
"\"" forall a. [a] -> [a] -> [a]
++ ShowS
replaceSpecialChars String
x forall a. [a] -> [a] -> [a]
++ String
"\""
    where
        replaceSpecialChars :: ShowS
replaceSpecialChars String
""     = String
""
        replaceSpecialChars (Char
c:String
cs) = Char -> String
escapeChar Char
c forall a. [a] -> [a] -> [a]
++ ShowS
replaceSpecialChars String
cs
        escapeChar :: Char -> String
escapeChar Char
'"' = String
"\\\""
        escapeChar Char
'\\' = String
"\\\\"
        escapeChar Char
'{' = String
"\\{"
        escapeChar Char
'}' = String
"\\}"
        escapeChar Char
s   = [Char
s]