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
      -- ** 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
                 | 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 (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]

----------------------------------------------------------------------
-- 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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return (ByteString
resp, Int
num)

show6 :: (Ord a, Num a, Show a) => a -> String
show6 :: 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 :: 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 (m :: * -> *) a. Monad m => a -> m a
return v
value
         NO Maybe StatusCode
_ String
msg      -> String -> IO v
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 (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 (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 (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 (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 (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 (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 (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
. 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 (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 :: Integer
_exists = Maybe Integer -> Integer
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Integer
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 :: Integer
_recent = Maybe Integer -> Integer
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' 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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()
value
         NO Maybe StatusCode
_ String
msg      -> String -> IO ()
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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()
value
         NO Maybe StatusCode
_ String
msg      -> String -> IO ()
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 (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 (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. [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 (m :: * -> *) a. Monad m => a -> m a
return ()
value
         NO Maybe StatusCode
_ String
msg      -> String -> IO ()
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 (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 (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 :: String
_mailbox = String
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 (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 (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 (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 (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 (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
forall a. Show a => a -> String
show) 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 (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 (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 (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 (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 b. String -> [(String, 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 [(String, String)]
lst <- IMAPConnection -> UID -> String -> IO [(String, String)]
fetchByString IMAPConnection
conn UID
uid (String
"BODY[HEADER.FIELDS "String -> ShowS
forall a. [a] -> [a] -> [a]
++[String] -> String
unwords [String]
hsString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"]")
       ByteString -> IO ByteString
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.FIELDS "String -> ShowS
forall a. [a] -> [a] -> [a]
++[String] -> String
unwords [String]
hsString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"]") [(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 (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 (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 b. String -> [(String, 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 (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
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 (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. [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 :: 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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
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

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

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
forall a. (Ord a, Num a, Show a) => a -> 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]
    where show2 :: a -> String
show2 a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10    = Char
'0' Char -> ShowS
forall a. a -> [a] -> [a]
: a -> String
forall a. Show a => a -> String
show a
n
                  | Bool
otherwise = a -> String
forall a. Show a => a -> String
show a
n
          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"

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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BSStream -> ByteString -> IO ()
bsPut BSStream
h ByteString
crlf IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BSStream -> IO ()
bsFlush BSStream
h

lookup' :: String -> [(String, b)] -> Maybe b
lookup' :: 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
lastWord String
k  = b -> Maybe b
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
        lastWord :: ShowS
lastWord = [String] -> String
forall a. [a] -> a
last ([String] -> String) -> (String -> [String]) -> ShowS
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]