packages feed

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 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