{- |
Module      : $Header$
Description : Basic NNTP data types
Copyright   : (c) Maciej Piechotka
License     : LGPL 3 or later

Maintainer  : uzytkownik2@gmail.com
Stability   : none
Portability : portable

This module contains the common features and common interface.
-}
module Network.NNTP
    (
     -- * Types
     Article(..),
     Group(..),
     NntpConnection(..),
     NntpState(..),
     NntpT(..),
     -- * Errors
     NntpError(..),
     -- * Functions
     -- ** 'NntpState'-related functions
     runNntpWithHost,
     runNntpWithConnection,
     -- ** Commands functions
     articleFromID,
     articleFromNo,
     groupFromName,
     forGroups,
     forNewGroups,
     forArticles,
     forNewArticles,
     fetchArticle,
     fetchArticleHeader,
     fetchArticleBody,
     fetchArticleLazy,
     fetchArticleHeaderLazy,
     fetchArticleBodyLazy,
     fetchGroup,
     post
    )
    where
import Control.Applicative hiding (empty)
import Control.Monad
import Control.Monad.Loops
import Control.Monad.Trans
import Data.ByteString.Lazy.Char8(ByteString, empty, hGetContents, hPut, pack)
import Data.Maybe
import Data.Time
import Data.Word
import qualified Network.NNTP.Core as Core
import qualified Network.NNTP.Common as Common
import Network.NNTP.Internal
import Network.NNTP.Internal.Article
import Network.NNTP.Internal.Group
import Network.NNTP.ParserHelpers hiding (groupName)
import Network.Socket
import System.IO hiding (hGetContents)

-- | This is utility function which connects to a host, creates 'NntpState' and
-- supplies it to 'runNntpWithState'.
runNntpWithHost :: MonadIO m => String -- ^ A hostname.
                -> Maybe Word16 -- ^ Port. 'Nothing' for standard port.
                -> (Bool -> NntpT m a) -- ^ Function returning 'NntpT' monad.
                                       -- Argument indicates if posting is
                                       -- allowed.
                -> m (Either NntpError a) -- ^ Returned value.
runNntpWithHost h p f = do s <- liftIO $ connectToHost h $ maybe "nntp" show p
                           ha <- liftIO $ socketToHandle s ReadWriteMode
                           liftIO $ hSetBuffering ha LineBuffering
                           o <- liftIO $ hGetContents ha
                           let c = NntpConnection o
                                                  (liftIO . (hPut ha >=>
                                                             \_ -> hFlush ha))
                           runNntpWithConnection c f
-- | Runs Nntp with given connection.
runNntpWithConnection :: Monad m => NntpConnection m -- ^ A state
                      -> (Bool -> NntpT m a) -- ^ Function returning 'NntpT'
                                             -- monad. Argument indicates if
                                             -- posting is allowed.
                      -> m (Either NntpError a) -- ^ Returned value.
runNntpWithConnection c f =
  snd `liftM`
  runNntpT (liftM2 const (f =<< runNntpParser cHelo) (runNntpParser cQuit))
           (NntpState c)
connectToHost :: String -> String -> IO Socket
connectToHost h p = do a <- head <$> getAddrInfo Nothing (Just h) (Just p)
                       s <- socket (addrFamily a) Stream 0
                       connect s (addrAddress a)
                       return s
-- | Returns the Article for given ID. Please note that it may or may not
-- fetch the header and body. Preferred is lazy loading.
articleFromID :: Monad m => String -- ^ ID of article.
              -> NntpT m (Maybe Article) -- ^ Returns the article.
articleFromID = Core.stat . pack
-- | Returns the Article of given number from given Group. Please note that
-- it may or may not fetch the header and body. Preferred is lazy loading.
articleFromNo :: Monad m => Group -- ^ Group.
              -> Integer -- ^ ID of article.
              -> NntpT m (Maybe Article) -- ^ Returns the article.
articleFromNo g n = Core.group (pack $ groupName g) >>=
                    maybe (NntpT $ \s -> return $! (s, Left NoSuchGroup))
                          (const $ Core.stat $ pack $ show n)
-- | Returns the Group of given name.
groupFromName :: Monad m => String -- ^ Name of group.
              -> NntpT m (Maybe Group) -- ^ Group.
groupFromName = Core.group . pack
-- | Iterates over every group on server collecting values. Please note
-- that the function may be called before all I/O operations finished and
-- the implementation may or may not allaw to call other NNTP functions
-- during the call.
forGroups :: Monad m => (Group -> m a) -- ^ Function called each time.
          -> NntpT m [a] -- ^ Collected values.
forGroups = Core.list
-- | Iterates over new group on server collecting values. Please note
-- that the function may be called before all I/O operations finished and
-- the implementation may or may not allaw to call other NNTP functions
-- during the call.
forNewGroups :: Monad m => UTCTime -- ^ Groups only newer thet this time will
                                   -- be returned.
             -> (Group -> m a) -- ^ Function called each time.
             -> NntpT m [a] -- ^ Collected values.
forNewGroups = Core.newgroups
-- | Iterates over the articles in group collecting values. Please note
-- that the function may be called before all I/O operations finished and
-- the implementation may or may not allaw to call other NNTP functions
-- during the call.
forArticles :: Monad m => Group -- ^ Group which we iterate.
            -> (Article -> m a) -- ^ Function called each time.
            -> NntpT m [a] -- ^ Collected values.
forArticles g f =
    Core.group (pack $ groupName g) >>=
    flip when (NntpT $ \s -> return $! (s, Left NoSuchGroup)) . isNothing >>
    tryCommands [Common.xhdr f,
                 Core.stat empty >>=
                 liftMb (lift . f >=>
                         \s -> unfoldM (Core.next >>= liftMb (lift . f)) >>=
                         \r -> return (s:r)) >>=
                 return . fromMaybe []]
    where liftMb :: Monad m => (a -> m b) -> (Maybe a -> m (Maybe b))
          liftMb h =  maybe (return Nothing) (return . Just <=< h)
-- | Iterates over the new articles in group collecting values. Please note
-- that the function may be called before all I/O operations finished and
-- the implementation may or may not allaw to call other NNTP functions
-- during the call.
forNewArticles :: Monad m => UTCTime -- ^ Articles only newer thet this time
                                     -- will be returned.
               -> Group -- ^ Group which we iterate.
               -> (Article -> m a) -- ^ Function called each time.
               -> NntpT m [a] -- ^ Collected values.
forNewArticles = Core.newnews
-- | Fetch the article.
fetchArticle :: Monad m => Article -- ^ An article.
             -> NntpT m Article -- ^ Updated article.
fetchArticle = Core.article . pack . articleID >=>
               maybe (NntpT $ \s -> return $! (s, Left NoSuchArticle)) return
-- | Fetch the article header.
fetchArticleHeader :: Monad m => Article -- ^ An article.
                   -> NntpT m Article -- ^ Updated article.
fetchArticleHeader a = Core.head (pack $ articleID a) >>=
                       maybe (NntpT $ \s -> return $! (s, Left NoSuchArticle))
                             (\a' -> return $! a {articleHeader = articleHeader a'})
-- | Fetch the article header.
fetchArticleBody :: Monad m => Article -- ^ An article.
                 -> NntpT m Article -- ^ Updated article.
fetchArticleBody a = Core.body (pack $ articleID a) >>=
                     maybe (NntpT $ \s -> return $! (s, Left NoSuchArticle))
                           (\a' -> return $! a {articleBody = articleBody a'})
-- | Fetchs the article only if it is not fetched.
fetchArticleLazy :: Monad m => Article -- ^ An article.
                 -> NntpT m Article -- ^ Updated article.
fetchArticleLazy a@(Article _ Nothing  Nothing) = fetchArticle a
fetchArticleLazy a@(Article _ _        Nothing) = fetchArticleBody a
fetchArticleLazy a@(Article _ Nothing  _      ) = fetchArticleHeader a
fetchArticleLazy a@(Article _ _        _      ) = return a
-- | Fetchs the article header if it is not fetched.
fetchArticleHeaderLazy :: Monad m => Article -- ^ An article.
                       -> NntpT m Article -- ^ Updated article.
fetchArticleHeaderLazy a@(Article _ Nothing _) = fetchArticleHeader a
fetchArticleHeaderLazy a@(Article _ _       _) = return a
-- | Fetchs the article body if it is not fetched.
fetchArticleBodyLazy :: Monad m => Article -- ^ An article.
                     -> NntpT m Article -- ^ Updated article.
fetchArticleBodyLazy a@(Article _ _ Nothing) = fetchArticleBody a
fetchArticleBodyLazy a@(Article _ _ _      ) = return a
-- | Updates group.
fetchGroup :: Monad m => Group -- ^ A group.
           -> NntpT m Group -- ^ Updated group.
fetchGroup = maybe (NntpT $ \s -> return $! (s, Left NoSuchGroup)) return <=<
             Core.group . pack . groupName
-- | Posts an article.
post :: Monad m => ByteString -- ^ Article contents
     -> NntpT m ()
post = Core.post

cHelo :: Monad m => NntpParser m Bool
cHelo = (code <* line) >>= \l -> case l of
                                   200 -> return True
                                   201 -> return False
                                   _ -> error "Unknown response"
cQuit :: Monad m => NntpParser m ()
cQuit = do lift $ nntpPutStrLn $ pack "QUIT"
           c <- code <* line
           case c of
             205 -> return ()
             _ -> error "Unknown response"