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, move
    , idle
      -- * fetch commands
    , fetch, fetchHeader, fetchSize, fetchHeaderFields, fetchHeaderFieldsNot
    , fetchFlags, fetchR, fetchByString, fetchByStringR
    , fetchPeek, fetchRPeek
      -- * other types
    , Flag(..), Attribute(..), MailboxStatus(..)
    , SearchQuery(..), FlagsQuery(..)
    , A.AuthType(..)
    )
where

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

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
dInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString (String -> ShowS) -> String -> ShowS
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" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Flag -> String
showFlag Flag
f
              showQuery (BCCs String
addr)     = String
"BCC " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
addr
              showQuery (BEFOREs CalendarTime
t)     = String
"BEFORE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
dateToStringIMAP CalendarTime
t
              showQuery (BODYs String
s)       = String
"BODY " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
              showQuery (CCs String
addr)      = String
"CC " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
addr
              showQuery (FROMs String
addr)    = String
"FROM " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
addr
              showQuery (HEADERs String
f String
v)   = String
"HEADER " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
v
              showQuery (LARGERs Integer
siz)   = String
"LARGER {" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
siz String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
              showQuery SearchQuery
NEWs            = String
"NEW"
              showQuery (NOTs SearchQuery
qry)      = String
"NOT " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SearchQuery -> String
forall a. Show a => a -> String
show SearchQuery
qry
              showQuery SearchQuery
OLDs            = String
"OLD"
              showQuery (ONs CalendarTime
t)         = String
"ON " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
dateToStringIMAP CalendarTime
t
              showQuery (ORs SearchQuery
q1 SearchQuery
q2)     = String
"OR " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SearchQuery -> String
forall a. Show a => a -> String
show SearchQuery
q1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SearchQuery -> String
forall a. Show a => a -> String
show SearchQuery
q2
              showQuery (SENTBEFOREs CalendarTime
t) = String
"SENTBEFORE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
dateToStringIMAP CalendarTime
t
              showQuery (SENTONs CalendarTime
t)     = String
"SENTON " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
dateToStringIMAP CalendarTime
t
              showQuery (SENTSINCEs CalendarTime
t)  = String
"SENTSINCE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
dateToStringIMAP CalendarTime
t
              showQuery (SINCEs CalendarTime
t)      = String
"SINCE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
dateToStringIMAP CalendarTime
t
              showQuery (SMALLERs Integer
siz)  = String
"SMALLER {" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
siz String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
              showQuery (SUBJECTs String
s)    = String
"SUBJECT " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
              showQuery (TEXTs String
s)       = String
"TEXT " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
              showQuery (TOs String
addr)      = String
"TO " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
addr
              showQuery (XGMRAW String
s)      = String
"X-GM-RAW " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
              showQuery (UIDs [UID]
uids)     = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"," ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
                                          (UID -> String) -> [UID] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map UID -> String
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 " String -> ShowS
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 (Handle -> BSStream) -> IO Handle -> IO BSStream
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> PortNumber -> IO Handle
connectTo String
hostname PortNumber
port
    IO BSStream -> (BSStream -> IO IMAPConnection) -> IO IMAPConnection
forall a b. IO a -> (a -> IO b) -> IO b
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
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Char -> Bool) -> ByteString -> ByteString -> [Bool]
forall a. (Char -> Char -> a) -> ByteString -> ByteString -> [a]
BS.zipWith Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) ByteString
msg (String -> ByteString
BS.pack String
"* OK")) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              String -> IO ()
forall a. String -> IO a
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) <- IMAPConnection -> (Int -> IO ()) -> IO ((), Int)
forall a. IMAPConnection -> (Int -> IO a) -> IO (a, Int)
withNextCommandNum IMAPConnection
c ((Int -> IO ()) -> IO ((), Int)) -> (Int -> IO ()) -> IO ((), Int)
forall a b. (a -> b) -> a -> b
$ \Int
num -> BSStream -> ByteString -> IO ()
bsPutCrLf (IMAPConnection -> BSStream
stream IMAPConnection
c) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
              String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. (Ord a, Num a, Show a) => a -> String
show6 Int
num String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cmdstr
  ByteString
resp <- BSStream -> IO ByteString
getResponse (IMAPConnection -> BSStream
stream IMAPConnection
c)
  (ByteString, Int) -> IO (ByteString, Int)
forall a. a -> IO a
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
100000 = a -> String
forall a. Show a => a -> String
show a
n
        | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
10000  = Char
'0' Char -> ShowS
forall a. a -> [a] -> [a]
: a -> String
forall a. Show a => a -> String
show a
n
        | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1000   = String
"00" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n
        | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
100    = String
"000" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n
        | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
10     = String
"0000" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n
        | Bool
otherwise  = String
"00000" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
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) = (RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> String -> ByteString -> (ServerResponse, MboxUpdate, v)
forall r.
(RespDerivs -> Result RespDerivs r) -> String -> ByteString -> r
eval RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, v)
pFunc (Int -> String
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
                             v -> IO v
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return v
value
         NO Maybe StatusCode
_ String
msg      -> String -> IO v
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"NO: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)
         BAD Maybe StatusCode
_ String
msg     -> String -> IO v
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"BAD: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)
         PREAUTH Maybe StatusCode
_ String
msg -> String -> IO v
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"preauth: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)

getResponse :: BSStream -> IO ByteString
getResponse :: BSStream -> IO ByteString
getResponse BSStream
s = [ByteString] -> ByteString
unlinesCRLF ([ByteString] -> ByteString) -> IO [ByteString] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ByteString]
getLs
    where unlinesCRLF :: [ByteString] -> ByteString
unlinesCRLF = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString]) -> [ByteString] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString
crlfStr])
          getLs :: IO [ByteString]
getLs =
              do ByteString
l <- ByteString -> ByteString
strip (ByteString -> ByteString) -> IO ByteString -> IO ByteString
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 -> [ByteString] -> IO [ByteString]
forall a. a -> IO a
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
                                          [ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
l' ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
ls)
                     | ByteString -> Bool
isTagged ByteString
l -> (ByteString
lByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:) ([ByteString] -> [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ByteString]
getLs
                     | Bool
otherwise -> [ByteString] -> IO [ByteString]
forall a. a -> IO a
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 (ByteString -> ByteString) -> IO ByteString -> IO ByteString
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 ByteString -> IO ByteString
forall a. a -> IO a
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'}' Bool -> Bool -> Bool
&&
                        ByteString -> Char
BS.last ((ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd Char -> Bool
isDigit (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.init ByteString
l))) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{'
          getLitLen :: ByteString -> Int
getLitLen = String -> Int
forall a. Read a => String -> a
read (String -> Int) -> (ByteString -> String) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS.unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd Char -> Bool
isDigit (ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.init
          isTagged :: ByteString -> Bool
isTagged ByteString
l = ByteString -> Char
BS.head ByteString
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*' Bool -> Bool -> Bool
&& ByteString -> Char
BS.head (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.tail ByteString
l) Char -> Char -> Bool
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
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Integer -> Bool
forall a. Maybe a -> Bool
isJust Maybe Integer
exists') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       IMAPConnection -> (MailboxInfo -> MailboxInfo) -> IO ()
modifyMailboxInfo IMAPConnection
conn ((MailboxInfo -> MailboxInfo) -> IO ())
-> (MailboxInfo -> MailboxInfo) -> IO ()
forall a b. (a -> b) -> a -> b
$ \MailboxInfo
mbox -> MailboxInfo
mbox { _exists = fromJust exists' }

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Integer -> Bool
forall a. Maybe a -> Bool
isJust Maybe Integer
recent') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
       IMAPConnection -> (MailboxInfo -> MailboxInfo) -> IO ()
modifyMailboxInfo IMAPConnection
conn ((MailboxInfo -> MailboxInfo) -> IO ())
-> (MailboxInfo -> MailboxInfo) -> IO ()
forall a b. (a -> b) -> a -> b
$ \MailboxInfo
mbox -> MailboxInfo
mbox { _recent = fromJust 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' ByteString -> ByteString -> Bool
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) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
"DONE"
                    BSStream -> IO ByteString
getResponse (BSStream -> IO ByteString) -> BSStream -> IO ByteString
forall a b. (a -> b) -> a -> b
$ IMAPConnection -> BSStream
stream IMAPConnection
conn
                else
                    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
buf'
        let (ServerResponse
resp, MboxUpdate
mboxUp, ()
value) = (RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> String -> ByteString -> (ServerResponse, MboxUpdate, ())
forall r.
(RespDerivs -> Result RespDerivs r) -> String -> ByteString -> r
eval RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone (Int -> String
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
                      () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
value
         NO Maybe StatusCode
_ String
msg -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"NO: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)
         BAD Maybe StatusCode
_ String
msg -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"BAD: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)
         PREAUTH Maybe StatusCode
_ String
msg -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"preauth: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)

noop :: IMAPConnection -> IO ()
noop :: IMAPConnection -> IO ()
noop IMAPConnection
conn = IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> IO ()
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 = IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, [String]))
-> IO [String]
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) (ByteString -> IO ()) -> ByteString -> IO ()
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 = IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> IO ()
forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"LOGIN " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
escapeLogin String
username) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
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) (ByteString -> IO ()) -> ByteString -> IO ()
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) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
passB64
       ByteString
buf <- BSStream -> IO ByteString
getResponse (BSStream -> IO ByteString) -> BSStream -> IO ByteString
forall a b. (a -> b) -> a -> b
$ IMAPConnection -> BSStream
stream IMAPConnection
conn
       let (ServerResponse
resp, MboxUpdate
mboxUp, ()
value) = (RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> String -> ByteString -> (ServerResponse, MboxUpdate, ())
forall r.
(RespDerivs -> Result RespDerivs r) -> String -> ByteString -> r
eval RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone (Int -> String
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 -> IO ()) -> MboxUpdate -> IO ()
forall a b. (a -> b) -> a -> b
$ MboxUpdate
mboxUp
                             () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
value
         NO Maybe StatusCode
_ String
msg      -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"NO: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)
         BAD Maybe StatusCode
_ String
msg     -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"BAD: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)
         PREAUTH Maybe StatusCode
_ String
msg -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"preauth: " String -> ShowS
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 (String -> IO (ByteString, Int)) -> String -> IO (ByteString, Int)
forall a b. (a -> b) -> a -> b
$ String
"AUTHENTICATE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AuthType -> String
forall a. Show a => a -> String
show AuthType
at
       let challenge :: String
challenge =
               if Int -> ByteString -> ByteString
BS.take Int
2 ByteString
c ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BS.pack String
"+ "
               then ShowS
A.b64Decode ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. HasCallStack => [a] -> a
head ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
                    (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Bool
isSpace (Char -> Bool) -> (ByteString -> Char) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Char
BS.last) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BS.inits (ByteString -> [ByteString]) -> ByteString -> [ByteString]
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) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
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 (BSStream -> IO ByteString) -> BSStream -> IO ByteString
forall a b. (a -> b) -> a -> b
$ IMAPConnection -> BSStream
stream IMAPConnection
conn
       let (ServerResponse
resp, MboxUpdate
mboxUp, ()
value) = (RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> String -> ByteString -> (ServerResponse, MboxUpdate, ())
forall r.
(RespDerivs -> Result RespDerivs r) -> String -> ByteString -> r
eval RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone (Int -> String
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 -> IO ()) -> MboxUpdate -> IO ()
forall a b. (a -> b) -> a -> b
$ MboxUpdate
mboxUp
                             () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
value
         NO Maybe StatusCode
_ String
msg      -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"NO: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)
         BAD Maybe StatusCode
_ String
msg     -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"BAD: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)
         PREAUTH Maybe StatusCode
_ String
msg -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"preauth: " String -> ShowS
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' <- IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, MailboxInfo))
-> IO MailboxInfo
forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
cmd String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quoted String
mboxName) RespDerivs
-> Result RespDerivs (ServerResponse, MboxUpdate, MailboxInfo)
pSelect
       IMAPConnection -> MailboxInfo -> IO ()
setMailboxInfo IMAPConnection
conn (MailboxInfo -> IO ()) -> MailboxInfo -> IO ()
forall a b. (a -> b) -> a -> b
$ MailboxInfo
mbox' { _mailbox = mboxName }
    where
       quoted :: ShowS
quoted String
s = String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
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 = IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> IO ()
forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"CREATE " String -> ShowS
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 = IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> IO ()
forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"DELETE " String -> ShowS
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 =
    IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> IO ()
forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"RENAME " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mboxorg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
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 = IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> IO ()
forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"SUBSCRIBE " String -> ShowS
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 = IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> IO ()
forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"UNSUBSCRIBE " String -> ShowS
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 = ((([Attribute], String, String) -> ([Attribute], String))
-> [([Attribute], String, String)] -> [([Attribute], String)]
forall a b. (a -> b) -> [a] -> [b]
map (\([Attribute]
a, String
_, String
m) -> ([Attribute]
a, String
m))) ([([Attribute], String, String)] -> [([Attribute], String)])
-> IO [([Attribute], String, String)] -> IO [([Attribute], String)]
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 = ((([Attribute], String, String) -> ([Attribute], String))
-> [([Attribute], String, String)] -> [([Attribute], String)]
forall a b. (a -> b) -> [a] -> [b]
map (\([Attribute]
a, String
_, String
m) -> ([Attribute]
a, String
m))) ([([Attribute], String, String)] -> [([Attribute], String)])
-> IO [([Attribute], String, String)] -> IO [([Attribute], String)]
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 = IMAPConnection
-> String
-> (RespDerivs
    -> Result
         RespDerivs
         (ServerResponse, MboxUpdate, [([Attribute], String, String)]))
-> IO [([Attribute], String, String)]
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 = IMAPConnection
-> String
-> (RespDerivs
    -> Result
         RespDerivs
         (ServerResponse, MboxUpdate, [([Attribute], String, String)]))
-> IO [([Attribute], String, String)]
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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mbox String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (MailboxStatus -> String) -> [MailboxStatus] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map MailboxStatus -> String
forall a. Show a => a -> String
show [MailboxStatus]
stats) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    in IMAPConnection
-> String
-> (RespDerivs
    -> Result
         RespDerivs
         (ServerResponse, MboxUpdate, [(MailboxStatus, Integer)]))
-> IO [(MailboxStatus, Integer)]
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 Maybe [Flag]
forall a. Maybe a
Nothing Maybe CalendarTime
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
                ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"APPEND ", String
mbox
                        , String
fstr, String
tstr, String
" {" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"])
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
BS.null ByteString
buf Bool -> Bool -> Bool
|| (ByteString -> Char
BS.head ByteString
buf Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'+')) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal server response"
       (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (BSStream -> ByteString -> IO ()
bsPutCrLf (BSStream -> ByteString -> IO ())
-> BSStream -> ByteString -> IO ()
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 (BSStream -> IO ByteString) -> BSStream -> IO ByteString
forall a b. (a -> b) -> a -> b
$ IMAPConnection -> BSStream
stream IMAPConnection
conn
       let (ServerResponse
resp, MboxUpdate
mboxUp, ()) = (RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> String -> ByteString -> (ServerResponse, MboxUpdate, ())
forall r.
(RespDerivs -> Result RespDerivs r) -> String -> ByteString -> r
eval RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone (Int -> String
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      -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"NO: "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
msg)
         BAD Maybe StatusCode
_ String
msg     -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"BAD: "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
msg)
         PREAUTH Maybe StatusCode
_ String
msg -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"PREAUTH: "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
msg)
    where mailLines :: [ByteString]
mailLines = ByteString -> [ByteString]
BS.lines ByteString
mailData
          len :: Int
len       = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (ByteString -> Int) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length) [ByteString]
mailLines
          tstr :: String
tstr      = String -> (CalendarTime -> String) -> Maybe CalendarTime -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (CalendarTime -> String) -> CalendarTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> String
datetimeToStringIMAP) Maybe CalendarTime
time
          fstr :: String
fstr      = String -> ([Flag] -> String) -> Maybe [Flag] -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
" ("String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ([Flag] -> String) -> [Flag] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. [a] -> [a] -> [a]
++String
")") ShowS -> ([Flag] -> String) -> [Flag] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> ([Flag] -> [String]) -> [Flag] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Flag -> String) -> [Flag] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Flag -> String
forall a. Show a => a -> String
show) Maybe [Flag]
flags'

check :: IMAPConnection -> IO ()
check :: IMAPConnection -> IO ()
check IMAPConnection
conn = IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> IO ()
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 IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> IO ()
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 = IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, [Integer]))
-> IO [Integer]
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 =
    IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, [UID]))
-> IO [UID]
forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"UID SEARCH "
                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
charset
                           then String
charset String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
                           else String
"")
                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((SearchQuery -> String) -> [SearchQuery] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SearchQuery -> String
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[]"
       ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> (String -> ByteString) -> Maybe String -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
BS.empty String -> ByteString
BS.pack (Maybe String -> ByteString) -> Maybe String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall b. String -> [(String, b)] -> Maybe b
lookup' String
"BODY[]" [(String, String)]
lst

-- | Like 'fetch' but without marking the email as seen/read
fetchPeek :: IMAPConnection -> UID -> IO ByteString
fetchPeek :: IMAPConnection -> UID -> IO ByteString
fetchPeek IMAPConnection
conn UID
uid =
    do [(String, String)]
lst <- IMAPConnection -> UID -> String -> IO [(String, String)]
fetchByString IMAPConnection
conn UID
uid String
"BODY.PEEK[]"
       ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> (String -> ByteString) -> Maybe String -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
BS.empty String -> ByteString
BS.pack (Maybe String -> ByteString) -> Maybe String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
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]"
       ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> (String -> ByteString) -> Maybe String -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
BS.empty String -> ByteString
BS.pack (Maybe String -> ByteString) -> Maybe String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
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"
       Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int -> (String -> Int) -> Maybe String -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 String -> Int
forall a. Read a => String -> a
read (Maybe String -> Int) -> Maybe String -> Int
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
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 ("String -> ShowS
forall a. [a] -> [a] -> [a]
++[String] -> String
unwords [String]
hsString -> ShowS
forall a. [a] -> [a] -> [a]
++String
")]"
       [(String, String)]
lst <- IMAPConnection -> UID -> String -> IO [(String, String)]
fetchByString IMAPConnection
conn UID
uid String
fetchCmd
       ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> (String -> ByteString) -> Maybe String -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
BS.empty String -> ByteString
BS.pack (Maybe String -> ByteString) -> Maybe String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
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 ("String -> ShowS
forall a. [a] -> [a] -> [a]
++[String] -> String
unwords [String]
hsString -> ShowS
forall a. [a] -> [a] -> [a]
++String
")]"
       [(String, String)]
lst <- IMAPConnection -> UID -> String -> IO [(String, String)]
fetchByString IMAPConnection
conn UID
uid String
fetchCmd
       ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> (String -> ByteString) -> Maybe String -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
BS.empty String -> ByteString
BS.pack (Maybe String -> ByteString) -> Maybe String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
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"
       [Flag] -> IO [Flag]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Flag] -> IO [Flag]) -> [Flag] -> IO [Flag]
forall a b. (a -> b) -> a -> b
$ Maybe String -> [Flag]
getFlags (Maybe String -> [Flag]) -> Maybe String -> [Flag]
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
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) = (RespDerivs -> Result RespDerivs [Flag])
-> String -> String -> [Flag]
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[]"
       [(UID, ByteString)] -> IO [(UID, ByteString)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(UID, ByteString)] -> IO [(UID, ByteString)])
-> [(UID, ByteString)] -> IO [(UID, ByteString)]
forall a b. (a -> b) -> a -> b
$ ((UID, [(String, String)]) -> (UID, ByteString))
-> [(UID, [(String, String)])] -> [(UID, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\(UID
uid, [(String, String)]
vs) -> (UID
uid, ByteString -> (String -> ByteString) -> Maybe String -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
BS.empty String -> ByteString
BS.pack (Maybe String -> ByteString) -> Maybe String -> ByteString
forall a b. (a -> b) -> a -> b
$
                                       String -> [(String, String)] -> Maybe String
forall b. String -> [(String, b)] -> Maybe b
lookup' String
"BODY[]" [(String, String)]
vs)) [(UID, [(String, String)])]
lst

-- | Like 'fetchR' but without marking the email as seen/read
fetchRPeek :: IMAPConnection -> (UID, UID) -> IO [(UID, ByteString)]
fetchRPeek :: IMAPConnection -> (UID, UID) -> IO [(UID, ByteString)]
fetchRPeek IMAPConnection
conn (UID, UID)
range =
    do [(UID, [(String, String)])]
ls <- IMAPConnection
-> (UID, UID) -> String -> IO [(UID, [(String, String)])]
fetchByStringR IMAPConnection
conn (UID, UID)
range String
"BODY.PEEK[]"
       [(UID, ByteString)] -> IO [(UID, ByteString)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(UID, ByteString)] -> IO [(UID, ByteString)])
-> [(UID, ByteString)] -> IO [(UID, ByteString)]
forall a b. (a -> b) -> a -> b
$ ((UID, [(String, String)]) -> (UID, ByteString))
-> [(UID, [(String, String)])] -> [(UID, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\(UID
uid, [(String, String)]
vs) -> (UID
uid, ByteString -> (String -> ByteString) -> Maybe String -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
BS.empty String -> ByteString
BS.pack (Maybe String -> ByteString) -> Maybe String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall b. String -> [(String, b)] -> Maybe b
lookup' String
"BODY[]" [(String, String)]
vs)) [(UID, [(String, String)])]
ls

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 <- IMAPConnection
-> String
-> ((Integer, [(String, String)]) -> (Integer, [(String, String)]))
-> IO [(Integer, [(String, String)])]
forall b.
IMAPConnection
-> String -> ((Integer, [(String, String)]) -> b) -> IO [b]
fetchCommand IMAPConnection
conn (String
"UID FETCH "String -> ShowS
forall a. [a] -> [a] -> [a]
++UID -> String
forall a. Show a => a -> String
show UID
uidString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
command) (Integer, [(String, String)]) -> (Integer, [(String, String)])
forall a. a -> a
id
       [(String, String)] -> IO [(String, String)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, String)] -> IO [(String, String)])
-> [(String, String)] -> IO [(String, String)]
forall a b. (a -> b) -> a -> b
$ (Integer, [(String, String)]) -> [(String, String)]
forall a b. (a, b) -> b
snd ((Integer, [(String, String)]) -> [(String, String)])
-> (Integer, [(String, String)]) -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ [(Integer, [(String, String)])] -> (Integer, [(String, String)])
forall a. HasCallStack => [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 =
    IMAPConnection
-> String
-> ((Integer, [(String, String)]) -> (UID, [(String, String)]))
-> IO [(UID, [(String, String)])]
forall b.
IMAPConnection
-> String -> ((Integer, [(String, String)]) -> b) -> IO [b]
fetchCommand IMAPConnection
conn (String
"UID FETCH "String -> ShowS
forall a. [a] -> [a] -> [a]
++UID -> String
forall a. Show a => a -> String
show UID
sString -> ShowS
forall a. [a] -> [a] -> [a]
++String
":"String -> ShowS
forall a. [a] -> [a] -> [a]
++UID -> String
forall a. Show a => a -> String
show UID
eString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
command) (Integer, [(String, String)]) -> (UID, [(String, String)])
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) =
              (a -> (String -> a) -> Maybe String -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> a
forall a. Enum a => Int -> a
toEnum (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)) String -> a
forall a. Read a => String -> a
read (String -> [(String, String)] -> Maybe String
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 =
    (((Integer, [(String, String)]) -> b)
-> [(Integer, [(String, String)])] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, [(String, String)]) -> b
proc) ([(Integer, [(String, String)])] -> [b])
-> IO [(Integer, [(String, String)])] -> IO [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IMAPConnection
-> String
-> (RespDerivs
    -> Result
         RespDerivs
         (ServerResponse, MboxUpdate, [(Integer, [(String, String)])]))
-> IO [(Integer, [(String, String)])]
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 =
    IMAPConnection
-> String
-> ((Integer, [(String, String)]) -> (UID, [Flag]))
-> IO [(UID, [Flag])]
forall b.
IMAPConnection
-> String -> ((Integer, [(String, String)]) -> b) -> IO [b]
fetchCommand IMAPConnection
conn (String
"UID STORE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
uidstr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FlagsQuery -> String
flgs FlagsQuery
query) (Integer, [(String, String)]) -> (UID, [Flag])
forall {a} {a}.
(Integral a, Read a, Enum a) =>
(a, [(String, String)]) -> (a, [Flag])
procStore
    where fstrs :: [a] -> String
fstrs [a]
fs = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" " ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
fs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
          toFStr :: String -> ShowS
toFStr String
s String
fstrs' =
              String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Bool
isSilent then String
".SILENT" else String
"") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fstrs'
          flgs :: FlagsQuery -> String
flgs (ReplaceGmailLabels [String]
ls) = String -> ShowS
toFStr String
"X-GM-LABELS" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall {a}. Show a => [a] -> String
fstrs [String]
ls
          flgs (PlusGmailLabels [String]
ls)    = String -> ShowS
toFStr String
"+X-GM-LABELS" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall {a}. Show a => [a] -> String
fstrs [String]
ls
          flgs (MinusGmailLabels [String]
ls)   = String -> ShowS
toFStr String
"-X-GM-LABELS" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall {a}. Show a => [a] -> String
fstrs [String]
ls
          flgs (ReplaceFlags [Flag]
fs)       = String -> ShowS
toFStr String
"FLAGS" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Flag] -> String
forall {a}. Show a => [a] -> String
fstrs [Flag]
fs
          flgs (PlusFlags [Flag]
fs)          = String -> ShowS
toFStr String
"+FLAGS" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Flag] -> String
forall {a}. Show a => [a] -> String
fstrs [Flag]
fs
          flgs (MinusFlags [Flag]
fs)         = String -> ShowS
toFStr String
"-FLAGS" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Flag] -> String
forall {a}. Show a => [a] -> String
fstrs [Flag]
fs
          procStore :: (a, [(String, String)]) -> (a, [Flag])
procStore (a
n, [(String, String)]
ps) = (a -> (String -> a) -> Maybe String -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> a
forall a. Enum a => Int -> a
toEnum (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)) String -> a
forall a. Read a => String -> a
read
                                         (String -> [(String, String)] -> Maybe String
forall b. String -> [(String, b)] -> Maybe b
lookup' String
"UID" [(String, String)]
ps)
                              ,[Flag] -> (String -> [Flag]) -> Maybe String -> [Flag]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((RespDerivs -> Result RespDerivs [Flag])
-> String -> String -> [Flag]
forall r.
(RespDerivs -> Result RespDerivs r) -> String -> String -> r
eval' RespDerivs -> Result RespDerivs [Flag]
dvFlags String
"") (String -> [(String, String)] -> Maybe 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 (UID -> String
forall a. Show a => a -> String
show UID
i) FlagsQuery
q Bool
True IO [(UID, [Flag])] -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
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 =
    IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> IO ()
forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"UID COPY " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
uidStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
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 (UID -> String
forall a. Show a => a -> String
show UID
uid) String
mbox

move :: IMAPConnection -> UID -> MailboxName -> IO ()
move :: IMAPConnection -> UID -> String -> IO ()
move IMAPConnection
conn UID
uid String
mboxname = IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, ()))
-> IO ()
forall v.
IMAPConnection
-> String
-> (RespDerivs
    -> Result RespDerivs (ServerResponse, MboxUpdate, v))
-> IO v
sendCommand IMAPConnection
conn (String
"UID MOVE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UID -> String
forall a. Show a => a -> String
show UID
uid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mboxname) RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone

----------------------------------------------------------------------
-- 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10    = Char
'0' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
n
        | Bool
otherwise = Int -> String
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1000 = a -> String
forall a. Show a => a -> String
show a
n
        | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
100  = Char
'0' Char -> ShowS
forall a. a -> [a] -> [a]
: a -> String
forall a. Show a => a -> String
show a
n
        | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
10   = String
"00" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n
        | Bool
otherwise  = String
"000" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n

dateToStringIMAP :: CalendarTime -> String
dateToStringIMAP :: CalendarTime -> String
dateToStringIMAP CalendarTime
date = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"-" [Int -> String
show2 (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctDay CalendarTime
date
                                                 , Month -> String
showMonth (Month -> String) -> Month -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Month
ctMonth CalendarTime
date
                                                 , Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Int
ctYear CalendarTime
date]
timeToStringIMAP :: CalendarTime -> String
timeToStringIMAP :: CalendarTime -> String
timeToStringIMAP CalendarTime
c = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                     ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
":"
                     ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Int -> String) -> [Int] -> [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
"\""
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
dateToStringIMAP CalendarTime
c
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ CalendarTime -> String
timeToStringIMAP CalendarTime
c
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall {a}. (Show a, Integral a) => a -> String
zone (CalendarTime -> Int
ctTZ CalendarTime
c)
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
  where
    zone :: a -> String
zone a
s =
      (if a
sa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>=a
0 then String
"+" else String
"-") String -> ShowS
forall a. [a] -> [a] -> [a]
++
      a -> String
forall a. (Ord a, Num a, Show a) => a -> String
show4 (a
s a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
3600)

strip :: ByteString -> ByteString
strip :: ByteString -> ByteString
strip = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd Char -> Bool
isSpace (ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (ByteString, ByteString)
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 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BSStream -> ByteString -> IO ()
bsPut BSStream
h ByteString
crlf IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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
_ [] = Maybe b
forall a. Maybe a
Nothing
lookup' String
q ((String
k,b
v):[(String, b)]
xs) | String
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ShowS
query String
k  = b -> Maybe b
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return b
v
                     | Bool
otherwise        = String -> [(String, b)] -> Maybe b
forall b. String -> [(String, b)] -> Maybe b
lookup' String
q [(String, b)]
xs
    where
        query :: ShowS
query = [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
2 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
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
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
replaceSpecialChars String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
    where
        replaceSpecialChars :: ShowS
replaceSpecialChars String
""     = String
""
        replaceSpecialChars (Char
c:String
cs) = Char -> String
escapeChar Char
c String -> ShowS
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]