{- | 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 ( -- * Classes Connection(..), -- * Types Article(..), Group(..), -- * Errors NNTPError(..), ) where import Control.Exception import Control.Monad import Data.ByteString import Data.Dynamic import Data.Time {- | Represents a single article. Please note that except the splitting into header and body no parsing is done. -} data Article = Article { -- | Returns the article ID articleID :: String, -- | Returns the article header. 'Data.Maybe.Nothing' indicates not -- fetched header. articleHeader :: Maybe ByteString, -- | Returns the article body. 'Data.Maybe.Nothing' indicates not -- fetched body. articleBody :: Maybe ByteString } instance Show Article where show = ("Article "++) . articleID instance Eq Article where a == b = (articleID a) == (articleID b) {- | Represents a single group. -} data Group = Group { -- | Returns the group name. groupName :: String, -- | Returns the number of first article avaible. groupArticleFirst :: Integer, -- | Returns the number of last article avaible. groupArticleLast :: Integer } instance Show Group where show = ("Group "++) . groupName instance Eq Group where a == b = (groupName a) == (groupName b) {- | Indicates an error of handling NNTP connection. Please note that this should indicate client errors only (with the exception of 'ServiceDiscontinued' and in some cases 'PostingFailed'). -} data NNTPError = NoSuchGroup -- ^ Indicates that operation was performed on group that does -- not exists. | NoSuchArticle -- ^ Indicates that operation was performed on article that does -- not exists. | PostingFailed -- ^ Indicates that posting operation failed for some reason. | PostingNotAllowed -- ^ Indicates that posting is not allowed. | ServiceDiscontinued -- ^ Indicates that service was discontinued deriving (Eq, Show, Read) instance Typeable NNTPError where typeOf _ = mkTyConApp (mkTyCon "Network.NNTP") [] instance Exception NNTPError {- NNTP library allows many backends. At least currently "Network.NNTP.RFC977" is the base backend but others may be implemented. All operations are required unless stated otherwise. If the operation was stated as defined "in terms of" other it means that the other operation need to be defined. -} class Connection c where -- | Returns the Article for given ID. Please note that it may or may not -- fetch the header and body. Preferred is lazy loading. -- -- If you need to fetch the article you may use: -- @ -- articleFromID c >=> maybe (return Nothing) (fmap Just . fetchArticleLazy) -- @ articleFromID :: c -- ^ Connection -> String -- ^ ID of the article -> IO (Maybe Article) -- ^ Returns the article -- | 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 :: c -- ^ Connection -> Group -- ^ Group -> Integer -- ^ Number of article in group -> IO (Maybe Article) -- ^ The article -- | Returns the Group of given name. groupFromName :: c -- ^ Connection -> String -- ^ Name of group -> IO (Maybe Group) -- ^ Group -- | 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 :: c -- ^ Connection -> (Group -> IO a) -- ^ Function called each time -> IO [a] -- ^ Collected values -- | 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 :: c -- ^ Connection -> UTCTime -- ^ Groups only newer thet this time will be -- returned -> (Group -> IO a) -- ^ Function called each time -> IO [a] -- ^ Collected values -- | 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 :: c -- ^ Connection -> Group -- ^ Group which we iterate -> (Article -> IO a) -- ^ Function called each time -> IO [a] -- ^ Collected values -- | 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 :: c -- ^ Connection -> Group -- ^ Group which we iterate -> UTCTime -- ^ Articles only newer thet this time will be -- returned -> (Article -> IO a) -- ^ Function called each time -> IO [a] -- ^ Collected values -- | Lists the groups. It has default implementation. listGroups :: c -- ^ Connection -> IO [Group] -- ^ List of groups listGroups c = forGroups c (return . id) -- | Lists the new groups. It has default implementation. listNewGroups :: c -- ^ Connection -> UTCTime -- ^ Groups only newer thet this time will be -- returned -> IO [Group] -- ^ List of groups listNewGroups c t = forNewGroups c t (return . id) -- | Lists the articles. It has default implementation. listArticles :: c -- ^ Connection -> Group -- ^ Group which we list -> IO [Article] -- ^ List of articles listArticles c g = forArticles c g (return . id) -- | Lists the new articles. It has default implementation. listNewArticles :: c -- ^ Connection -> Group -- ^ Group which we list -> UTCTime -- ^ Articles only newer thet this time will be -- returned -> IO [Article] -- ^ List of articles listNewArticles c g t = forNewArticles c g t (return . id) -- | Fetch the article. It has default implementation defined in terms -- of 'fetchArticleHeader' and 'fetchArticleBody'. fetchArticle :: c -- ^ Connection -> Article -- ^ An article -> IO Article -- ^ Updated article fetchArticle c = fetchArticleHeader c >=> fetchArticleBody c -- | Fetch the article header. It has default implementation defined in -- terms of 'fetchArticle'. fetchArticleHeader :: c -- ^ Connection -> Article -- ^ An article -> IO Article -- ^ Updated article fetchArticleHeader = fetchArticle -- | Fetch the article header. It has default implementation defined in -- terms of 'fetchArticle'. fetchArticleBody :: c -- ^ Connection -> Article -- ^ An article -> IO Article -- ^ Updated article fetchArticleBody = fetchArticle -- | Fetchs the article only if it is not fetched. It has default -- implementation. fetchArticleLazy :: c -- ^ Connection -> Article -- ^ An article -> IO Article -- ^ Updated article fetchArticleLazy c s@(Article _ Nothing Nothing) = fetchArticle c s fetchArticleLazy c a = fetchArticleHeaderLazy c a >>= fetchArticleBodyLazy c -- | Fetchs the article header if it is not fetched. It has default -- implementation. fetchArticleHeaderLazy :: c -- ^ Connection -> Article -- ^ An article -> IO Article -- ^ Updated article fetchArticleHeaderLazy _ a@(Article _ (Just _) _) = return a fetchArticleHeaderLazy c a = fetchArticleHeader c a -- | Fetchs the article body if it is not fetched. It has default -- implementation. fetchArticleBodyLazy :: c -- ^ Connection -> Article -- ^ An article -> IO Article -- ^ Updated article fetchArticleBodyLazy _ a@(Article _ _ (Just _)) = return a fetchArticleBodyLazy c a = fetchArticleBody c a -- | Updates group. fetchGroup :: c -- ^ Connection -> Group -- ^ A group -> IO Group -- ^ Updated group -- | Posts an article. post :: c -- ^ Connection -> ByteString -- ^ Article content -> IO () -- | Disconnects gently disconnect :: c -- ^ Connection -> IO ()