{- |
    Module      :  Network.POP3.Client
    Copyright   :  (c) 2009 Peter van den Brand
    License     :  BSD3

    Maintainer  :  peter@vdbrand.nl
    Stability   :  provisional
    Portability :  portable

    This module contains function to connect to a POP3 server and 
    retrieve messages and other information from it. 

    This library is designed to be safe to use: connections are
    guaranteed to be closed after the POP3 commands have been executed.

    Example:

    @
       main :: IO ()
       main = do
           result <- withPOP3 \"pop3.example.org\" defaultPort $ do
               r <- authenticate \"user at host.com\" \"my_pass\"
               case r of
                   Left s  -> liftIO $ putStrLn (\"Error: \" ++ s)
                   Right _ -> liftIO $ putStrLn (\"Authentication OK\")
               r <- getMailboxBytes
               case r of
                   Left s  -> liftIO $ putStrLn (\"Error: \" ++ s)
                   Right n -> liftIO $ putStrLn (\"Size of mailbox:    \" ++ show n)
               r <- getNumberOfMessages
               case r of
                   Left s    -> do
                       liftIO $ putStrLn (\"Error: \" ++ s)
                       return $ Left s -- withPOP3 will return this error message
                   Right num -> do
                       liftIO $ putStrLn (\"Number of messages: \" ++ show num)
                       -- read the most recently received message and return it
                       getMessage num
           -- result is the message which was read above (or an error message)
           putStrLn $ show result
    @

-}

module Network.POP3.Client (
        defaultPort,

        -- * Connecting and authenticating
        withPOP3,
        authenticate,

        -- * Retrieving mailbox statistics
        getMailboxBytes,
        getNumberOfMessages,

        -- * Retrieving messages
        getUniqueID,
        getSize,
        getMessage,
        getFirstNLines,
        getHeaders
    ) where

import Network
import Control.Exception
import Control.Monad.Reader
import System.IO
import Data.List
import Data.Char
import Control.Monad.Instances

data Connection = Connection { socket :: Handle }

type POP3 = ReaderT Connection IO
type Response = Either String String
type MessageID = Integer

-- | Default POP3 port (110)
defaultPort :: Int
defaultPort = 110

-- | Connects to the given host and port, executes the given
--   POP3 action(s), closes the connection, and finally returns
--   the result op the (last) POP3 action.
--   The connection is guaranteed to be closed before returning from 
--   this function, even when an exception occurs during the session.
withPOP3 :: String -> Int -> POP3 a -> IO a
withPOP3 host port commands = withSocketsDo $ bracket connect disconnect session
    where
        connect    = do
            h <- connectTo host (PortNumber (fromIntegral port))
            hSetBuffering h LineBuffering
            return $ Connection h
        disconnect = hClose . socket
        session    = runReaderT (receive singleLine >> commands >>= quit)

-- | Send the given username and password. 
--   This has to be the first command sent to the POP3 server.
--   Other POP3 actions can only be executed after a successful authentication.
authenticate :: String -> String -> POP3 Response
authenticate user pass = do
    sendReceive ["USER", sanitize user] singleLine Right
    sendReceive ["PASS", sanitize pass] singleLine Right

-- | Returns the number of messages stored in the POP3 mailbox.
getNumberOfMessages :: POP3 (Either String Integer)
getNumberOfMessages = sendReceive ["STAT"] singleLine (firstToken toInt)

-- | Returns the size of the POP3 mailbox in bytes.
getMailboxBytes :: POP3 (Either String Integer)
getMailboxBytes = sendReceive ["STAT"] singleLine (secondToken toInt)

-- | Returns the unique ID (UIDL) of a message on the server.
--   The message ID should be in the range [1..'getNumberOfMessages'].
getUniqueID :: MessageID -> POP3 (Either String String)
getUniqueID n = sendReceive ["UIDL", show n] singleLine (secondToken Just)

-- | Returns the size of a message on the server in bytes.
--   Note that this may not correspond exactly to the size of the message
--   as it is downloaded, because of newline and escape values.
--   The message ID should be in the range [1..'getNumberOfMessages'].
getSize :: MessageID -> POP3 (Either String Integer)
getSize n = sendReceive ["LIST", show n] singleLine (secondToken toInt)

-- | Retrieves a POP3 message from the server and returns it parsed as a 'Message'.
--   The message ID should be in the range [1..'getNumberOfMessages'].
getMessage :: MessageID -> POP3 Response
getMessage n = sendReceive ["RETR", show n] multiLine Right

-- | Retrieves a the headers and the first n lines of a message from the server 
--   and returns it parsed as a 'Message'.
--   The message ID should be in the range [1..'getNumberOfMessages'].
getFirstNLines :: MessageID -> Integer -> POP3 Response
getFirstNLines n m = sendReceive ["TOP", show n, show m] multiLine Right

-- | Retrieves a the headers of a message from the server and returns it parsed as a 'Message'.
--   The message ID should be in the range [1..'getNumberOfMessages'].
getHeaders :: MessageID -> POP3 Response
getHeaders n = getFirstNLines n 0

-- | Sends the QUIT command to the server. It returns its argument to 
--   make the implementation of 'withPOP3' a little more concise.
quit :: a -> POP3 a
quit a = sendReceive ["QUIT"] singleLine Right >> return a

-------------------------------------------------------------------------------
-- Actual send and receive functions

sendReceive :: [String]             -- ^ The command and its arguments to send
    -> (Handle -> IO String)        -- ^ Function to read the response with
    -> (String -> Either String a)  -- ^ Function to parse the response with
    -> POP3 (Either String a)       -- ^ Either an error message or the parsed response
sendReceive command reader parser = do
    h <- asks socket
    liftIO $ hPutStr h (intercalate " " command)
    liftIO $ hPutStr h "\r\n"
    response <- receive reader
    case response of
        Left err -> return $ Left err
        Right r  -> return $ parser r

receive :: (Handle -> IO String)    -- ^ Function to read the response with
    -> POP3 Response                -- ^ Either an error message or the raw response body
receive reader = do
    h <- asks socket
    response <- liftIO $ reader h
    if "+OK" `isPrefixOf` response
        then return $ Right (drop 4 response)
        else return $ Left  (drop 5 (sanitize response))

-------------------------------------------------------------------------------
-- Small helper functions

-- remove all non-printable and all whitespace characters
sanitize :: String -> String
sanitize = filter (\c -> isPrint c && not (isSpace c))

firstToken, secondToken :: (String -> Maybe a) -> String -> Either String a
firstToken  = extractToken 0
secondToken = extractToken 1

-- extract the n'th word from a string and return the result of f applied to this word
extractToken :: Int -> (String -> Maybe a) -> String -> Either String a
extractToken n f input =
    case drop n (words input) of
        []    -> Left  $ "invalid response received: " ++ input
        (x:_) -> case f x of
                    Nothing -> Left  $ "invalid response received: " ++ input
                    Just x' -> Right x'

-- parse an integer from a string, returning Nothing if the 
-- string is empty or contains a non-digit character
toInt :: String -> Maybe Integer
toInt [] = Nothing
toInt s = helper s 0
    where
        helper :: String -> Integer -> Maybe Integer
        helper [] acc = Just acc
        helper (x:xs) acc
            | '0' <= x && x <= '9' = helper xs (acc * 10 + fromIntegral (ord x - ord '0'))
            | otherwise = Nothing

-- Read a single line from the POP3 connection.
-- According to the RFC, these lines should be terminated with CRLF.
singleLine :: Handle -> IO String
singleLine h = do
    line <- hGetLine h -- TODO should properly read upto CRLF instead of just LF, and discard the CRLF
    if "\r" `isSuffixOf` line 
        then return $ init line
        else return $ line

-- Read a multi-line response from the POP3 connection.
multiLine :: Handle -> IO String
multiLine h = do 
        firstLine <- singleLine h
        if not ("+OK" `isPrefixOf` firstLine)
            then return firstLine
            else do
                rest <- readOtherLines
                return $ "+OK " ++ joinWithCRLF (map removeTerminationOctet rest)
    where
        readOtherLines = do
            line <- singleLine h
            if line == "." 
                then return []
                else do
                    others <- readOtherLines
                    return $ line : others
        removeTerminationOctet s = if "." `isPrefixOf` s then tail s else s
        joinWithCRLF = concatMap (++ "\r\n")