irc-conduit 0.2.1.0 → 0.2.1.1
raw patch · 5 files changed
+241/−278 lines, 5 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Network.IRC.Conduit.Internal.Conduits: chunked :: Monad m => Conduit ByteString m ByteString
- Network.IRC.Conduit.Internal.Conduits: exceptionalConduit :: MonadIO m => Conduit a m a
- Network.IRC.Conduit.Internal.Messages: Channel :: (ChannelName a) -> (NickName a) -> Source a
- Network.IRC.Conduit.Internal.Messages: Event :: ByteString -> Source a -> Message a -> Event a
- Network.IRC.Conduit.Internal.Messages: Invite :: (ChannelName a) -> (NickName a) -> Message a
- Network.IRC.Conduit.Internal.Messages: Join :: (ChannelName a) -> Message a
- Network.IRC.Conduit.Internal.Messages: Kick :: (ChannelName a) -> (NickName a) -> (Reason a) -> Message a
- Network.IRC.Conduit.Internal.Messages: Mode :: (Target a) -> IsModeSet -> [ModeFlag a] -> [ModeArg a] -> Message a
- Network.IRC.Conduit.Internal.Messages: Nick :: (NickName a) -> Message a
- Network.IRC.Conduit.Internal.Messages: Notice :: (Target a) -> (Either CTCPByteString a) -> Message a
- Network.IRC.Conduit.Internal.Messages: Numeric :: Int -> [NumericArg a] -> Message a
- Network.IRC.Conduit.Internal.Messages: Part :: (ChannelName a) -> (Reason a) -> Message a
- Network.IRC.Conduit.Internal.Messages: Ping :: (ServerName a) -> (Maybe (ServerName a)) -> Message a
- Network.IRC.Conduit.Internal.Messages: Pong :: (ServerName a) -> Message a
- Network.IRC.Conduit.Internal.Messages: Privmsg :: (Target a) -> (Either CTCPByteString a) -> Message a
- Network.IRC.Conduit.Internal.Messages: Quit :: (Reason a) -> Message a
- Network.IRC.Conduit.Internal.Messages: RawMsg :: a -> Message a
- Network.IRC.Conduit.Internal.Messages: Server :: (ServerName a) -> Source a
- Network.IRC.Conduit.Internal.Messages: Topic :: (ChannelName a) -> a -> Message a
- Network.IRC.Conduit.Internal.Messages: User :: (NickName a) -> Source a
- Network.IRC.Conduit.Internal.Messages: [_message] :: Event a -> Message a
- Network.IRC.Conduit.Internal.Messages: [_raw] :: Event a -> ByteString
- Network.IRC.Conduit.Internal.Messages: [_source] :: Event a -> Source a
- Network.IRC.Conduit.Internal.Messages: attemptDecode :: ByteString -> Maybe (IrcSource, IrcMessage)
- Network.IRC.Conduit.Internal.Messages: data Event a
- Network.IRC.Conduit.Internal.Messages: data Message a
- Network.IRC.Conduit.Internal.Messages: data Source a
- Network.IRC.Conduit.Internal.Messages: fromByteString :: ByteString -> Either ByteString IrcEvent
- Network.IRC.Conduit.Internal.Messages: instance GHC.Base.Functor Network.IRC.Conduit.Internal.Messages.Event
- Network.IRC.Conduit.Internal.Messages: instance GHC.Base.Functor Network.IRC.Conduit.Internal.Messages.Message
- Network.IRC.Conduit.Internal.Messages: instance GHC.Base.Functor Network.IRC.Conduit.Internal.Messages.Source
- Network.IRC.Conduit.Internal.Messages: instance GHC.Classes.Eq (Network.IRC.Conduit.Internal.Messages.NickName a) => GHC.Classes.Eq (Network.IRC.Conduit.Internal.Messages.Event a)
- Network.IRC.Conduit.Internal.Messages: instance GHC.Classes.Eq (Network.IRC.Conduit.Internal.Messages.NickName a) => GHC.Classes.Eq (Network.IRC.Conduit.Internal.Messages.Source a)
- Network.IRC.Conduit.Internal.Messages: instance GHC.Classes.Eq (Network.IRC.Conduit.Internal.Messages.Target a) => GHC.Classes.Eq (Network.IRC.Conduit.Internal.Messages.Message a)
- Network.IRC.Conduit.Internal.Messages: instance GHC.Show.Show (Network.IRC.Conduit.Internal.Messages.NickName a) => GHC.Show.Show (Network.IRC.Conduit.Internal.Messages.Event a)
- Network.IRC.Conduit.Internal.Messages: instance GHC.Show.Show (Network.IRC.Conduit.Internal.Messages.NickName a) => GHC.Show.Show (Network.IRC.Conduit.Internal.Messages.Source a)
- Network.IRC.Conduit.Internal.Messages: instance GHC.Show.Show (Network.IRC.Conduit.Internal.Messages.Target a) => GHC.Show.Show (Network.IRC.Conduit.Internal.Messages.Message a)
- Network.IRC.Conduit.Internal.Messages: mkMessage :: ByteString -> [ByteString] -> ByteString
- Network.IRC.Conduit.Internal.Messages: rawMessage :: ByteString -> [ByteString] -> IrcMessage
- Network.IRC.Conduit.Internal.Messages: toByteString :: IrcMessage -> ByteString
- Network.IRC.Conduit.Internal.Messages: type ChannelName a = a
- Network.IRC.Conduit.Internal.Messages: type IrcEvent = Event ByteString
- Network.IRC.Conduit.Internal.Messages: type IrcMessage = Message ByteString
- Network.IRC.Conduit.Internal.Messages: type IrcSource = Source ByteString
- Network.IRC.Conduit.Internal.Messages: type IsModeSet = Bool
- Network.IRC.Conduit.Internal.Messages: type ModeArg a = a
- Network.IRC.Conduit.Internal.Messages: type ModeFlag a = a
- Network.IRC.Conduit.Internal.Messages: type NickName a = a
- Network.IRC.Conduit.Internal.Messages: type NumericArg a = a
- Network.IRC.Conduit.Internal.Messages: type Reason a = Maybe a
- Network.IRC.Conduit.Internal.Messages: type ServerName a = a
- Network.IRC.Conduit.Internal.Messages: type Target a = a
+ Network.IRC.Conduit.Internal: Channel :: (ChannelName a) -> (NickName a) -> Source a
+ Network.IRC.Conduit.Internal: Event :: ByteString -> Source a -> Message a -> Event a
+ Network.IRC.Conduit.Internal: Invite :: (ChannelName a) -> (NickName a) -> Message a
+ Network.IRC.Conduit.Internal: Join :: (ChannelName a) -> Message a
+ Network.IRC.Conduit.Internal: Kick :: (ChannelName a) -> (NickName a) -> (Reason a) -> Message a
+ Network.IRC.Conduit.Internal: Mode :: (Target a) -> IsModeSet -> [ModeFlag a] -> [ModeArg a] -> Message a
+ Network.IRC.Conduit.Internal: Nick :: (NickName a) -> Message a
+ Network.IRC.Conduit.Internal: Notice :: (Target a) -> (Either CTCPByteString a) -> Message a
+ Network.IRC.Conduit.Internal: Numeric :: Int -> [NumericArg a] -> Message a
+ Network.IRC.Conduit.Internal: Part :: (ChannelName a) -> (Reason a) -> Message a
+ Network.IRC.Conduit.Internal: Ping :: (ServerName a) -> (Maybe (ServerName a)) -> Message a
+ Network.IRC.Conduit.Internal: Pong :: (ServerName a) -> Message a
+ Network.IRC.Conduit.Internal: Privmsg :: (Target a) -> (Either CTCPByteString a) -> Message a
+ Network.IRC.Conduit.Internal: Quit :: (Reason a) -> Message a
+ Network.IRC.Conduit.Internal: RawMsg :: a -> Message a
+ Network.IRC.Conduit.Internal: Server :: (ServerName a) -> Source a
+ Network.IRC.Conduit.Internal: Topic :: (ChannelName a) -> a -> Message a
+ Network.IRC.Conduit.Internal: User :: (NickName a) -> Source a
+ Network.IRC.Conduit.Internal: [_message] :: Event a -> Message a
+ Network.IRC.Conduit.Internal: [_raw] :: Event a -> ByteString
+ Network.IRC.Conduit.Internal: [_source] :: Event a -> Source a
+ Network.IRC.Conduit.Internal: attemptDecode :: ByteString -> Maybe (IrcSource, IrcMessage)
+ Network.IRC.Conduit.Internal: chunked :: Monad m => Conduit ByteString m ByteString
+ Network.IRC.Conduit.Internal: data Event a
+ Network.IRC.Conduit.Internal: data Message a
+ Network.IRC.Conduit.Internal: data Source a
+ Network.IRC.Conduit.Internal: fromByteString :: ByteString -> Either ByteString IrcEvent
+ Network.IRC.Conduit.Internal: instance GHC.Base.Functor Network.IRC.Conduit.Internal.Event
+ Network.IRC.Conduit.Internal: instance GHC.Base.Functor Network.IRC.Conduit.Internal.Message
+ Network.IRC.Conduit.Internal: instance GHC.Base.Functor Network.IRC.Conduit.Internal.Source
+ Network.IRC.Conduit.Internal: instance GHC.Classes.Eq (Network.IRC.Conduit.Internal.NickName a) => GHC.Classes.Eq (Network.IRC.Conduit.Internal.Event a)
+ Network.IRC.Conduit.Internal: instance GHC.Classes.Eq (Network.IRC.Conduit.Internal.NickName a) => GHC.Classes.Eq (Network.IRC.Conduit.Internal.Source a)
+ Network.IRC.Conduit.Internal: instance GHC.Classes.Eq (Network.IRC.Conduit.Internal.Target a) => GHC.Classes.Eq (Network.IRC.Conduit.Internal.Message a)
+ Network.IRC.Conduit.Internal: instance GHC.Show.Show (Network.IRC.Conduit.Internal.NickName a) => GHC.Show.Show (Network.IRC.Conduit.Internal.Event a)
+ Network.IRC.Conduit.Internal: instance GHC.Show.Show (Network.IRC.Conduit.Internal.NickName a) => GHC.Show.Show (Network.IRC.Conduit.Internal.Source a)
+ Network.IRC.Conduit.Internal: instance GHC.Show.Show (Network.IRC.Conduit.Internal.Target a) => GHC.Show.Show (Network.IRC.Conduit.Internal.Message a)
+ Network.IRC.Conduit.Internal: mkMessage :: ByteString -> [ByteString] -> ByteString
+ Network.IRC.Conduit.Internal: rawMessage :: ByteString -> [ByteString] -> IrcMessage
+ Network.IRC.Conduit.Internal: toByteString :: IrcMessage -> ByteString
+ Network.IRC.Conduit.Internal: type ChannelName a = a
+ Network.IRC.Conduit.Internal: type IrcEvent = Event ByteString
+ Network.IRC.Conduit.Internal: type IrcMessage = Message ByteString
+ Network.IRC.Conduit.Internal: type IrcSource = Source ByteString
+ Network.IRC.Conduit.Internal: type IsModeSet = Bool
+ Network.IRC.Conduit.Internal: type ModeArg a = a
+ Network.IRC.Conduit.Internal: type ModeFlag a = a
+ Network.IRC.Conduit.Internal: type NickName a = a
+ Network.IRC.Conduit.Internal: type NumericArg a = a
+ Network.IRC.Conduit.Internal: type Reason a = Maybe a
+ Network.IRC.Conduit.Internal: type ServerName a = a
+ Network.IRC.Conduit.Internal: type Target a = a
Files
- Network/IRC/Conduit.hs +10/−3
- Network/IRC/Conduit/Internal.hs +229/−8
- Network/IRC/Conduit/Internal/Conduits.hs +0/−64
- Network/IRC/Conduit/Internal/Messages.hs +0/−199
- irc-conduit.cabal +2/−4
Network/IRC/Conduit.hs view
@@ -61,7 +61,7 @@ import Control.Monad (when) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.ByteString (ByteString)-import Data.Conduit (Conduit, Consumer, Producer, (=$), ($$), (=$=), awaitForever, yield)+import Data.Conduit (Conduit, Consumer, Producer, (=$), ($$), (=$=), awaitForever, yield, runConduit) import Data.Conduit.Network (AppData, clientSettings, runTCPClient, appSource, appSink) import Data.Conduit.Network.TLS (TLSClientConfig(..), tlsClientConfig, runTLSClient) import Data.Monoid ((<>))@@ -157,8 +157,15 @@ -> IO () ircWithConn runner start cons prod = runner $ \appdata -> runConcurrently $ Concurrently start- *> Concurrently (appSource appdata =$= exceptionalConduit $$ ircDecoder =$ cons)- *> Concurrently (prod $$ ircEncoder =$ appSink appdata)+ *> Concurrently (runSource appdata)+ *> Concurrently (runSink appdata)++ where+ runSource appdata = do+ runConduit $ appSource appdata =$= ircDecoder =$ cons+ ioError $ userError "Upstream source closed."++ runSink appdata = prod $$ ircEncoder =$ appSink appdata -- **TLS
Network/IRC/Conduit/Internal.hs view
@@ -1,17 +1,238 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+ -- | -- Module : Network.IRC.Conduit.Internal -- Copyright : (c) 2016 Michael Walker -- License : MIT -- Maintainer : Michael Walker <mike@barrucadu.co.uk> -- Stability : experimental--- Portability : non-portable+-- Portability : BangPatterns, DeriveFunctor, OverloadedStrings, TupleSections ----- Internal types and functions for irc-conduit. This module is NOT+-- Internal IRC conduit types and utilities. This module is NOT -- considered to form part of the public interface of this library.-module Network.IRC.Conduit.Internal- ( module Network.IRC.Conduit.Internal.Conduits- , module Network.IRC.Conduit.Internal.Messages- ) where+module Network.IRC.Conduit.Internal where -import Network.IRC.Conduit.Internal.Conduits-import Network.IRC.Conduit.Internal.Messages+import Control.Applicative ((<$>))+import Control.Arrow ((&&&))+import Data.ByteString (ByteString, isSuffixOf, singleton, unpack)+import Data.Char (ord)+import Data.Conduit (Conduit, await, yield)+import Data.Maybe (listToMaybe, isJust)+import Data.Monoid ((<>))+import Data.String (fromString)+import Network.IRC.CTCP (CTCPByteString, getUnderlyingByteString, orCTCP)+import Text.Read (readMaybe)++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Network.IRC as I++-- *Conduits++-- |Split up incoming bytestrings into new lines.+chunked :: Monad m => Conduit ByteString m ByteString+chunked = chunked' ""+ where+ chunked' !leftover = do+ -- Wait for a value from upstream+ val <- await++ case val of+ Just val' ->+ let+ carriage = fromIntegral $ fromEnum '\r'+ newline = fromIntegral $ fromEnum '\n'++ -- Split on '\n's, removing any stray '\r's (line endings+ -- are usually '\r\n's, but this isn't certain).+ bytes = B.filter (/=carriage) $ leftover <> val'+ splitted = B.split newline bytes++ -- If the last chunk ends with a '\n', then we have a+ -- complete message at the end, and can yield it+ -- immediately. Otherwise, store the partial message to+ -- prepend to the next bytestring received.+ (toyield, remainder)+ | singleton newline `isSuffixOf` bytes = (splitted, "")+ | otherwise = init &&& last $ splitted++ in do+ -- Yield all complete and nonempty messages, and loop.+ mapM_ yield $ filter (not . B.null) toyield+ chunked' remainder++ Nothing -> return ()++-- *Type synonyms+type ChannelName a = a+type NickName a = a+type ServerName a = a+type Reason a = Maybe a+type IsModeSet = Bool+type ModeFlag a = a+type ModeArg a = a+type NumericArg a = a++-- |The target of a message. Will be a nick or channel name.+type Target a = a++type IrcEvent = Event ByteString+type IrcSource = Source ByteString+type IrcMessage = Message ByteString++-- *Messages++-- |A decoded IRC message + source.+data Event a = Event+ { _raw :: ByteString+ -- ^The message as a bytestring.+ , _source :: Source a+ -- ^The source of the message (user, channel, or server).+ , _message :: Message a+ -- ^The decoded message. This will never be a 'RawMsg'.+ }+ deriving (Eq, Functor, Show)++-- |The source of an IRC message.+data Source a = User (NickName a)+ -- ^The message comes directly from a user.+ | Channel (ChannelName a) (NickName a)+ -- ^The message comes from a user in a channel.+ | Server (ServerName a)+ -- ^The message comes directly from the server.+ deriving (Eq, Functor, Show)++-- |A decoded IRC message.+data Message a = Privmsg (Target a) (Either CTCPByteString a)+ -- ^A message, either from a user or to a channel the+ -- client is in. CTCPs are distinguished by starting+ -- and ending with a \\001 (SOH).+ | Notice (Target a) (Either CTCPByteString a)+ -- ^Like a privmsg, but should not provoke an automatic+ -- response.+ | Nick (NickName a)+ -- ^Someone has updated their nick.+ | Join (ChannelName a)+ -- ^Someone has joined a channel.+ | Part (ChannelName a) (Reason a)+ -- ^Someone has left a channel.+ | Quit (Reason a)+ -- ^Someone has left the network.+ | Mode (Target a) IsModeSet [ModeFlag a] [ModeArg a]+ -- ^Someone has set some channel modes or user modes.+ | Topic (ChannelName a) a+ -- ^Someone has set the topic of a channel.+ | Invite (ChannelName a) (NickName a)+ -- ^The client has been invited to a channel.+ | Kick (ChannelName a) (NickName a) (Reason a)+ -- ^Someone has been kicked from a channel.+ | Ping (ServerName a) (Maybe (ServerName a))+ -- ^The client has received a server ping, and should+ -- send a pong asap.+ | Pong (ServerName a)+ -- ^A pong sent to the named server.+ | Numeric Int [NumericArg a]+ -- ^One of the many server numeric responses.+ | RawMsg a+ -- ^Never produced by decoding, but can be used to send+ -- arbitrary bytestrings to the IRC server. Naturally,+ -- this should only be used when you are confident that+ -- the produced bytestring will be a valid IRC message.+ deriving (Eq, Functor, Show)++-- *Decoding messages++fromByteString :: ByteString -> Either ByteString IrcEvent+fromByteString bs = maybe (Left bs) Right $ uncurry (Event bs) <$> attemptDecode bs++-- |Attempt to decode a ByteString into a message, returning a Nothing+-- if either the source or the message can't be determined.+attemptDecode :: ByteString -> Maybe (IrcSource, IrcMessage)+attemptDecode bs = I.decode bs >>= decode'+ where+ decode' msg = case msg of+ -- Disambiguate PRIVMSG and NOTICE source by checking the first+ -- character of the target+ I.Message (Just (I.NickName n _ _)) "PRIVMSG" [t, m] | isChan t -> Just (Channel t n, privmsg t m)+ | otherwise -> Just (User n, privmsg t m)++ I.Message (Just (I.NickName n _ _)) "NOTICE" [t, m] | isChan t -> Just (Channel t n, notice t m)+ | otherwise -> Just (User n, notice t m)++ I.Message (Just (I.NickName n _ _)) "NICK" [n'] -> Just (User n, Nick n')+ I.Message (Just (I.NickName n _ _)) "JOIN" [c] -> Just (Channel c n, Join c)+ I.Message (Just (I.NickName n _ _)) "PART" (c:r) -> Just (Channel c n, Part c $ listToMaybe r)+ I.Message (Just (I.NickName n _ _)) "QUIT" r -> Just (User n, Quit $ listToMaybe r)+ I.Message (Just (I.NickName n _ _)) "KICK" (c:u:r) -> Just (Channel c n, Kick c u $ listToMaybe r)+ I.Message (Just (I.NickName n _ _)) "INVITE" [_, c] -> Just (User n, Invite c n)+ I.Message (Just (I.NickName n _ _)) "TOPIC" [c, t] -> Just (Channel c n, Topic c t)++ I.Message (Just (I.NickName n _ _)) "MODE" (t:fs:as) | n == t -> (User n,) <$> mode t fs as+ | otherwise -> (Channel t n,) <$> mode t fs as++ I.Message (Just (I.Server s)) "PING" (s1:s2) -> Just (Server s, Ping s1 $ listToMaybe s2)+ I.Message Nothing "PING" (s1:s2) -> Just (Server s1, Ping s1 $ listToMaybe s2)++ I.Message (Just (I.Server s)) n args | isNumeric n -> (Server s,) <$> numeric n args++ _ -> Nothing++ -- An IRC channel name can start with '#', '&', '+', or '!', all+ -- of which have different meanings. However, most servers only+ -- support '#'.+ isChan t = B.take 1 t `elem` ["#", "&", "+", "!"]++ -- Check if the message looks like a ctcp or not, and produce the appropriate message type.+ privmsg t = Privmsg t . (Right `orCTCP` Left)+ notice t = Notice t . (Right `orCTCP` Left)++ -- Decode a set of mode changes+ mode t fs as = case unpack fs of+ (f:fs') | f == fromIntegral (ord '+') -> Just $ Mode t True (map singleton fs') as+ | f == fromIntegral (ord '-') -> Just $ Mode t False (map singleton fs') as+ _ -> Nothing++ -- Parse the number in a numeric response+ isNumeric = isJust . (readMaybe :: String -> Maybe Int) . B8.unpack+ numeric n args = flip Numeric args <$> readMaybe (B8.unpack n)++-- *Encoding messages++-- |Encode an IRC message into a single bytestring suitable for+-- sending to the server.+toByteString :: IrcMessage -> ByteString+toByteString (Privmsg t (Left ctcpbs)) = mkMessage "PRIVMSG" [t, getUnderlyingByteString ctcpbs]+toByteString (Privmsg t (Right bs)) = mkMessage "PRIVMSG" [t, bs]+toByteString (Notice t (Left ctcpbs)) = mkMessage "NOTICE" [t, getUnderlyingByteString ctcpbs]+toByteString (Notice t (Right bs)) = mkMessage "NOTICE" [t, bs]+toByteString (Nick n) = mkMessage "NICK" [n]+toByteString (Join c) = mkMessage "JOIN" [c]+toByteString (Part c (Just r)) = mkMessage "PART" [c, r]+toByteString (Part c Nothing) = mkMessage "PART" [c]+toByteString (Quit (Just r)) = mkMessage "QUIT" [r]+toByteString (Quit Nothing) = mkMessage "QUIT" []+toByteString (Mode t True ms as) = mkMessage "MODE" $ t : ("+" <> B.concat ms) : as+toByteString (Mode t False ms as) = mkMessage "MODE" $ t : ("-" <> B.concat ms) : as+toByteString (Invite c n) = mkMessage "INVITE" [c, n]+toByteString (Topic c bs) = mkMessage "TOPIC" [c, bs]+toByteString (Kick c n (Just r)) = mkMessage "KICK" [c, n, r]+toByteString (Kick c n Nothing) = mkMessage "KICK" [c, n]+toByteString (Ping s1 (Just s2)) = mkMessage "PING" [s1, s2]+toByteString (Ping s1 Nothing) = mkMessage "PING" [s1]+toByteString (Pong s) = mkMessage "PONG" [s]+toByteString (Numeric n as) = mkMessage (fromString $ show n) as+toByteString (RawMsg bs) = bs++mkMessage :: ByteString -> [ByteString] -> ByteString+mkMessage cmd = I.encode . I.Message Nothing cmd++-- |Construct a raw message.+rawMessage :: ByteString+ -- ^The command+ -> [ByteString]+ -- ^The arguments+ -> IrcMessage+rawMessage cmd = RawMsg . mkMessage cmd
− Network/IRC/Conduit/Internal/Conduits.hs
@@ -1,64 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}---- |--- Module : Network.IRC.Conduit.Internal.Conduits--- Copyright : (c) 2016 Michael Walker--- License : MIT--- Maintainer : Michael Walker <mike@barrucadu.co.uk>--- Stability : experimental--- Portability : OverloadedStrings, RankNTypes------ Internal helper conduits. This module is NOT considered to form--- part of the public interface of this library.-module Network.IRC.Conduit.Internal.Conduits where--import Control.Arrow ((&&&))-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.ByteString (ByteString, isSuffixOf, singleton)-import Data.Conduit (Conduit, await, yield)-import Data.Monoid ((<>))--import qualified Data.ByteString as B---- |Split up incoming bytestrings into new lines.-chunked :: Monad m => Conduit ByteString m ByteString-chunked = chunked' ""- where- chunked' leftover = do- -- Wait for a value from upstream- val <- await-- case val of- Just val' ->- let- carriage = fromIntegral $ fromEnum '\r'- newline = fromIntegral $ fromEnum '\n'-- -- Split on '\n's, removing any stray '\r's (line endings- -- are usually '\r\n's, but this isn't certain).- bytes = B.filter (/=carriage) $ leftover <> val'- splitted = B.split newline bytes-- -- If the last chunk ends with a '\n', then we have a- -- complete message at the end, and can yield it- -- immediately. Otherwise, store the partial message to- -- prepend to the next bytestring received.- (toyield, remainder)- | singleton newline `isSuffixOf` bytes = (splitted, "")- | otherwise = init &&& last $ splitted-- in do- -- Yield all complete and nonempty messages, and loop.- mapM_ yield $ filter (not . B.null) toyield- chunked' remainder-- Nothing -> return ()---- |Throw an IO exception when the upstream conduit is closed.-exceptionalConduit :: MonadIO m => Conduit a m a-exceptionalConduit = do- val <- await- case val of- Just x -> yield x >> exceptionalConduit- Nothing -> liftIO . ioError $ userError "Upstream source closed."
− Network/IRC/Conduit/Internal/Messages.hs
@@ -1,199 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}---- |--- Module : Network.IRC.Conduit.Internal.Messages--- Copyright : (c) 2016 Michael Walker--- License : MIT--- Maintainer : Michael Walker <mike@barrucadu.co.uk>--- Stability : experimental--- Portability : DeriveFunctor, OverloadedStrings, TupleSections------ Internal IRC conduit types and utilities. This module is NOT--- considered to form part of the public interface of this library.-module Network.IRC.Conduit.Internal.Messages where--import Control.Applicative ((<$>))-import Data.ByteString (ByteString, singleton, unpack)-import Data.Char (ord)-import Data.Maybe (listToMaybe, isJust)-import Data.Monoid ((<>))-import Data.String (fromString)-import Network.IRC.CTCP (CTCPByteString, getUnderlyingByteString, orCTCP)-import Text.Read (readMaybe)--import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import qualified Network.IRC as I---- *Type synonyms-type ChannelName a = a-type NickName a = a-type ServerName a = a-type Reason a = Maybe a-type IsModeSet = Bool-type ModeFlag a = a-type ModeArg a = a-type NumericArg a = a---- |The target of a message. Will be a nick or channel name.-type Target a = a--type IrcEvent = Event ByteString-type IrcSource = Source ByteString-type IrcMessage = Message ByteString---- *Messages---- |A decoded IRC message + source.-data Event a = Event- { _raw :: ByteString- -- ^The message as a bytestring.- , _source :: Source a- -- ^The source of the message (user, channel, or server).- , _message :: Message a- -- ^The decoded message. This will never be a 'RawMsg'.- }- deriving (Eq, Functor, Show)---- |The source of an IRC message.-data Source a = User (NickName a)- -- ^The message comes directly from a user.- | Channel (ChannelName a) (NickName a)- -- ^The message comes from a user in a channel.- | Server (ServerName a)- -- ^The message comes directly from the server.- deriving (Eq, Functor, Show)---- |A decoded IRC message.-data Message a = Privmsg (Target a) (Either CTCPByteString a)- -- ^A message, either from a user or to a channel the- -- client is in. CTCPs are distinguished by starting- -- and ending with a \\001 (SOH).- | Notice (Target a) (Either CTCPByteString a)- -- ^Like a privmsg, but should not provoke an automatic- -- response.- | Nick (NickName a)- -- ^Someone has updated their nick.- | Join (ChannelName a)- -- ^Someone has joined a channel.- | Part (ChannelName a) (Reason a)- -- ^Someone has left a channel.- | Quit (Reason a)- -- ^Someone has left the network.- | Mode (Target a) IsModeSet [ModeFlag a] [ModeArg a]- -- ^Someone has set some channel modes or user modes.- | Topic (ChannelName a) a- -- ^Someone has set the topic of a channel.- | Invite (ChannelName a) (NickName a)- -- ^The client has been invited to a channel.- | Kick (ChannelName a) (NickName a) (Reason a)- -- ^Someone has been kicked from a channel.- | Ping (ServerName a) (Maybe (ServerName a))- -- ^The client has received a server ping, and should- -- send a pong asap.- | Pong (ServerName a)- -- ^A pong sent to the named server.- | Numeric Int [NumericArg a]- -- ^One of the many server numeric responses.- | RawMsg a- -- ^Never produced by decoding, but can be used to send- -- arbitrary bytestrings to the IRC server. Naturally,- -- this should only be used when you are confident that- -- the produced bytestring will be a valid IRC message.- deriving (Eq, Functor, Show)---- *Decoding messages--fromByteString :: ByteString -> Either ByteString IrcEvent-fromByteString bs = maybe (Left bs) Right $ uncurry (Event bs) <$> attemptDecode bs---- |Attempt to decode a ByteString into a message, returning a Nothing--- if either the source or the message can't be determined.-attemptDecode :: ByteString -> Maybe (IrcSource, IrcMessage)-attemptDecode bs = I.decode bs >>= decode'- where- decode' msg = case msg of- -- Disambiguate PRIVMSG and NOTICE source by checking the first- -- character of the target- I.Message (Just (I.NickName n _ _)) "PRIVMSG" [t, m] | isChan t -> Just (Channel t n, privmsg t m)- | otherwise -> Just (User n, privmsg t m)-- I.Message (Just (I.NickName n _ _)) "NOTICE" [t, m] | isChan t -> Just (Channel t n, notice t m)- | otherwise -> Just (User n, notice t m)-- I.Message (Just (I.NickName n _ _)) "NICK" [n'] -> Just (User n, Nick n')- I.Message (Just (I.NickName n _ _)) "JOIN" [c] -> Just (Channel c n, Join c)- I.Message (Just (I.NickName n _ _)) "PART" (c:r) -> Just (Channel c n, Part c $ listToMaybe r)- I.Message (Just (I.NickName n _ _)) "QUIT" r -> Just (User n, Quit $ listToMaybe r)- I.Message (Just (I.NickName n _ _)) "KICK" (c:u:r) -> Just (Channel c n, Kick c u $ listToMaybe r)- I.Message (Just (I.NickName n _ _)) "INVITE" [_, c] -> Just (User n, Invite c n)- I.Message (Just (I.NickName n _ _)) "TOPIC" [c, t] -> Just (Channel c n, Topic c t)-- I.Message (Just (I.NickName n _ _)) "MODE" (t:fs:as) | n == t -> (User n,) <$> mode t fs as- | otherwise -> (Channel t n,) <$> mode t fs as-- I.Message (Just (I.Server s)) "PING" (s1:s2) -> Just (Server s, Ping s1 $ listToMaybe s2)- I.Message Nothing "PING" (s1:s2) -> Just (Server s1, Ping s1 $ listToMaybe s2)-- I.Message (Just (I.Server s)) n args | isNumeric n -> (Server s,) <$> numeric n args-- _ -> Nothing-- -- An IRC channel name can start with '#', '&', '+', or '!', all- -- of which have different meanings. However, most servers only- -- support '#'.- isChan t = B.take 1 t `elem` ["#", "&", "+", "!"]-- -- Check if the message looks like a ctcp or not, and produce the appropriate message type.- privmsg t = Privmsg t . (Right `orCTCP` Left)- notice t = Notice t . (Right `orCTCP` Left)-- -- Decode a set of mode changes- mode t fs as = case unpack fs of- (f:fs') | f == fromIntegral (ord '+') -> Just $ Mode t True (map singleton fs') as- | f == fromIntegral (ord '-') -> Just $ Mode t False (map singleton fs') as- _ -> Nothing-- -- Parse the number in a numeric response- isNumeric = isJust . (readMaybe :: String -> Maybe Int) . B8.unpack- numeric n args = flip Numeric args <$> readMaybe (B8.unpack n)---- *Encoding messages---- |Encode an IRC message into a single bytestring suitable for--- sending to the server.-toByteString :: IrcMessage -> ByteString-toByteString (Privmsg t (Left ctcpbs)) = mkMessage "PRIVMSG" [t, getUnderlyingByteString ctcpbs]-toByteString (Privmsg t (Right bs)) = mkMessage "PRIVMSG" [t, bs]-toByteString (Notice t (Left ctcpbs)) = mkMessage "NOTICE" [t, getUnderlyingByteString ctcpbs]-toByteString (Notice t (Right bs)) = mkMessage "NOTICE" [t, bs]-toByteString (Nick n) = mkMessage "NICK" [n]-toByteString (Join c) = mkMessage "JOIN" [c]-toByteString (Part c (Just r)) = mkMessage "PART" [c, r]-toByteString (Part c Nothing) = mkMessage "PART" [c]-toByteString (Quit (Just r)) = mkMessage "QUIT" [r]-toByteString (Quit Nothing) = mkMessage "QUIT" []-toByteString (Mode t True ms as) = mkMessage "MODE" $ t : ("+" <> B.concat ms) : as-toByteString (Mode t False ms as) = mkMessage "MODE" $ t : ("-" <> B.concat ms) : as-toByteString (Invite c n) = mkMessage "INVITE" [c, n]-toByteString (Topic c bs) = mkMessage "TOPIC" [c, bs]-toByteString (Kick c n (Just r)) = mkMessage "KICK" [c, n, r]-toByteString (Kick c n Nothing) = mkMessage "KICK" [c, n]-toByteString (Ping s1 (Just s2)) = mkMessage "PING" [s1, s2]-toByteString (Ping s1 Nothing) = mkMessage "PING" [s1]-toByteString (Pong s) = mkMessage "PONG" [s]-toByteString (Numeric n as) = mkMessage (fromString $ show n) as-toByteString (RawMsg bs) = bs--mkMessage :: ByteString -> [ByteString] -> ByteString-mkMessage cmd = I.encode . I.Message Nothing cmd---- |Construct a raw message.-rawMessage :: ByteString- -- ^The command- -> [ByteString]- -- ^The arguments- -> IrcMessage-rawMessage cmd = RawMsg . mkMessage cmd
irc-conduit.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.2.1.0+version: 0.2.1.1 -- A short (one-line) description of the package. synopsis: Streaming IRC message library using conduits.@@ -68,8 +68,6 @@ -- Modules exported by the library. exposed-modules: Network.IRC.Conduit , Network.IRC.Conduit.Internal- , Network.IRC.Conduit.Internal.Conduits- , Network.IRC.Conduit.Internal.Messages -- Modules included in this library but not exported. -- other-modules: @@ -108,4 +106,4 @@ source-repository this type: git location: https://github.com/barrucadu/irc-conduit.git- tag: 0.2.1.0+ tag: 0.2.1.1