{- | Module : $Header$ Description : Internalities of NNTP modules Copyright : (c) Maciej Piechotka License : LGPL 3 or later Maintainer : uzytkownik2@gmail.com Stability : none Portability : portable This module contains internalities of NNTP library -} module Network.NNTP.Internal ( -- * Types Article(..), Group(..), NntpT(..), NntpState(..), NntpConnection(..), NntpError(..), NntpParser, -- * Functions runNntpParser, nntpPutStr, nntpPutStrLn, nntpSendCommand, tryCommands ) where import Control.Applicative hiding (empty) import Control.Arrow import Control.Monad.Error import Control.Monad.State hiding (State) import Data.ByteString.Lazy.Char8 hiding (foldl) import Data.Monoid import Text.Parsec hiding ((<|>), many) import Text.Parsec.Pos {- | 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 (==) = curry (articleID *** articleID >>> uncurry (==)) {- | 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 (==) = curry (groupName *** groupName >>> uncurry (==)) {- | NntpConnection represents a connection in a NntpT monad. Please note that for 'runNntpWithConnection' you need to supply both 'input' and 'output' functions. -} data Monad m => NntpConnection m = NntpConnection { -- | Input is an stream which is from a server. input :: ByteString, -- | Output is a function which sends the data to a server. output :: ByteString -> m () } {- | NntpState represents a state at given moment. Please note that this type is not a part of stable API (when we will have one). -} data Monad m => NntpState m = NntpState { connection :: NntpConnection m } {- | NntpT represents a connection. Since some servers have short timeouts it is recommended to keep the connections short. -} data Monad m => NntpT m a = NntpT { runNntpT :: StateT (NntpState m) (ErrorT NntpError m) a } instance Monad m => Applicative (NntpT m) where pure = return (<*>) = ap instance Monad m => Functor (NntpT m) where f `fmap` m = NntpT $ f <$> runNntpT m instance Monad m => Monad (NntpT m) where m >>= f = NntpT $ runNntpT m >>= runNntpT . f return = lift . return instance MonadTrans NntpT where lift = NntpT . lift . lift instance MonadIO m => MonadIO (NntpT m) where liftIO = lift . liftIO {- | Indicates an error of handling NNTP connection. Please note that this should indicate client errors only (with the exception of 'ServiceDiscontinued', in some cases 'PostingFailed' and 'NoSuchCommand'. The last one if propagated outside NNTP module indicates a bug in library or server.). -} 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. | NoSuchCommand -- ^ Indicates that command does not exists. deriving (Eq, Show, Read) instance Error NntpError where noMsg = undefined strMsg = read type NntpParser m a = ParsecT ByteString () (NntpT m) a -- | Transforms "NntpParser" into "NntpT" monad taking care about input -- position runNntpParser :: Monad m => NntpParser m a -> NntpT m a runNntpParser p = do s <- NntpT (gets $ input . connection) r <- parserRep =<< runParsecT p (State s (initialPos "") ()) case r of Ok v (State i _ _) _ -> NntpT (modify $ pNI i) >> return v Error e -> error $ show e where parserRep (Consumed x) = x parserRep (Empty x) = x pNI i s = s {connection = (connection s) {input = i}} -- | Puts an argument to output. nntpPutStr :: Monad m => ByteString -> NntpT m () nntpPutStr s = lift . ($ s) =<< NntpT (gets $ output . connection) -- | Puts an argument to output followed by end-of-line. nntpPutStrLn :: Monad m => ByteString -> NntpT m () nntpPutStrLn = nntpPutStr . (`mappend` pack "\r\n") -- | Sends a commad. nntpSendCommand :: Monad m => String -- ^ Command. -> ByteString -- ^ Arguments. -> NntpParser m a -- ^ Parser of output. -> NntpT m a -- ^ Returned value from parser. nntpSendCommand c a p = nntpPutStrLn (pack (c ++ " ") `mappend` a) >> runNntpParser p -- | Try commands one by one to check for existing command. tryCommands :: Monad m => [NntpT m a] -- ^ Possible command. -> NntpT m a -- ^ Result tryCommands = foldl (\a b -> NntpT $ runNntpT a `catchError` \e -> if e == NoSuchCommand then runNntpT b else throwError e) (NntpT $ throwError NoSuchCommand)