{-# LANGUAGE CPP #-}
module Network.HaskellNet.POP3
    ( -- * Establishing Connection
      connectPop3Port
    , connectPop3
    , connectStream
      -- * Send Command
    , sendCommand
      -- * More Specific Operations
    , closePop3
    , user
    , pass
    , userPass
    , apop
    , auth
    , stat
    , dele
    , retr
    , top
    , rset
    , allList
    , list
    , allUIDLs
    , uidl
      -- * Other Useful Operations
    , doPop3Port
    , doPop3
    , doPop3Stream
      -- * Other types
    , A.AuthType(..)
    )
    where

import Network.HaskellNet.BSStream
import Network.Socket
import Network.Compat
import qualified Network.HaskellNet.Auth as A

import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BS
import Crypto.Hash.MD5
import Numeric (showHex)

import Control.Applicative
import Control.Exception
import Control.Monad (when, unless)

import Data.List
import Data.Char (isSpace, isControl)

import System.IO

import Prelude

import Network.HaskellNet.POP3.Types
import Network.HaskellNet.POP3.Connection

hexDigest :: [Char] -> [Char]
hexDigest :: [Char] -> [Char]
hexDigest = (Word8 -> [Char]) -> [Word8] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Word8 -> [Char] -> [Char]) -> [Char] -> Word8 -> [Char]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word8 -> [Char] -> [Char]
forall a. (Integral a, Show a) => a -> [Char] -> [Char]
showHex [Char]
"") ([Word8] -> [Char]) -> ([Char] -> [Word8]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack (ByteString -> [Word8])
-> ([Char] -> ByteString) -> [Char] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hash (ByteString -> ByteString)
-> ([Char] -> ByteString) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> ([Char] -> [Word8]) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> [Char] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a. Enum a => Int -> a
toEnum(Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Int
forall a. Enum a => a -> Int
fromEnum)

blank :: Char -> Bool
blank :: Char -> Bool
blank Char
a = Char -> Bool
isSpace Char
a Bool -> Bool -> Bool
|| Char -> Bool
isControl Char
a

trimR :: ByteString -> ByteString
trimR :: ByteString -> ByteString
trimR ByteString
s = let rs :: ByteString
rs = ByteString -> ByteString
BS.reverse ByteString
s in
        (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile Char -> Bool
blank ByteString
rs

strip :: ByteString -> ByteString
strip :: ByteString -> ByteString
strip = ByteString -> ByteString
trimR (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
trimR

stripEnd :: ByteString -> ByteString
stripEnd :: ByteString -> ByteString
stripEnd = ByteString -> ByteString
BS.reverse (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
trimR

-- | connecting to the pop3 server specified by the hostname and port
-- number
connectPop3Port :: String -> PortNumber -> IO POP3Connection
connectPop3Port :: [Char] -> PortNumber -> IO POP3Connection
connectPop3Port [Char]
hostname PortNumber
port =
    Handle -> BSStream
handleToStream (Handle -> BSStream) -> IO Handle -> IO BSStream
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> PortNumber -> IO Handle
connectTo [Char]
hostname PortNumber
port)
    IO BSStream -> (BSStream -> IO POP3Connection) -> IO POP3Connection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BSStream -> IO POP3Connection
connectStream

-- | connecting to the pop3 server specified by the hostname. 110 is
-- used for the port number.
connectPop3 :: String -> IO POP3Connection
connectPop3 :: [Char] -> IO POP3Connection
connectPop3 = ([Char] -> PortNumber -> IO POP3Connection)
-> PortNumber -> [Char] -> IO POP3Connection
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> PortNumber -> IO POP3Connection
connectPop3Port PortNumber
110

-- | connecting to the pop3 server via a stream
connectStream :: BSStream -> IO POP3Connection
connectStream :: BSStream -> IO POP3Connection
connectStream BSStream
st =
    do (Response
resp, ByteString
msg) <- BSStream -> IO (Response, ByteString)
response BSStream
st
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response
resp Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
Err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot connect"
       let code :: ByteString
code = [ByteString] -> ByteString
forall a. [a] -> a
last ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BS.words ByteString
msg
       if ByteString -> Char
BS.head ByteString
code Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<' Bool -> Bool -> Bool
&& ByteString -> Char
BS.last ByteString
code Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'>'
         then POP3Connection -> IO POP3Connection
forall (m :: * -> *) a. Monad m => a -> m a
return (POP3Connection -> IO POP3Connection)
-> POP3Connection -> IO POP3Connection
forall a b. (a -> b) -> a -> b
$ BSStream -> [Char] -> POP3Connection
newConnection BSStream
st (ByteString -> [Char]
BS.unpack ByteString
code)
         else POP3Connection -> IO POP3Connection
forall (m :: * -> *) a. Monad m => a -> m a
return (POP3Connection -> IO POP3Connection)
-> POP3Connection -> IO POP3Connection
forall a b. (a -> b) -> a -> b
$ BSStream -> [Char] -> POP3Connection
newConnection BSStream
st [Char]
""

response :: BSStream -> IO (Response, ByteString)
response :: BSStream -> IO (Response, ByteString)
response BSStream
st =
    do ByteString
reply <- 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
st
       if ([Char] -> ByteString
BS.pack [Char]
"+OK") ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
reply
         then (Response, ByteString) -> IO (Response, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response
Ok, Int -> ByteString -> ByteString
BS.drop Int
4 ByteString
reply)
         else (Response, ByteString) -> IO (Response, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response
Err, Int -> ByteString -> ByteString
BS.drop Int
5 ByteString
reply)

-- | parse mutiline of response
responseML :: POP3Connection -> IO (Response, ByteString)
responseML :: POP3Connection -> IO (Response, ByteString)
responseML POP3Connection
conn =
    do ByteString
reply <- 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
st
       if ([Char] -> ByteString
BS.pack [Char]
"+OK") ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
reply
         then do [ByteString]
rest <- IO [ByteString]
getRest
                 (Response, ByteString) -> IO (Response, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response
Ok, [ByteString] -> ByteString
BS.unlines (Int -> ByteString -> ByteString
BS.drop Int
4 ByteString
reply ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
rest))
         else (Response, ByteString) -> IO (Response, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response
Err, Int -> ByteString -> ByteString
BS.drop Int
5 ByteString
reply)
    where st :: BSStream
st = POP3Connection -> BSStream
stream POP3Connection
conn
          getRest :: IO [ByteString]
getRest = do ByteString
l <- ByteString -> ByteString
stripEnd (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BSStream -> IO ByteString
bsGetLine BSStream
st
                       if ByteString
l ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> ByteString
BS.singleton Char
'.'
                         then [ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                         else (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]
getRest

-- | sendCommand sends a pop3 command via a pop3 connection.  This
-- action is too generic. Use more specific actions
sendCommand :: POP3Connection -> Command -> IO (Response, ByteString)
sendCommand :: POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
conn (LIST Maybe Int
Nothing) =
    BSStream -> ByteString -> IO ()
bsPutCrLf (POP3Connection -> BSStream
stream POP3Connection
conn) ([Char] -> ByteString
BS.pack [Char]
"LIST") IO () -> IO (Response, ByteString) -> IO (Response, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> POP3Connection -> IO (Response, ByteString)
responseML POP3Connection
conn
sendCommand POP3Connection
conn (UIDL Maybe Int
Nothing) =
    BSStream -> ByteString -> IO ()
bsPutCrLf (POP3Connection -> BSStream
stream POP3Connection
conn) ([Char] -> ByteString
BS.pack [Char]
"UIDL") IO () -> IO (Response, ByteString) -> IO (Response, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> POP3Connection -> IO (Response, ByteString)
responseML POP3Connection
conn
sendCommand POP3Connection
conn (RETR Int
msg) =
    BSStream -> ByteString -> IO ()
bsPutCrLf (POP3Connection -> BSStream
stream POP3Connection
conn) ([Char] -> ByteString
BS.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"RETR " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
msg) IO () -> IO (Response, ByteString) -> IO (Response, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> POP3Connection -> IO (Response, ByteString)
responseML POP3Connection
conn
sendCommand POP3Connection
conn (TOP Int
msg Int
n) =
    BSStream -> ByteString -> IO ()
bsPutCrLf (POP3Connection -> BSStream
stream POP3Connection
conn) ([Char] -> ByteString
BS.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"TOP " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n) IO () -> IO (Response, ByteString) -> IO (Response, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    POP3Connection -> IO (Response, ByteString)
responseML POP3Connection
conn
sendCommand POP3Connection
conn (AUTH AuthType
A.LOGIN [Char]
username [Char]
password) =
    do BSStream -> ByteString -> IO ()
bsPutCrLf (POP3Connection -> BSStream
stream POP3Connection
conn) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
BS.pack [Char]
"AUTH LOGIN"
       BSStream -> IO ByteString
bsGetLine (POP3Connection -> BSStream
stream POP3Connection
conn)
       BSStream -> ByteString -> IO ()
bsPutCrLf (POP3Connection -> BSStream
stream POP3Connection
conn) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
BS.pack [Char]
userB64
       BSStream -> IO ByteString
bsGetLine (POP3Connection -> BSStream
stream POP3Connection
conn)
       BSStream -> ByteString -> IO ()
bsPutCrLf (POP3Connection -> BSStream
stream POP3Connection
conn) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
BS.pack [Char]
passB64
       BSStream -> IO (Response, ByteString)
response (POP3Connection -> BSStream
stream POP3Connection
conn)
    where ([Char]
userB64, [Char]
passB64) = [Char] -> [Char] -> ([Char], [Char])
A.login [Char]
username [Char]
password
sendCommand POP3Connection
conn (AUTH AuthType
at [Char]
username [Char]
password) =
    do BSStream -> ByteString -> IO ()
bsPutCrLf (POP3Connection -> BSStream
stream POP3Connection
conn) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
BS.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"AUTH", AuthType -> [Char]
forall a. Show a => a -> [Char]
show AuthType
at]
       ByteString
c <- BSStream -> IO ByteString
bsGetLine (POP3Connection -> BSStream
stream POP3Connection
conn)
       let challenge :: [Char]
challenge =
               if Int -> ByteString -> ByteString
BS.take Int
2 ByteString
c ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> ByteString
BS.pack [Char]
"+ "
               then [Char] -> [Char]
A.b64Decode ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
BS.unpack (ByteString -> [Char]) -> ByteString -> [Char]
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 [Char]
""
       BSStream -> ByteString -> IO ()
bsPutCrLf (POP3Connection -> BSStream
stream POP3Connection
conn) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
BS.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthType -> [Char] -> [Char] -> [Char] -> [Char]
A.auth AuthType
at [Char]
challenge [Char]
username [Char]
password
       BSStream -> IO (Response, ByteString)
response (POP3Connection -> BSStream
stream POP3Connection
conn)
sendCommand POP3Connection
conn Command
command =
    BSStream -> ByteString -> IO ()
bsPutCrLf (POP3Connection -> BSStream
stream POP3Connection
conn) ([Char] -> ByteString
BS.pack [Char]
commandStr) IO () -> IO (Response, ByteString) -> IO (Response, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BSStream -> IO (Response, ByteString)
response (POP3Connection -> BSStream
stream POP3Connection
conn)
    where commandStr :: [Char]
commandStr = case Command
command of
                         (USER [Char]
name)  -> [Char]
"USER " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name
                         (PASS [Char]
passw) -> [Char]
"PASS " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
passw
                         Command
NOOP         -> [Char]
"NOOP"
                         Command
QUIT         -> [Char]
"QUIT"
                         Command
STAT         -> [Char]
"STAT"
                         (DELE Int
msg)   -> [Char]
"DELE " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
msg
                         Command
RSET         -> [Char]
"RSET"
                         (LIST Maybe Int
msg)   -> [Char]
"LIST " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> (Int -> [Char]) -> Maybe Int -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" Int -> [Char]
forall a. Show a => a -> [Char]
show Maybe Int
msg
                         (UIDL Maybe Int
msg)   -> [Char]
"UIDL " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> (Int -> [Char]) -> Maybe Int -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" Int -> [Char]
forall a. Show a => a -> [Char]
show Maybe Int
msg
                         (APOP [Char]
usern [Char]
passw) -> [Char]
"APOP " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
usern [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                             [Char] -> [Char]
hexDigest (POP3Connection -> [Char]
apopKey POP3Connection
conn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
passw)
                         (AUTH AuthType
_ [Char]
_ [Char]
_) -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: AUTH should not get matched here"
                         (RETR Int
_) -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: RETR should not get matched here"
                         (TOP Int
_ Int
_) -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"BUG: TOP should not get matched here"

user :: POP3Connection -> String -> IO ()
user :: POP3Connection -> [Char] -> IO ()
user POP3Connection
conn [Char]
name = do (Response
resp, ByteString
_) <- POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
conn ([Char] -> Command
USER [Char]
name)
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response
resp Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
Err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot send user name"

pass :: POP3Connection -> String -> IO ()
pass :: POP3Connection -> [Char] -> IO ()
pass POP3Connection
conn [Char]
pwd = do (Response
resp, ByteString
_) <- POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
conn ([Char] -> Command
PASS [Char]
pwd)
                   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response
resp Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
Err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot send password"

userPass :: POP3Connection -> A.UserName -> A.Password -> IO ()
userPass :: POP3Connection -> [Char] -> [Char] -> IO ()
userPass POP3Connection
conn [Char]
name [Char]
pwd = POP3Connection -> [Char] -> IO ()
user POP3Connection
conn [Char]
name IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> POP3Connection -> [Char] -> IO ()
pass POP3Connection
conn [Char]
pwd

auth :: POP3Connection -> A.AuthType -> A.UserName -> A.Password
     -> IO ()
auth :: POP3Connection -> AuthType -> [Char] -> [Char] -> IO ()
auth POP3Connection
conn AuthType
at [Char]
username [Char]
password =
    do (Response
resp, ByteString
msg) <- POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
conn (AuthType -> [Char] -> [Char] -> Command
AUTH AuthType
at [Char]
username [Char]
password)
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Response
resp Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
Ok) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"authentication failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BS.unpack ByteString
msg

apop :: POP3Connection -> String -> String -> IO ()
apop :: POP3Connection -> [Char] -> [Char] -> IO ()
apop POP3Connection
conn [Char]
name [Char]
pwd =
    do (Response
resp, ByteString
msg) <- POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
conn ([Char] -> [Char] -> Command
APOP [Char]
name [Char]
pwd)
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response
resp Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
Err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"authentication failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BS.unpack ByteString
msg

stat :: POP3Connection -> IO (Int, Int)
stat :: POP3Connection -> IO (Int, Int)
stat POP3Connection
conn = do (Response
resp, ByteString
msg) <- POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
conn Command
STAT
               Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response
resp Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
Err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot get stat info"
               let (ByteString
nn, ByteString
mm) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') ByteString
msg
               (Int, Int) -> IO (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
BS.unpack ByteString
nn, [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
BS.unpack (ByteString -> [Char]) -> ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.tail ByteString
mm)

dele :: POP3Connection -> Int -> IO ()
dele :: POP3Connection -> Int -> IO ()
dele POP3Connection
conn Int
n = do (Response
resp, ByteString
_) <- POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
conn (Int -> Command
DELE Int
n)
                 Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response
resp Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
Err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot delete"

retr :: POP3Connection -> Int -> IO ByteString
retr :: POP3Connection -> Int -> IO ByteString
retr POP3Connection
conn Int
n = do (Response
resp, ByteString
msg) <- POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
conn (Int -> Command
RETR Int
n)
                 Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response
resp Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
Err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot retrieve"
                 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 -> ByteString
BS.tail (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n') ByteString
msg

top :: POP3Connection -> Int -> Int -> IO ByteString
top :: POP3Connection -> Int -> Int -> IO ByteString
top POP3Connection
conn Int
n Int
m = do (Response
resp, ByteString
msg) <- POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
conn (Int -> Int -> Command
TOP Int
n Int
m)
                  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response
resp Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
Err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot retrieve"
                  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 -> ByteString
BS.tail (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n') ByteString
msg

rset :: POP3Connection -> IO ()
rset :: POP3Connection -> IO ()
rset POP3Connection
conn = do (Response
resp, ByteString
_) <- POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
conn Command
RSET
               Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response
resp Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
Err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot reset"

allList :: POP3Connection -> IO [(Int, Int)]
allList :: POP3Connection -> IO [(Int, Int)]
allList POP3Connection
conn = do (Response
resp, ByteString
lst) <- POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
conn (Maybe Int -> Command
LIST Maybe Int
forall a. Maybe a
Nothing)
                  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response
resp Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
Err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot retrieve the list"
                  [(Int, Int)] -> IO [(Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, Int)] -> IO [(Int, Int)])
-> [(Int, Int)] -> IO [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ (ByteString -> (Int, Int)) -> [ByteString] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> (Int, Int)
forall a b. (Read a, Read b) => ByteString -> (a, b)
f ([ByteString] -> [(Int, Int)]) -> [ByteString] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
tail ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BS.lines ByteString
lst
    where f :: ByteString -> (a, b)
f ByteString
s = let (ByteString
n1, ByteString
n2) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') ByteString
s
                in ([Char] -> a
forall a. Read a => [Char] -> a
read ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
BS.unpack ByteString
n1, [Char] -> b
forall a. Read a => [Char] -> a
read ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
BS.unpack (ByteString -> [Char]) -> ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.tail ByteString
n2)

list :: POP3Connection -> Int -> IO Int
list :: POP3Connection -> Int -> IO Int
list POP3Connection
conn Int
n = do (Response
resp, ByteString
lst) <- POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
conn (Maybe Int -> Command
LIST (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n))
                 Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response
resp Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
Err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot retrieve the list"
                 let (ByteString
_, ByteString
n2) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') ByteString
lst
                 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
$ [Char] -> Int
forall a. Read a => [Char] -> a
read ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
BS.unpack (ByteString -> [Char]) -> ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.tail ByteString
n2

allUIDLs :: POP3Connection -> IO [(Int, ByteString)]
allUIDLs :: POP3Connection -> IO [(Int, ByteString)]
allUIDLs POP3Connection
conn = do (Response
resp, ByteString
lst) <- POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
conn (Maybe Int -> Command
UIDL Maybe Int
forall a. Maybe a
Nothing)
                   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response
resp Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
Err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot retrieve the uidl list"
                   [(Int, ByteString)] -> IO [(Int, ByteString)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, ByteString)] -> IO [(Int, ByteString)])
-> [(Int, ByteString)] -> IO [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ (ByteString -> (Int, ByteString))
-> [ByteString] -> [(Int, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> (Int, ByteString)
forall a. Read a => ByteString -> (a, ByteString)
f ([ByteString] -> [(Int, ByteString)])
-> [ByteString] -> [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
tail ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BS.lines ByteString
lst
    where f :: ByteString -> (a, ByteString)
f ByteString
s = let (ByteString
n1, ByteString
n2) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') ByteString
s in ([Char] -> a
forall a. Read a => [Char] -> a
read ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
BS.unpack ByteString
n1, ByteString
n2)

uidl :: POP3Connection -> Int -> IO ByteString
uidl :: POP3Connection -> Int -> IO ByteString
uidl POP3Connection
conn Int
n = do (Response
resp, ByteString
msg) <- POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
conn (Maybe Int -> Command
UIDL (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n))
                 Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response
resp Response -> Response -> Bool
forall a. Eq a => a -> a -> Bool
== Response
Err) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"cannot retrieve the uidl data"
                 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 -> ByteString
BS.tail (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') ByteString
msg

closePop3 :: POP3Connection -> IO ()
closePop3 :: POP3Connection -> IO ()
closePop3 POP3Connection
c = do POP3Connection -> Command -> IO (Response, ByteString)
sendCommand POP3Connection
c Command
QUIT
                 BSStream -> IO ()
bsClose (POP3Connection -> BSStream
stream POP3Connection
c)

doPop3Port :: String -> PortNumber -> (POP3Connection -> IO a) -> IO a
doPop3Port :: [Char] -> PortNumber -> (POP3Connection -> IO a) -> IO a
doPop3Port [Char]
host PortNumber
port POP3Connection -> IO a
execution =
    IO POP3Connection
-> (POP3Connection -> IO ()) -> (POP3Connection -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket ([Char] -> PortNumber -> IO POP3Connection
connectPop3Port [Char]
host PortNumber
port) POP3Connection -> IO ()
closePop3 POP3Connection -> IO a
execution

doPop3 :: String -> (POP3Connection -> IO a) -> IO a
doPop3 :: [Char] -> (POP3Connection -> IO a) -> IO a
doPop3 [Char]
host POP3Connection -> IO a
execution = [Char] -> PortNumber -> (POP3Connection -> IO a) -> IO a
forall a. [Char] -> PortNumber -> (POP3Connection -> IO a) -> IO a
doPop3Port [Char]
host PortNumber
110 POP3Connection -> IO a
execution

doPop3Stream :: BSStream -> (POP3Connection -> IO b) -> IO b
doPop3Stream :: BSStream -> (POP3Connection -> IO b) -> IO b
doPop3Stream BSStream
conn POP3Connection -> IO b
execution = IO POP3Connection
-> (POP3Connection -> IO ()) -> (POP3Connection -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (BSStream -> IO POP3Connection
connectStream BSStream
conn) POP3Connection -> IO ()
closePop3 POP3Connection -> IO b
execution

crlf :: BS.ByteString
crlf :: ByteString
crlf = [Char] -> ByteString
BS.pack [Char]
"\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