irc-fun-messages (empty) → 0.1.0.0
raw patch · 21 files changed
+2380/−0 lines, 21 filesdep +basedep +regex-applicativesetup-changed
Dependencies added: base, regex-applicative
Files
- AUTHORS +1/−0
- COPYING +121/−0
- ChangeLog +17/−0
- INSTALL +13/−0
- NEWS +23/−0
- README +14/−0
- Setup.hs +2/−0
- irc-fun-messages.cabal +50/−0
- src/Network/IRC/Fun/Messages.hs +37/−0
- src/Network/IRC/Fun/Messages/Internal/Parse.hs +329/−0
- src/Network/IRC/Fun/Messages/Internal/Serialize.hs +212/−0
- src/Network/IRC/Fun/Messages/Internal/Tokens/Message.hs +78/−0
- src/Network/IRC/Fun/Messages/Internal/Tokens/Other.hs +48/−0
- src/Network/IRC/Fun/Messages/Internal/Tokens/Reply.hs +42/−0
- src/Network/IRC/Fun/Messages/Internal/Tokens/Target.hs +122/−0
- src/Network/IRC/Fun/Messages/Internal/Tokens/Wildcards.hs +47/−0
- src/Network/IRC/Fun/Messages/Internal/Types.hs +881/−0
- src/Network/IRC/Fun/Messages/Mask.hs +69/−0
- src/Network/IRC/Fun/Messages/Modes.hs +188/−0
- src/Network/IRC/Fun/Messages/TypeAliases.hs +35/−0
- src/Network/IRC/Fun/Messages/Types.hs +51/−0
+ AUTHORS view
@@ -0,0 +1,1 @@+fr33domlover <fr33domlover@riseup.net>
+ COPYING view
@@ -0,0 +1,121 @@+Creative Commons Legal Code++CC0 1.0 Universal++ CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE+ LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN+ ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS+ INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES+ REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS+ PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM+ THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED+ HEREUNDER.++Statement of Purpose++The laws of most jurisdictions throughout the world automatically confer+exclusive Copyright and Related Rights (defined below) upon the creator+and subsequent owner(s) (each and all, an "owner") of an original work of+authorship and/or a database (each, a "Work").++Certain owners wish to permanently relinquish those rights to a Work for+the purpose of contributing to a commons of creative, cultural and+scientific works ("Commons") that the public can reliably and without fear+of later claims of infringement build upon, modify, incorporate in other+works, reuse and redistribute as freely as possible in any form whatsoever+and for any purposes, including without limitation commercial purposes.+These owners may contribute to the Commons to promote the ideal of a free+culture and the further production of creative, cultural and scientific+works, or to gain reputation or greater distribution for their Work in+part through the use and efforts of others.++For these and/or other purposes and motivations, and without any+expectation of additional consideration or compensation, the person+associating CC0 with a Work (the "Affirmer"), to the extent that he or she+is an owner of Copyright and Related Rights in the Work, voluntarily+elects to apply CC0 to the Work and publicly distribute the Work under its+terms, with knowledge of his or her Copyright and Related Rights in the+Work and the meaning and intended legal effect of CC0 on those rights.++1. Copyright and Related Rights. A Work made available under CC0 may be+protected by copyright and related or neighboring rights ("Copyright and+Related Rights"). Copyright and Related Rights include, but are not+limited to, the following:++ i. the right to reproduce, adapt, distribute, perform, display,+ communicate, and translate a Work;+ ii. moral rights retained by the original author(s) and/or performer(s);+iii. publicity and privacy rights pertaining to a person's image or+ likeness depicted in a Work;+ iv. rights protecting against unfair competition in regards to a Work,+ subject to the limitations in paragraph 4(a), below;+ v. rights protecting the extraction, dissemination, use and reuse of data+ in a Work;+ vi. database rights (such as those arising under Directive 96/9/EC of the+ European Parliament and of the Council of 11 March 1996 on the legal+ protection of databases, and under any national implementation+ thereof, including any amended or successor version of such+ directive); and+vii. other similar, equivalent or corresponding rights throughout the+ world based on applicable law or treaty, and any national+ implementations thereof.++2. Waiver. To the greatest extent permitted by, but not in contravention+of, applicable law, Affirmer hereby overtly, fully, permanently,+irrevocably and unconditionally waives, abandons, and surrenders all of+Affirmer's Copyright and Related Rights and associated claims and causes+of action, whether now known or unknown (including existing as well as+future claims and causes of action), in the Work (i) in all territories+worldwide, (ii) for the maximum duration provided by applicable law or+treaty (including future time extensions), (iii) in any current or future+medium and for any number of copies, and (iv) for any purpose whatsoever,+including without limitation commercial, advertising or promotional+purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each+member of the public at large and to the detriment of Affirmer's heirs and+successors, fully intending that such Waiver shall not be subject to+revocation, rescission, cancellation, termination, or any other legal or+equitable action to disrupt the quiet enjoyment of the Work by the public+as contemplated by Affirmer's express Statement of Purpose.++3. Public License Fallback. Should any part of the Waiver for any reason+be judged legally invalid or ineffective under applicable law, then the+Waiver shall be preserved to the maximum extent permitted taking into+account Affirmer's express Statement of Purpose. In addition, to the+extent the Waiver is so judged Affirmer hereby grants to each affected+person a royalty-free, non transferable, non sublicensable, non exclusive,+irrevocable and unconditional license to exercise Affirmer's Copyright and+Related Rights in the Work (i) in all territories worldwide, (ii) for the+maximum duration provided by applicable law or treaty (including future+time extensions), (iii) in any current or future medium and for any number+of copies, and (iv) for any purpose whatsoever, including without+limitation commercial, advertising or promotional purposes (the+"License"). The License shall be deemed effective as of the date CC0 was+applied by Affirmer to the Work. Should any part of the License for any+reason be judged legally invalid or ineffective under applicable law, such+partial invalidity or ineffectiveness shall not invalidate the remainder+of the License, and in such case Affirmer hereby affirms that he or she+will not (i) exercise any of his or her remaining Copyright and Related+Rights in the Work or (ii) assert any associated claims and causes of+action with respect to the Work, in either case contrary to Affirmer's+express Statement of Purpose.++4. Limitations and Disclaimers.++ a. No trademark or patent rights held by Affirmer are waived, abandoned,+ surrendered, licensed or otherwise affected by this document.+ b. Affirmer offers the Work as-is and makes no representations or+ warranties of any kind concerning the Work, express, implied,+ statutory or otherwise, including without limitation warranties of+ title, merchantability, fitness for a particular purpose, non+ infringement, or the absence of latent or other defects, accuracy, or+ the present or absence of errors, whether or not discoverable, all to+ the greatest extent permissible under applicable law.+ c. Affirmer disclaims responsibility for clearing rights of other persons+ that may apply to the Work or any use thereof, including without+ limitation any person's Copyright and Related Rights in the Work.+ Further, Affirmer disclaims responsibility for obtaining any necessary+ consents, permissions or other rights required for any use of the+ Work.+ d. Affirmer understands and acknowledges that Creative Commons is not a+ party to this document and has no duty or obligation with respect to+ this CC0 or use of the Work.
+ ChangeLog view
@@ -0,0 +1,17 @@+The changes are recorded by the version control system, Darcs. To see a log+quickly from the terminal, run:++ $ darcs changes --repo http://dev.rel4tion.org/fr33domlover/irc-fun-messages++There is also a web interface at <http://darcs.rel4tion.org> which, among other+things, can display the history log.++To see the log in a local clone, first get a copy of the repository if you+haven't yet:++ $ darcs get http://dev.rel4tion.org/fr33domlover/irc-fun-messages++Then move into the newly created directory and run darcs:++ $ cd irc-fun-messages+ $ darcs changes
+ INSTALL view
@@ -0,0 +1,13 @@+Install from Hackage:++ $ cabal install irc-fun-messages++Install from unpacked release tarball or source repo:++ $ cd irc-fun-messages+ $ cabal install++Just play with it without installing:++ $ cabal build+ $ cabal repl
+ NEWS view
@@ -0,0 +1,23 @@+This file lists the user-visible interesting changes between releases. For a+full list of changes to the source, see the ChangeLog.++++irc-fun-messages 0.1.0.0 -- 2015-08-09+======================================++General, build and documentation changes:++* (This is the first release, so everything is new)++New APIs, features and enhancements:++* (This is the first release, so everything is a new feature)++Bug fixes:++* (This is the first release)++Dependency changes:++* (No dependencies at this point)
+ README view
@@ -0,0 +1,14 @@+See the .cabal file for more info and link to project website the version+control.++The official download location is Hackage:++<http://hackage.haskell.org/package/irc-fun-messages>++This library is free software, and is committed to software freedom. It is+released to the public domain using the CC0 Public Domain Dedication. For the+boring "legal" details see the file 'COPYING'.++See the file 'INSTALL' for hints on installation. The file 'ChangeLog' explains+how to see the history log of the changes done in the code. 'NEWS' provides a+friendly overview of the changes for each release.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ irc-fun-messages.cabal view
@@ -0,0 +1,50 @@+name: irc-fun-messages+version: 0.1.0.0+synopsis: Types and functions for working with the IRC protocol.+description:+ Another IRC library. It doesn't provide a client API though. It just provides+ datatypes, and functions for parsing and serializing IRC commands and+ replies.+ .+ The package is based on RFC 2812, with modifications and extensions to work+ with Freenode.+ .+ NOTE: The handling of IRC protocol messages is FAR from complete, but there+ is enough to e.g. create a basic IRC bot. Missing features are being added as+ needed while working on <http://rel4tion.org/projects/funbot FunBot>, and of+ course patches are welcome.+homepage: http://rel4tion.org/projects/irc-fun-messages/+bug-reports: http://rel4tion.org/projects/irc-fun-messages/tickets/+license: PublicDomain+license-file: COPYING+author: fr33domlover+maintainer: fr33domlover@riseup.net+copyright: ♡ Copying is an act of love. Please copy, reuse and share.+category: Data+build-type: Simple+extra-source-files: AUTHORS ChangeLog COPYING INSTALL NEWS README+cabal-version: >=1.10++source-repository head+ type: darcs+ location: http://dev.rel4tion.org/fr33domlover/irc-fun-messages++library+ exposed-modules: Network.IRC.Fun.Messages+ , Network.IRC.Fun.Messages.Mask+ , Network.IRC.Fun.Messages.Modes+ , Network.IRC.Fun.Messages.TypeAliases+ , Network.IRC.Fun.Messages.Types+ other-modules: Network.IRC.Fun.Messages.Internal.Parse+ , Network.IRC.Fun.Messages.Internal.Serialize+ , Network.IRC.Fun.Messages.Internal.Tokens.Message+ , Network.IRC.Fun.Messages.Internal.Tokens.Other+ , Network.IRC.Fun.Messages.Internal.Tokens.Reply+ , Network.IRC.Fun.Messages.Internal.Tokens.Target+ , Network.IRC.Fun.Messages.Internal.Tokens.Wildcards+ , Network.IRC.Fun.Messages.Internal.Types+ -- other-extensions: + build-depends: base >=4.7 && <5+ , regex-applicative >=0.3.1+ hs-source-dirs: src+ default-language: Haskell2010
+ src/Network/IRC/Fun/Messages.hs view
@@ -0,0 +1,37 @@+{- This file is part of irc-fun-messages.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++-- | This module handles parsing and serializing IRC messages and replies.+-- Types and other functionality are provided in the submodules.+module Network.IRC.Fun.Messages+ ( -- * Parsing+ parseMessage+ , messageIsReply+ , messageToReply+ , parse+ , analyzeMessage+ , analyzeReply+ , analyze+ -- * Serializing+ , buildMessage+ , buildReply+ , messageFromReply+ , serializeMessage+ , serializeReply+ )+where++import Network.IRC.Fun.Messages.Internal.Parse+import Network.IRC.Fun.Messages.Internal.Serialize
+ src/Network/IRC/Fun/Messages/Internal/Parse.hs view
@@ -0,0 +1,329 @@+{- This file is part of irc-fun-messages.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module Network.IRC.Fun.Messages.Internal.Parse+ ( -- * Parsing+ parseMessage+ , messageIsReply+ , messageToReply+ , parse+ -- * Analysis+ , analyzeMessage+ , analyzeReply+ , analyze+ )+where++import Data.Bits (testBit)+import Data.Char (toUpper)+import Data.List (isSuffixOf)+--import Data.Maybe (fromMaybe)+import Network.IRC.Fun.Messages.Mask (parseMask)+import Network.IRC.Fun.Messages.Modes (parseUserMode)+import qualified Network.IRC.Fun.Messages.Internal.Tokens.Message as T+import qualified Network.IRC.Fun.Messages.Internal.Tokens.Other as T+import qualified Network.IRC.Fun.Messages.Internal.Tokens.Reply as T+import qualified Network.IRC.Fun.Messages.Internal.Tokens.Target as T+import Network.IRC.Fun.Messages.Internal.Types+import Text.Regex.Applicative+import Text.Regex.Applicative.Common (decimal)++-------------------------------------------------------------------------------+-- Parsing+-------------------------------------------------------------------------------++-- | Parse a raw IRC message string into a generic message structure.+parseMessage :: String -> Maybe GenericMessage+parseMessage s =+ match T.message $ if "\r\n" `isSuffixOf` s then s else s ++ "\r\n"++-- | Check is a given message is a server reply, i.e. has a numeric command and+-- the sender is a server.+messageIsReply :: GenericMessage -> Bool+messageIsReply msg =+ let prefOk =+ case prefix msg of+ Nothing -> False+ Just (Server _) -> True+ Just (Nick {}) -> False+ cmdOk =+ case command msg of+ StringCommand _ -> False+ NumericCommand _ -> True+ in prefOk && cmdOk++-- | Try to convert a generic message into a matching reply value. If+-- successful, return 'Right' the reply. If the message isn't a reply, return+-- 'Left' an error message.+messageToReply :: GenericMessage -> Either String GenericReply+messageToReply msg =+ case (prefix msg, command msg, parameters msg) of+ (Just (Server s), NumericCommand n, p : ps) ->+ Right GenericReply+ { sender = s+ , code = n+ , target = NickTarget p+ , params = ps+ }+ (Just (Server _), NumericCommand _, []) ->+ Left "No parameters, must have at least one"+ (Just (Nick {}), NumericCommand _, _) ->+ Left "Sender prefix is a user, not a server"+ (Nothing, NumericCommand _, _) ->+ Left "No sender prefix"+ (_, StringCommand _, _) ->+ Left "Command is not numeric"++-- | Parse a raw IRC message string into a generic message structure. If the+-- message is detected to be a server reply, a generic reply structure is+-- returned.+--+-- This is essentially a combination of 'parseMessage' and 'messageToReply'.+parse :: String -> Maybe (Either GenericReply GenericMessage)+parse s =+ case parseMessage s of+ Nothing -> Nothing+ Just msg -> Just $ either (const $ Right msg) Left $ messageToReply msg++-------------------------------------------------------------------------------+-- Analysis+-------------------------------------------------------------------------------++analyzeMessage' :: Maybe Prefix+ -> String+ -> [Parameter]+ -> Either String Message+analyzeMessage' prefix cmd params =+ case map toUpper cmd of+ -- Connection registration+ "PASS" ->+ case params of+ [pass] -> Right $ PassMessage pass+ [] -> Left "Password missing"+ _ -> Left "Too many parameters"+ "NICK" ->+ case params of+ [nick] -> Right $ NickMessage nick+ [] -> Left "Nickname missing"+ _ -> Left "Too many parameters"+ "USER" ->+ case params of+ [user, mode, _, realname] ->+ case match decimal mode :: Maybe Int of+ (Just m) -> Right $ UserMessage user+ (testBit m 3)+ (testBit m 2)+ realname+ Nothing -> Left "<mode> should be a number"+ [_:_:_:_:_:_] -> Left "Too many parameters"+ _ -> Left "Too few parameters"+ "OPER" ->+ case params of+ [name, pass] -> Right $ OperMessage name pass+ [_:_:_:_] -> Left "Too many parameters"+ _ -> Left "Too few parameters"+ "MODE" ->+ case params of+ (first:rest) ->+ case (match T.nickname first, match T.channel first) of+ (Just nick, _) ->+ case rest of+ [mode] ->+ case parseUserMode mode of+ Just (remove, add) ->+ Right $ UserModeMessage nick+ remove+ add+ Nothing ->+ Left "Invalid user mode string"+ [] -> Left "Too few parameters"+ _ -> Left "Too many parameters"+ (Nothing, Just chan) -> Left "Not implemented yet"+ {-case parseChannelModeParams rest of+ Just X ->+ Nothing ->-}+ _ -> Left "First parameter invalid"+ _ ->+ Left "Too new parameters"+ "SERVICE" ->+ case params of+ [nick, _, dist, _, _, info] ->+ case parseMask dist of+ Just m -> Right $ ServiceMessage nick m info+ Nothing -> Left "Distribution mask invalid"+ [_:_:_:_:_:_:_:_] -> Left "Too many parameters"+ _ -> Left "Too few parameters"+ "QUIT" ->+ case params of+ [] -> Right $ QuitMessage Nothing+ [msg] -> Right $ QuitMessage (Just msg)+ _ -> Left "Too many parameters"+ "SQUIT" ->+ case params of+ [server, comment] -> Right $ SQuitMessage server comment+ [_:_:_:_] -> Left "Too many parameters"+ _ -> Left "Too few parameters"+ -- Channel operations+ "JOIN" ->+ case params of+ ["0"] -> Right $ JoinMessage Nothing+ [channels] ->+ let c = (:) <$> T.channel <*> many (sym ',' *> T.channel)+ in case match c channels of+ Just cs -> Right $ JoinMessage $ Just (cs, [])+ _ -> Left "Invalid parameters"+ [channels, keys] ->+ let c = (:) <$> T.channel <*> many (sym ',' *> T.channel)+ k = (:) <$> T.key <*> many (sym ',' *> T.key)+ in case (match c channels, match k keys) of+ (Just cs, Just ks) ->+ Right $ JoinMessage $ Just (cs, ks)+ _ ->+ Left "Invalid parameters"+ _ -> Left "Invalid parameters"+ "PART" ->+ case params of+ [channels] ->+ case match c channels of+ Just cs -> Right $ PartMessage cs Nothing+ Nothing -> Left "Invalid channel list"+ [channels, msg] ->+ case match c channels of+ Just cs -> Right $ PartMessage cs $ Just msg+ Nothing -> Left "Invalid channel list"+ _ -> Left "Wrong number of parameters"+ where+ c = (:) <$> T.channel <*> many (sym ',' *> T.channel)+ -- "MODE" -> Channel mode handled by MODE above+ "TOPIC" ->+ case params of+ [channel] -> Right $ TopicMessage channel Nothing+ [channel, topic] -> Right $ TopicMessage channel $ Just topic+ [] -> Left "No parameters given"+ _ -> Left "Too many parameters"+ "NAMES" -> Left "Not implemented yet"+ "LIST" -> Left "Not implemented yet"+ "INVITE" -> Left "Not implemented yet"+ "KICK" -> Left "Not implemented yet"+ -- Sending messages+ "PRIVMSG" ->+ case params of+ [target, text] ->+ case match T.msgto target of+ Nothing -> Left $ "Invalid message target: " ++ target+ Just t -> Right $ PrivMsgMessage t text+ (_:_:_:_) -> Left "Too many parameters"+ _ -> Left "Too few parameters"+ "NOTICE" ->+ case params of+ [target, text] ->+ case match T.msgto target of+ Nothing -> Left $ "Invalid notice target: " ++ target+ Just t -> Right $ NoticeMessage t text+ (_:_:_:_) -> Left "Too many parameters"+ _ -> Left "Too few parameters"+ -- Server queries and commands+ "MOTD" -> Left "Not implemented yet"+ "LUSERS" -> Left "Not implemented yet"+ "VERSION" -> Left "Not implemented yet"+ "STATS" -> Left "Not implemented yet"+ "LINKS" -> Left "Not implemented yet"+ "TIME" -> Left "Not implemented yet"+ "CONNECT" -> Left "Not implemented yet"+ "TRACE" -> Left "Not implemented yet"+ "ADMIN" -> Left "Not implemented yet"+ "INFO" -> Left "Not implemented yet"+ -- Service query and commands+ "SERVLIST" -> Left "Not implemented yet"+ "SQUERY" -> Left "Not implemented yet"+ -- User based queries+ "WHO" -> Left "Not implemented yet"+ "WHOIS" -> Left "Not implemented yet"+ "WHOWAS" -> Left "Not implemented yet"+ -- Miscellaneous messages+ "KILL" -> Left "Not implemented yet"+ "PING" ->+ case params of+ [] -> Left "No parameters given"+ [s] -> Right $ PingMessage s Nothing+ [s1, s2] -> Right $ PingMessage s1 (Just s2)+ _ -> Left "Too many parameters"+ "PONG" ->+ case params of+ [] -> Left "No parameters given"+ [s] -> Right $ PongMessage s Nothing+ [s1, s2] -> Right $ PongMessage s1 (Just s2)+ _ -> Left "Too many parameters"+ "ERROR" -> Left "Not implemented yet"+ -- Optional features+ "AWAY" -> Left "Not implemented yet"+ "REHASH" -> Left "Not implemented yet"+ "DIE" -> Left "Not implemented yet"+ "RESTART" -> Left "Not implemented yet"+ "SUMMON" -> Left "Not implemented yet"+ "USERS" -> Left "Not implemented yet"+ "WALLOPS" -> Left "Not implemented yet"+ "USERHOST" -> Left "Not implemented yet"+ "ISON" -> Left "Not implemented yet"+ _ -> Left "Unrecognized command"++-- | Read a generic message structure into specific message details. Return+-- 'Left' an error description if analysis fails. If the message is detected+-- to be a reply, return a generic reply structure without analyzing.+analyzeMessage :: GenericMessage+ -> Either String (Either GenericReply SpecificMessage)+analyzeMessage msg =+ if messageIsReply msg+ then fmap Left $ messageToReply msg+ else case command msg of+ StringCommand c ->+ fmap (Right . SpecificMessage (prefix msg)) $+ analyzeMessage' (prefix msg) c (parameters msg)+ _ ->+ Left "Implementation error"++analyzeReply' :: Int -> Target -> [Parameter] -> Either String Reply+analyzeReply' c _ params =+ case c of+ 353 ->+ case params of+ [priv, chan, nicks] ->+ maybe (Left "Invalid parameters") Right $ do+ chan' <- match T.channel chan+ priv' <- match T.chanpriv priv+ pnicks <- match T.prefnicks nicks+ return $ NamesReply priv' chan' pnicks+ (_:_:_:_:_) -> Left "Too many parameters"+ [] -> Left "Too few parameters"+ _ -> Left "Not implemented yet"++-- | Read a generic reply structure into specific reply details. Return+-- 'Left' an error description if analysis fails.+analyzeReply :: GenericReply -> Either String SpecificReply+analyzeReply gr =+ fmap (SpecificReply (sender gr) (target gr)) $+ analyzeReply' (code gr) (target gr) (params gr)++-- | Read a generic reply structure into specific message or reply details.+-- Return 'Left' an error description if analysis fails.+--+-- This is essentially a combination or 'analyzeMessage' and 'analyzeReply.+analyze :: GenericMessage+ -> Either String (Either SpecificReply SpecificMessage)+analyze gm =+ case analyzeMessage gm of+ Left e -> Left e+ Right (Left rpl) -> fmap Left $ analyzeReply rpl+ Right (Right msg) -> Right $ Right msg
+ src/Network/IRC/Fun/Messages/Internal/Serialize.hs view
@@ -0,0 +1,212 @@+{- This file is part of irc-fun-messages.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module Network.IRC.Fun.Messages.Internal.Serialize+ ( -- * Building+ buildMessage+ , buildReply+ , messageFromReply+ -- * Serializing+ , serializeMessage+ , serializeReply+ )+where++import Data.Bits (bit, zeroBits, (.|.))+--import Data.Char (toUpper)+import Data.List (intercalate)+import Data.Maybe (maybeToList)+import Network.IRC.Fun.Messages.Mask (serializeMask)+--import Network.IRC.Fun.Messages.Modes (parseUserMode)+--import Network.IRC.Fun.Messages.Reply (messageToReply, messageIsReply)+import Network.IRC.Fun.Messages.Internal.Types++-------------------------------------------------------------------------------+-- Building+-------------------------------------------------------------------------------++showAddr :: Address -> String+showAddr (IPv4 s) = s+showAddr (IPv6 s) = s++showHost :: Host -> String+showHost (HostName hn) = hn+showHost (HostAddr addr) = showAddr addr+showHost (HostCloak s) = s++showTargetMask :: TargetMask -> String+showTargetMask (HostMask m) = '#' : serializeMask m+showTargetMask (ServerMask m) = '$' : serializeMask m++showTarget :: MessageTarget -> String+showTarget (ChannelTarget chan) = chan+showTarget (UserTarget Nothing (Just (UserAddr user mhost)) (Just server)) =+ maybe user ((user ++) . ('%' :) . showHost) mhost ++ '@' : server+showTarget (UserTarget Nothing (Just (UserAddr user (Just host))) Nothing) =+ user ++ '%' : showHost host+showTarget (UserTarget (Just nick) Nothing Nothing) = nick+showTarget (UserTarget (Just nick) (Just (UserAddr user (Just host))) Nothing)+ = nick ++ '!' : user ++ '@' : showHost host+showTarget (MaskTarget mt) = showTargetMask mt+showTarget _ = "invalid_target"++-- Fill command name and parameters from specific message+buildMessage' :: Message -> (CommandName, [Parameter])+buildMessage' msg =+ case msg of+ PassMessage pass -> ("PASS", [pass])+ NickMessage nn -> ("NICK", [nn])+ UserMessage un i w rn ->+ ("USER", [un, show $ modebit 3 i .|. modebit 2 w, "*", rn])+ where+ modebit n b = if b then bit n else zeroBits :: Int+ OperMessage un p -> ("????", error "Not implemented")+ UserModeMessage n remove add -> ("????", error "Not implemented")+ ServiceMessage n m s -> ("????", error "Not implemented")+ QuitMessage reason -> ("QUIT", perhaps reason)+ SQuitMessage s t -> ("????", error "Not implemented")+ JoinMessage Nothing -> ("JOIN", ["0"])+ JoinMessage (Just (chans, keys)) ->+ ("JOIN", intercalate "," chans :+ if null keys then [] else [intercalate "," keys])+ PartMessage chans reason -> ("PART", intercalate "," chans ?: reason)+ ChannelModeMessage remove add -> ("????", error "Not implemented")+ TopicMessage chan topic -> ("TOPIC", chan ?: topic)+ NamesMessage chans serv -> ("????", error "Not implemented")+ ListMessage chans serv -> ("????", error "Not implemented")+ InviteMessage nn chan -> ("????", error "Not implemented")+ KickMessage chans users s -> ("????", error "Not implemented")+ PrivMsgMessage tgt text -> ("PRIVMSG", [showTarget tgt, text])+ NoticeMessage tgt text -> ("NOTICE", [showTarget tgt, text])+ MotdMessage serv -> ("????", error "Not implemented")+ LusersMessage serv -> ("????", error "Not implemented")+ VersionMessage serv -> ("????", error "Not implemented")+ StatsMessage x -> ("????", error "Not implemented")+ LinksMessage x -> ("????", error "Not implemented")+ TimeMessage serv -> ("????", error "Not implemented")+ ConnectMessage serv portn sm -> ("????", error "Not implemented")+ TraceMessage t -> ("????", error "Not implemented")+ AdminMessage t -> ("????", error "Not implemented")+ InfoMessage t -> ("????", error "Not implemented")+ ServlistMessage _ -> ("????", error "Not implemented")+ SQueryMessage _ _ -> ("????", error "Not implemented")+ WhoMessage _ -> ("????", error "Not implemented")+ WhoisMessage _ _ -> ("????", error "Not implemented")+ WhowasMessage _ _ -> ("????", error "Not implemented")+ KillMessage _ _ -> ("????", error "Not implemented")+ PingMessage s1 s2 -> ("PING", s1 ?: s2)+ PongMessage s1 s2 -> ("PONG", s1 ?: s2)+ ErrorMessage _ -> ("????", error "Not implemented")+ AwayMessage _ -> ("????", error "Not implemented")+ RehashMessage -> ("????", error "Not implemented")+ DieMessage -> ("????", error "Not implemented")+ RestartMessage -> ("????", error "Not implemented")+ SummonMessage _ _ -> ("????", error "Not implemented")+ UsersMessage _ -> ("????", error "Not implemented")+ WallopsMessage _ -> ("????", error "Not implemented")+ UserhostMessage _ -> ("????", error "Not implemented")+ IsonMessage _ -> ("????", error "Not implemented")+ where+ perhaps = maybeToList+ x ?: my = x : perhaps my++-- | Fill a generic message record using a specific message's details.+buildMessage :: SpecificMessage -> GenericMessage+buildMessage (SpecificMessage pref msg) =+ let (cmd, ps) = buildMessage' msg+ in GenericMessage pref (StringCommand cmd) ps++channelPrivacyChar :: ChannelPrivacy -> Char+channelPrivacyChar Secret = '@'+channelPrivacyChar Private = '*'+channelPrivacyChar Public = '='++privilegeChar :: Privilege -> Maybe Char+privilegeChar Regular = Nothing+privilegeChar Voice = Just '+'+privilegeChar Operator = Just '@'++-- Fill reply code, target and parameters from specific reply+buildReply' :: Reply -> (Int, [Parameter])+buildReply' reply =+ case reply of+ NamesReply priv chan pns ->+ ( 353+ , [ [channelPrivacyChar priv]+ , chan+ , unwords $+ map (\ (p, n) -> maybe n (: n) $ privilegeChar p) pns+ ]+ )+ _ -> error "Not implemented"++-- | Fill a generic reply record using a specific reply's details.+buildReply :: SpecificReply -> GenericReply+buildReply (SpecificReply sender tgt reply) =+ let (code, ps) = buildReply' reply+ in GenericReply sender code tgt ps++-- | Convert a reply, which is a message with a numeric command name, into a+-- generic message value.+messageFromReply :: GenericReply -> GenericMessage+messageFromReply reply = GenericMessage+ { prefix = Just $ Server $ sender reply+ , command = NumericCommand $ code reply+ , parameters = target' reply : params reply+ }+ where+ target' (GenericReply { target = NickTarget n }) = n+ target' (GenericReply { target = ServerTarget s }) = s++-------------------------------------------------------------------------------+-- Serializing+-------------------------------------------------------------------------------++serializePrefix :: Prefix -> String+serializePrefix (Server sn) = sn+serializePrefix (Nick n mu mh) = n+ ++ maybe "" ('!' :) mu+ ++ maybe "" (('@' :) . showHost) mh++serializeCommand :: Command -> String+serializeCommand (StringCommand s) = s+serializeCommand (NumericCommand n) = show n++serializeParams :: [Parameter] -> String+serializeParams = f . map (\ p -> if null p then "(?)" else p)+ where+ f [] = ""+ f l =+ let (ps, p) = (init l, last l)+ in concatMap (' ' :) ps ++ ' ' :+ if head p == ':' || ' ' `elem` p+ then ':' : p+ else p++-- | Write a message into an IRC protocol message formatted string.+serializeMessage :: GenericMessage -> String+serializeMessage msg = concat+ [ maybe "" (\ p -> ':' : serializePrefix p ++ " ") $ prefix msg+ , serializeCommand $ command msg+ , serializeParams $ parameters msg+ , "\r\n"+ ]++-- | Write a reply into an IRC protocol message formatted string.+--+-- This is essentially a combination of 'messageFromReply' and+-- 'serializeMessage'.+serializeReply :: GenericReply -> String+serializeReply = serializeMessage . messageFromReply
+ src/Network/IRC/Fun/Messages/Internal/Tokens/Message.hs view
@@ -0,0 +1,78 @@+{- This file is part of irc-fun-messages.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module Network.IRC.Fun.Messages.Internal.Tokens.Message+ ( message+ )+where++import Data.Maybe (fromMaybe)+import Network.IRC.Fun.Messages.Internal.Tokens.Other+import Network.IRC.Fun.Messages.Internal.Tokens.Target+import Network.IRC.Fun.Messages.Internal.Types hiding ( prefix+ , command+ , params )+import Text.Regex.Applicative++----------TOTO+{-+- go over errata, make sure everything here is correct+- some regexes, such as matchone and target, seem not to be used in the rules+ here. they're probably intended for later use, e.g. when matching a string+ against a mask. in such case the API should probably import them+-}++message :: Regex GenericMessage+message = GenericMessage <$> optional (sym ':' *> prefix <* space)+ <*> command+ <*> (fromMaybe [] <$> optional params)+ <* crlf++prefix :: Regex Prefix+prefix = Server <$> servername+ <|> nick <$> nickname+ <*> optional ((,) <$> optional (sym '!' *> user)+ <* sym '@'+ <*> host)+ where+ nick n Nothing = Nick n Nothing Nothing+ nick n (Just (u, h)) = Nick n u (Just h)++command :: Regex Command+command = StringCommand <$> some letter <|> f <$> digit <*> digit <*> digit+ where+ f a b c = NumericCommand $ read [a, b, c]++params :: Regex [Parameter]+params = f <$> many (space *> middle)+ <*> optional (space *> sym ':' *> trailing)+ where+ f m (Just t) = m ++ [t]+ f m Nothing = m++middle :: Regex Parameter+middle = (:) <$> paramchar <*> many (sym ':' <|> paramchar)++trailing :: Regex Parameter+trailing = many $ sym ':' <|> sym ' ' <|> paramchar++paramchar :: Regex Char+paramchar = psym (`notElem` "\0\r\n :")++space :: Regex Char+space = sym ' '++crlf :: Regex String+crlf = string "\r\n"
+ src/Network/IRC/Fun/Messages/Internal/Tokens/Other.hs view
@@ -0,0 +1,48 @@+{- This file is part of irc-fun-messages.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module Network.IRC.Fun.Messages.Internal.Tokens.Other+ ( user+ , key+ , letter+ , digit+ , hexdigit+ , special+ )+where++import Data.Char (isAscii, isDigit)+import Network.IRC.Fun.Messages.Internal.Types+import Text.Regex.Applicative++user :: Regex UserName+user = some $ psym (`notElem` "\0\r\n @")++key :: Regex ChannelKey+key = some $ psym $ \ c -> isAscii c && c `notElem` "\0\r\n\f\t\v "++letter :: Regex Char+letter = psym $ \ c -> 'A' <= c && c <= 'Z' || 'a' <= c && c <= 'z'++digit :: Regex Char+digit = psym isDigit++hexdigit :: Regex Char+hexdigit = digit <|> upperhex+ where+ upperhex = psym $ \ c -> 'A' <= c && c <= 'F'++special :: Regex Char+special = psym (`elem` "[]\\`_^{|}")
+ src/Network/IRC/Fun/Messages/Internal/Tokens/Reply.hs view
@@ -0,0 +1,42 @@+{- This file is part of irc-fun-messages.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module Network.IRC.Fun.Messages.Internal.Tokens.Reply+ ( chanpriv+ , prefnicks+ )+where++import Data.Maybe (fromMaybe)+import Network.IRC.Fun.Messages.Internal.Tokens.Target+import Network.IRC.Fun.Messages.Internal.Types+import Text.Regex.Applicative++-------------------------------------------------------------------------------+-- 353 RPL_NAMREPLY+-------------------------------------------------------------------------------++chanpriv :: Regex ChannelPrivacy+chanpriv = Secret <$ sym '@' <|> Private <$ sym '*' <|> Public <$ sym '='++prefnicks :: Regex [(Privilege, NickName)]+prefnicks = (:) <$> prefnick <*> many (sym ' ' *> prefnick)++prefnick :: Regex (Privilege, NickName)+prefnick = (,) <$> privilege <*> nickname++privilege :: Regex Privilege+privilege =+ fromMaybe Regular <$> optional (Voice <$ sym '+' <|> Operator <$ sym '@')
+ src/Network/IRC/Fun/Messages/Internal/Tokens/Target.hs view
@@ -0,0 +1,122 @@+{- This file is part of irc-fun-messages.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module Network.IRC.Fun.Messages.Internal.Tokens.Target+ ( target+ , msgtarget+ , msgto+ , channel+ , servername+ , host+ , nickname+ )+where++import Data.Char (isAsciiUpper)+import Network.IRC.Fun.Messages.Internal.Types hiding (target)+import Network.IRC.Fun.Messages.Internal.Tokens.Other+import Network.IRC.Fun.Messages.Internal.Tokens.Wildcards+import Text.Regex.Applicative++target :: Regex Target+target = NickTarget <$> nickname <|> ServerTarget <$> servername++msgtarget :: Regex [MessageTarget]+msgtarget = (:) <$> msgto <*> many (sym ',' *> msgto)++msgto :: Regex MessageTarget+msgto = ChannelTarget <$> channel+ <|> uhs <$> user+ <*> optional (sym '%' *> host) <* sym '@'+ <*> servername+ <|> uh <$> user <* sym '%'+ <*> host+ <|> MaskTarget <$> targetmask+ <|> nn <$> nickname+ <|> nuh <$> nickname <* sym '!'+ <*> user <* sym '@'+ <*> host+ where+ uhs u h s = UserTarget Nothing (Just (UserAddr u h)) (Just s)+ uh u h = UserTarget Nothing (Just (UserAddr u (Just h))) Nothing+ nn n = UserTarget (Just n) Nothing Nothing+ nuh n u h = UserTarget (Just n) (Just (UserAddr u (Just h))) Nothing++channel :: Regex ChannelName+channel = fmap snd $ withMatched $+ (sym '#' <|> sym '+' <|> sym '!' <* channelid <|> sym '&') <*+ chanstring <*+ optional (sym ':' <* chanstring)++servername :: Regex ServerName+servername = hostname++host :: Regex Host+host = HostName <$> hostname+ <|> HostAddr <$> hostaddr+ <|> HostCloak <$> hostcloak++hostname :: Regex String+hostname = snd <$> withMatched (shortname <* many (sym '.' <* shortname))++shortname :: Regex String+shortname =+ snd <$> withMatched+ ( (letter <|> digit) <*+ optional (many (letter <|> digit <|> sym '-') <* (letter <|> digit))+ )++hostaddr :: Regex Address+hostaddr = IPv4 <$> ip4addr <|> IPv6 <$> ip6addr++ip4addr :: Regex String+ip4addr = snd <$> withMatched (s <* p <* s <* p <* s <* p <* s)+ where+ d = digit+ s = snd <$> withMatched (d <|> d <* d <|> d <* d <* d)+ p = sym '.'++ip6addr :: Regex String+ip6addr = snd <$> withMatched (a <|> b)+ where+ h = some hexdigit+ c = sym ':'+ a = h <* c <* h <* c <*+ h <* c <* h <* c <*+ h <* c <* h <* c <*+ h <* c <* h <* c+ b = string "0:0:0:0:0:" <*+ (string "0" <|> string "FFFF") <*+ sym ':' <*+ ip4addr++hostcloak :: Regex String+hostcloak = some $ letter <|> digit <|> special <|> psym (`elem` ".-/")++nickname :: Regex NickName+nickname = (:) <$> (letter <|> special)+ <*> many (letter <|> digit <|> special <|> sym '-')++targetmask :: Regex TargetMask+targetmask = ServerMask <$> (sym '$' *> mask)+ <|> HostMask <$> (sym '#' *> mask)++chanstring :: Regex String+chanstring = many $ psym (`notElem` "\0\a\r\n ,:")++channelid :: Regex String+channelid = snd <$> withMatched (c *> c *> c *> c *> c)+ where+ c = psym isAsciiUpper <|> digit
+ src/Network/IRC/Fun/Messages/Internal/Tokens/Wildcards.hs view
@@ -0,0 +1,47 @@+{- This file is part of irc-fun-messages.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module Network.IRC.Fun.Messages.Internal.Tokens.Wildcards+ ( mask+ , matchone+ , matchmany+ )+where++import Network.IRC.Fun.Messages.Internal.Types ( MaskPart (..)+ , Mask (..)+ , Regex )+import Text.Regex.Applicative++mask :: Regex Mask+mask = Mask <$> many (nowild <|> noesc *> wildone <|> noesc *> wildmany)++wildone :: Regex MaskPart+wildone = MaskWildOne <$ sym '?'++wildmany :: Regex MaskPart+wildmany = MaskWildMany <$ sym '*'++nowild :: Regex MaskPart+nowild = MaskChar <$> psym (`notElem` "\0*?")++noesc :: Regex Char+noesc = psym (`notElem` "\0\\")++matchone :: Regex Char+matchone = psym (/= '\0')++matchmany :: Regex String+matchmany = many matchone
+ src/Network/IRC/Fun/Messages/Internal/Types.hs view
@@ -0,0 +1,881 @@+{- This file is part of irc-fun-messages.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module Network.IRC.Fun.Messages.Internal.Types+ ( -- * Type Aliases+ ServerName+ , ServiceName+ , UserName+ , NickName+ , ChannelName+ , CommandName+ , Parameter+ , Password+ , ChannelKey+ , ChannelTopic+ , RealName+ , Comment+ , PortNumber+ , Regex+ -- * Message Parts+ , Prefix (..)+ , UserAddr (..)+ , Target (..)+ , Address (..)+ , Host (..)+ , Command (..)+ -- * Mask+ , MaskPart (..)+ , Mask (..)+ , TargetMask (..)+ -- * Message+ , GenericMessage (..)+ , SpecificMessage (..)+ , MessageTarget (..)+ , Message (..)+ -- * Modes+ , UserMode (..)+ , ChannelMode (..)+ , ChannelModeType (..)+ -- * Reply+ , CommandResponseCode (..)+ , ErrorReplyCode (..)+ , ReservedReplyCode (..)+ , ReservedErrorCode (..)+ , GenericReply (..)+ , Reply (..)+ , SpecificReply (..)+ , Privilege (..)+ , ChannelPrivacy (..)+ )+where++import Text.Regex.Applicative (RE)++-------------------------------------------------------------------------------+-- Type Aliases+-------------------------------------------------------------------------------++-- | IRC server hostname, e.g. @"orwell.freenode.net"@+type ServerName = String++-- | TODO+type ServiceName = String++-- | System user name, i.e. the first part of user\@host.tld+type UserName = String++-- | IRC nickname+type NickName = String++-- | IRC channel name (including the prefix character), e.g. @"#freepost"@+type ChannelName = String++-- | IRC protocol command name, i.e. @"PRIVMSG"@+type CommandName = String++-- | IRC message parameter, e.g. second part of @JOIN #freepost@+type Parameter = String++-- | TODO+type Password = String++-- | TODO+type ChannelKey = String++-- | TODO+type ChannelTopic = String++-- | TODO+type RealName = String++-- | TODO+type Comment = String++-- | TODO+type PortNumber = Int++-- | TODO+type Regex = RE Char++-------------------------------------------------------------------------------+-- Message Parts+-------------------------------------------------------------------------------++-- | IRC message prefix.+data Prefix+ -- | The server which sends the message+ = Server ServerName+ -- | The user which sends the message (if the message comes from a user)+ | Nick NickName (Maybe UserName) (Maybe Host)+ deriving (Eq, Show)++-- | User address containing a name part (as in "user") and an optional host+-- part (as in "user@host").+data UserAddr = UserAddr UserName (Maybe Host) deriving (Eq, Show)++-- | TODO+data Target = NickTarget NickName | ServerTarget ServerName deriving (Eq, Show)++-- | An IP address.+data Address = IPv4 String | IPv6 String deriving (Eq, Show)++-- | A host, either a hostname (e.g. @irc.freenode.net@) or an IP address, or a+-- cloak assigned by the server.+data Host = HostName String | HostAddr Address | HostCloak String+ deriving (Eq, Show)++-- | TODO+data Command = StringCommand CommandName | NumericCommand Int+ deriving (Eq, Show)++-------------------------------------------------------------------------------+-- Masks+-------------------------------------------------------------------------------++-- | Part of a 'Mask'.+data MaskPart+ -- | A literal character.+ = MaskChar Char+ -- | A wildcard which matches a single character.+ | MaskWildOne+ -- | A wildcard which matches zero or more characters.+ | MaskWildMany+ deriving (Eq, Show)++-- | A pattern for matching host and server names. A mask in the protocol is a+-- string which consists of literal characters and wildcards. There are two+-- wildcards: @'?'@, which matches a single character; @'*'@, which matches any+-- number of characters (zero or more).+newtype Mask = Mask [MaskPart] deriving (Eq, Show)++-- | Some IRC command parameters are targets, and one way to specify a target+-- is using a 'Mask'.+data TargetMask+ -- | Host mask, prefixed with @'#'@ in the protocol. Selects all the users+ -- whose host matches the mask.+ = HostMask Mask+ -- | Server mask, prefixed with @'$'@ in the protocol. Selects all the+ -- users connected to a server which matches the mask.+ | ServerMask Mask+ deriving (Eq, Show)++-------------------------------------------------------------------------------+-- Message+-------------------------------------------------------------------------------++-- | A generic IRC message. It consists of a sender prefix, command name+-- (string or numeric) and optionally a list of parameters.+data GenericMessage = GenericMessage+ { prefix :: Maybe Prefix+ , command :: Command+ , parameters :: [Parameter]+ }+ deriving Show++-- | An IRC message of a specific type. This includes only messages whose+-- command is a name. Messages with a numeric command are handled in the+-- "Network.IRC.Fun.Messages.Reply" module.+data SpecificMessage = SpecificMessage (Maybe Prefix) Message deriving Show++-- | Some IRC commands have targets. For example, to which channel to send a+-- given text message. Targets are specified as parameters in IRC messages.+data MessageTarget+ -- | An IRC channel.+ = ChannelTarget ChannelName+ -- | An IRC user. Possible combinations in the protocol are:+ --+ -- * Address (address host is required)+ -- * Address and server (address host is optional)+ -- * Nickname+ -- * Nickname and address (address host is required)+ | UserTarget (Maybe NickName) (Maybe UserAddr) (Maybe ServerName)+ -- | A mask which matches the server or host of the users to whom the+ -- message should be sent.+ | MaskTarget TargetMask+ deriving Show++-- | A server query. Can be sent through a 'StatsMessage'.+data Query+ -- | TODO+ = Connections+ -- | TODO+ | CommandUsage+ -- | TODO+ | PrivilegedUsers+ -- | TODO+ | Uptime+ -- | TODO+ | OtherQuery Char+ deriving Show++-- TODO in all the either-servername-mask occurences, make sure in the RFC+-- that they are "<target> may contain wildcards" cases, and replace them with+-- plain ServerName - let's treat mask as a user mask (for bans etc.)+-- TODO in all the <target> cases, do they mean a user can be specified too,+-- to mean "the server this user is connected to"? try with some IRC servers+-- over telnet, and change ServerName to Target if yes. Note that servername+-- has '.' chars while a nickname can't, so that's how one tells which is which+-- Also compare with existing irc packages, how they model these messages++-- | An IRC message of specific type (excluding the optional sender prefix, see+-- 'SpecificMessage').+data Message+-- Connection registration+ = PassMessage Password+ | NickMessage NickName+ -- | first bool = whether invisible, second bool = whether sees wallops+ | UserMessage UserName Bool Bool RealName+ | OperMessage UserName Password+ -- | first list: modes to remove (-), second list: modes to add (+)+ | UserModeMessage NickName [UserMode] [UserMode]+ | ServiceMessage NickName Mask String+ | QuitMessage (Maybe String)+ | SQuitMessage ServerName String+-- Channel operations+ | JoinMessage (Maybe ([ChannelName], [ChannelKey]))+ | PartMessage [ChannelName] (Maybe String)+ -- first: remove (-), second: add/set (+)+ | ChannelModeMessage [ChannelMode] [ChannelMode]+ | TopicMessage ChannelName (Maybe ChannelTopic)+ | NamesMessage [ChannelName] (Maybe ServerName)+ | ListMessage [ChannelName] (Maybe (Either ServerName Mask))+ | InviteMessage NickName ChannelName+ | KickMessage [ChannelName] [UserName] (Maybe Comment)+-- Sending messages+ | PrivMsgMessage MessageTarget String+ | NoticeMessage MessageTarget String+-- Server queries and commands+ | MotdMessage (Maybe (Either ServerName Mask))+ | LusersMessage (Maybe (Mask, Maybe ServerName))+ | VersionMessage (Maybe (Either ServerName Mask))+ | StatsMessage (Maybe (Query, Maybe (Either ServerName Mask)))+ | LinksMessage (Maybe (Maybe (Either ServerName Mask), Mask))+ | TimeMessage (Maybe (Either ServerName Mask))+ | ConnectMessage ServerName PortNumber (Either ServerName Mask)+ | TraceMessage (Maybe Target)+ | AdminMessage (Maybe Target)+ | InfoMessage (Maybe Target)+-- Service query and commands+ | ServlistMessage (Maybe (Mask, Maybe String))+ | SQueryMessage ServiceName String+-- User based queries+ | WhoMessage (Maybe (Mask, Bool))+ | WhoisMessage (Maybe ServerName) [Mask]+ | WhowasMessage [NickName] (Maybe (Int, Maybe ServerName))+-- Miscellaneous messages+ | KillMessage NickName Comment+ | PingMessage ServerName (Maybe ServerName)+ | PongMessage ServerName (Maybe ServerName)+ | ErrorMessage String+-- Optional features+ | AwayMessage (Maybe String)+ | RehashMessage+ | DieMessage+ | RestartMessage+ | SummonMessage UserName (Maybe (ServerName, Maybe ChannelName))+ | UsersMessage (Maybe ServerName)+ | WallopsMessage String+ | UserhostMessage [NickName]+ | IsonMessage [NickName]+ deriving Show++-------------------------------------------------------------------------------+-- Modes+-------------------------------------------------------------------------------++-- | TODO+data UserMode+ -- http://toxin.jottit.com/freenode_user_modes+ = UModeInvisible+ | UModeCallerID+ | UModeSeeWallops+ | UModeDeaf+ | UModeNoForwarding+ | UModeBlockUnidentified+ | UModeConnectedViaSSL+ -- from the irc rfc, MODE message (section 3.1.5)+ | UModeAway+ | UModeRestricted+ | UModeOperator+ | UModeLocalOperator+ | UModeSeeNotices+ | UModeOther Char+ deriving (Eq, Show)++-- | TODO+data ChannelMode+ = CModeCreator+ | CModeOperator+ | CModeVoice+ | CModeAnonymous+ | CModeInviteOnly+ | CModeModerated+ | CModeNoMessagesFromOutside+ | CModeQuiet+ | CModePrivate+ | CModeSecret+ | CModeServerReop+ | CModeTopicSettableByChannelOpOnly+ | CModeKey (Maybe ChannelKey)+ | CModeUserLimit (Maybe Int)+ | CModeBanMask (Maybe Mask)+ | CModeExceptionMask (Maybe Mask)+ | CModeInvitationMask (Maybe Mask)+ | CModeOther Char [String]+ | CModeFreenodeQuiet (Maybe Mask)+ deriving (Eq, Show)++data ChannelModeType+ = ModeTypeList+ | ModeTypeSetting+ | ModeTypeMaybeSetting+ | ModeTypeFlag++-------------------------------------------------------------------------------+-- Reply+-------------------------------------------------------------------------------++-- | TODO+data CommandResponseCode+ -- | TODO+ = ReplyWelcome+ -- | TODO+ | ReplyYourHost+ -- | TODO+ | ReplyCreated+ -- | TODO+ | ReplyMyInfo+ -- | TODO+ | ReplyBounce+ -- | TODO+ | ReplyUserHost+ -- | TODO+ | ReplyIsOn+ -- | TODO+ | ReplyAway+ -- | TODO+ | ReplyUnAway+ -- | TODO+ | ReplyNoAway+ -- | TODO+ | ReplyWhoIsUser+ -- | TODO+ | ReplyWhoIsServer+ -- | TODO+ | ReplyWhoIsOperator+ -- | TODO+ | ReplyWhoIsIdle+ -- | TODO+ | ReplyEndOfWhoIs+ -- | TODO+ | ReplyWhoIsChannels+ -- | TODO+ | ReplyWhoWasUser+ -- | TODO+ | ReplyEndOfWhoWas+ -- | TODO+ | ReplyListStart+ -- | TODO+ | ReplyList+ -- | TODO+ | ReplyListEnd+ -- | TODO+ | ReplyUniqueOpIs+ -- | TODO+ | ReplyChannelModeIs+ -- | TODO+ | ReplyNoTopic+ -- | TODO+ | ReplyTopic+ -- | TODO+ | ReplyInviting+ -- | TODO+ | ReplySummoning+ -- | TODO+ | ReplyInviteList+ -- | TODO+ | ReplyEndOfInviteList+ -- | TODO+ | ReplyExceptList+ -- | TODO+ | ReplyEndOfExceptList+ -- | TODO+ | ReplyVersion+ -- | TODO+ | ReplyWhoReply+ -- | TODO+ | ReplyEndOfWho+ -- | TODO+ | ReplyNameReply+ -- | TODO+ | ReplyEndOfNames+ -- | TODO+ | ReplyLinks+ -- | TODO+ | ReplyEndOfLinks+ -- | TODO+ | ReplyBanList+ -- | TODO+ | ReplyEndOfBanList+ -- | TODO+ | ReplyInfo+ -- | TODO+ | ReplyEndOfInfo+ -- | TODO+ | ReplyMotdStart+ -- | TODO+ | ReplyMessageOfTheDay+ -- | TODO+ | ReplyEndOfMessageOfTheDay+ -- | TODO+ | ReplyYoureOper+ -- | TODO+ | ReplyRehashing+ -- | TODO+ | ReplyYoureService+ -- | TODO+ | ReplyTime+ -- | TODO+ | ReplyUsersStart+ -- | TODO+ | ReplyUsers+ -- | TODO+ | ReplyEndOfUsers+ -- | TODO+ | ReplyNoUsers+ -- | TODO+ | ReplyTraceLink+ -- | TODO+ | ReplyTraceConnecting+ -- | TODO+ | ReplyTraceHandshake+ -- | TODO+ | ReplyTraceUnknown+ -- | TODO+ | ReplyTraceOperator+ -- | TODO+ | ReplyTraceUser+ -- | TODO+ | ReplyTraceServer+ -- | TODO+ | ReplyTraceService+ -- | TODO+ | ReplyTraceNewType+ -- | TODO+ | ReplyTraceClass+ -- | TODO+ | ReplyTraceReconnect+ -- | TODO+ | ReplyTraceLog+ -- | TODO+ | ReplyTraceEnd+ -- | TODO+ | ReplyStatsLinkInfo+ -- | TODO+ | ReplyStatsCommands+ -- | TODO+ | ReplyEndOfStats+ -- | TODO+ | ReplyStatsUptime+ -- | TODO+ | ReplyStatsOLine+ -- | TODO+ | ReplyUModeIs+ -- | TODO+ | ReplyServList+ -- | TODO+ | ReplyServListEnd+ -- | TODO+ | ReplyLuserClient+ -- | TODO+ | ReplyLuserOp+ -- | TODO+ | ReplyLuserUnknown+ -- | TODO+ | ReplyLuserChannels+ -- | TODO+ | ReplyLuserMe+ -- | TODO+ | ReplyAdminMe+ -- | TODO+ | ReplyAdminLocation1+ -- | TODO+ | ReplyAdminLocation2+ -- | TODO+ | ReplyAdminEmail+ -- | TODO+ | ReplyTryAgain+ -- | TODO+ | ReplyFreenodeISupport+ deriving (Eq, Show)++data ErrorReplyCode+ -- | TODO+ = ErrorNoSuchNick+ -- | TODO+ | ErrorNoSuchServer+ -- | TODO+ | ErrorNoSuchChannel+ -- | TODO+ | ErrorCannotSendToChannel+ -- | TODO+ | ErrorTooManyChannels+ -- | TODO+ | ErrorWasNoSuchNick+ -- | TODO+ | ErrorTooManyTargets+ -- | TODO+ | ErrorNoSuchService+ -- | TODO+ | ErrorNoOrigin+ -- | TODO+ | ErrorNoRecipient+ -- | TODO+ | ErrorNoTextToSend+ -- | TODO+ | ErrorNoTopLevel+ -- | TODO+ | ErrorWildTopLevel+ -- | TODO+ | ErrorBadMask+ -- | TODO+ | ErrorUnknownCommand+ -- | TODO+ | ErrorNoMessageOfTheDay+ -- | TODO+ | ErrorNoAdminInfo+ -- | TODO+ | ErrorFileError+ -- | TODO+ | ErrorNoNickNameGiven+ -- | TODO+ | ErrorErroneousNickName+ -- | TODO+ | ErrorNickNameInUse+ -- | TODO+ | ErrorNickCollision+ -- | TODO+ | ErrorUnavailableResource+ -- | TODO+ | ErrorUserNotInChannel+ -- | TODO+ | ErrorNotOnChannel+ -- | TODO+ | ErrorUserOnChannel+ -- | TODO+ | ErrorNoLogin+ -- | TODO+ | ErrorSummonDisabled+ -- | TODO+ | ErrorUsersDisabled+ -- | TODO+ | ErrorNotRegistered+ -- | TODO+ | ErrorNeedMoreParams+ -- | TODO+ | ErrorAlreadyRegistered+ -- | TODO+ | ErrorNoPermissionForHost+ -- | TODO+ | ErrorPasswordMismatch+ -- | TODO+ | ErrorYoureBannedCreep+ -- | TODO+ | ErrorYouWillBeBanned+ -- | TODO+ | ErrorKeySet+ -- | TODO+ | ErrorChannelIsFull+ -- | TODO+ | ErrorUnknownMode+ -- | TODO+ | ErrorInviteOnlyChannel+ -- | TODO+ | ErrorBannedFromChannel+ -- | TODO+ | ErrorBadChannelKey+ -- | TODO+ | ErrorBadChannelMask+ -- | TODO+ | ErrorNoChannelModes+ -- | TODO+ | ErrorBanListFull+ -- | TODO+ | ErrorNoPrivileges+ -- | TODO+ | ErrorChannelOpPrivilegesNeeded+ -- | TODO+ | ErrorCantKillServer+ -- | TODO+ | ErrorRestricted+ -- | TODO+ | ErrorUniqueOpPrivilegesNeeded+ -- | TODO+ | ErrorNoOperHost+ -- | TODO+ | ErrorUModeUnknownFlag+ -- | TODO+ | ErrorUsersDontMatch+ deriving (Eq, Show)++data ReservedReplyCode+ -- | TODO+ = ReservedReplyServiceInfo+ -- | TODO+ | ReservedReplyEndOfServices+ -- | TODO+ | ReservedReplyService+ -- | TODO+ | ReservedReplyNone+ -- | TODO+ | ReservedReplyWhoIsChannelOp+ -- | TODO+ | ReservedReplyKillDone+ -- | TODO+ | ReservedReplyClosing+ -- | TODO+ | ReservedReplyCloseEnd+ -- | TODO+ | ReservedReplyInfoStart+ -- | TODO+ | ReservedReplyMyPortIs+ -- | TODO+ | ReservedReplyStatsCLine+ -- | TODO+ | ReservedReplyStatsNLine+ -- | TODO+ | ReservedReplyStatsILine+ -- | TODO+ | ReservedReplyStatsKLine+ -- | TODO+ | ReservedReplyStatsQLine+ -- | TODO+ | ReservedReplyStatsYLine+ -- | TODO+ | ReservedReplyStatsVLine+ -- | TODO+ | ReservedReplyStatsLLine+ -- | TODO+ | ReservedReplyStatsHLine+ -- | TODO+ | ReservedReplyStatsSLine+ -- | TODO+ | ReservedReplyStatsPing+ -- | TODO+ | ReservedReplyStatsBLine+ -- | TODO+ | ReservedReplyStatsDLine+ deriving (Eq, Show)++-- | TODO+data ReservedErrorCode+ -- | TODO+ = ReservedErrorNoServiceHost+ deriving (Eq, Show)++-- | TODO+data GenericReply = GenericReply+ { sender :: ServerName+ , code :: Int+ , target :: Target+ , params :: [Parameter]+ }+ deriving Show++-- | TODO+data Reply+ -- | TODO+ = WelcomeReply+ -- | TODO+ | YourHostReply+ -- | TODO+ | CreatedReply+ -- | TODO+ | MyInfoReply+ -- | TODO+ | BounceReply+ -- | TODO+ | ISupportReply+ -- | TODO+ | UserHostReply+ -- | TODO+ | IsOnReply+ -- | TODO+ | AwayReply+ -- | TODO+ | UnAwayReply+ -- | TODO+ | NoAwayReply+ -- | TODO+ | WhoIsUserReply+ -- | TODO+ | WhoIsServerReply+ -- | TODO+ | WhoIsOperatorReply+ -- | TODO+ | WhoIsIdleReply+ -- | TODO+ | EndOfWhoIsReply+ -- | TODO+ | WhoIsChannelsReply+ -- | TODO+ | WhoWasUserReply+ -- | TODO+ | EndOfWhoWasReply+ -- | TODO+ | ListStartReply+ -- | TODO+ | ListReply+ -- | TODO+ | ListEndReply+ -- | TODO+ | UniqueOpIsReply+ -- | TODO+ | ChannelModeIsReply+ -- | TODO+ | NoTopicReply+ -- | TODO+ | TopicReply+ -- | TODO+ | InvitingReply+ -- | TODO+ | SummoningReply+ -- | TODO+ | InviteListReply+ -- | TODO+ | EndOfInviteListReply+ -- | TODO+ | ExceptListReply+ -- | TODO+ | EndOfExceptListReply+ -- | TODO+ | VersionReply+ -- | TODO+ | WhoReply+ -- | TODO+ | EndOfWhoReply+ -- | Lists members of IRC channels. Sent when JOINing a channel to list the+ -- users in that channel, or as a response to the NAMES command.+ | NamesReply ChannelPrivacy ChannelName [(Privilege, NickName)]+ -- | Sent after a sequence of 0 or more 'NameReply's, to signal that the+ -- list transmission is finished.+ | EndOfNamesReply+ -- | TODO+ | LinksReply+ -- | TODO+ | EndOfLinksReply+ -- | TODO+ | BanListReply+ -- | TODO+ | EndOfBanListReply+ -- | TODO+ | InfoReply+ -- | TODO+ | EndOfInfoReply+ -- | TODO+ | MotdStartReply+ -- | TODO+ | MessageOfTheDayReply+ -- | TODO+ | EndOfMessageOfTheDayReply+ -- | TODO+ | YoureOperReply+ -- | TODO+ | RehashingReply+ -- | TODO+ | YoureServiceReply+ -- | TODO+ | TimeReply+ -- | TODO+ | UsersStartReply+ -- | TODO+ | UsersReply+ -- | TODO+ | EndOfUsersReply+ -- | TODO+ | NoUsersReply+ -- | TODO+ | TraceLinkReply+ -- | TODO+ | TraceConnectingReply+ -- | TODO+ | TraceHandshakeReply+ -- | TODO+ | TraceUnknownReply+ -- | TODO+ | TraceOperatorReply+ -- | TODO+ | TraceUserReply+ -- | TODO+ | TraceServerReply+ -- | TODO+ | TraceServiceReply+ -- | TODO+ | TraceNewTypeReply+ -- | TODO+ | TraceClassReply+ -- | TODO+ | TraceReconnectReply+ -- | TODO+ | TraceLogReply+ -- | TODO+ | TraceEndReply+ -- | TODO+ | StatsLinkInfoReply+ -- | TODO+ | StatsCommandsReply+ -- | TODO+ | EndOfStatsReply+ -- | TODO+ | StatsUptimeReply+ -- | TODO+ | StatsOLineReply+ -- | TODO+ | UModeIsReply+ -- | TODO+ | ServListReply+ -- | TODO+ | ServListEndReply+ -- | TODO+ | LuserClientReply+ -- | TODO+ | LuserOpReply+ -- | TODO+ | LuserUnknownReply+ -- | TODO+ | LuserChannelsReply+ -- | TODO+ | LuserMeReply+ -- | TODO+ | AdminMeReply+ -- | TODO+ | AdminLocation1Reply+ -- | TODO+ | AdminLocation2Reply+ -- | TODO+ | AdminEmailReply+ -- | TODO+ | TryAgainReply+ deriving (Eq, Show)++-- | An IRC server numeric reply of a specific type.+data SpecificReply = SpecificReply ServerName Target Reply deriving Show++--+data Privilege = Regular | Voice | Operator deriving (Eq, Show)++--+data ChannelPrivacy = Secret | Private | Public deriving (Eq, Show)
+ src/Network/IRC/Fun/Messages/Mask.hs view
@@ -0,0 +1,69 @@+{- This file is part of irc-fun-messages.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++-- | This module deals with wildcard based masks, used for selecting users and+-- servers.+module Network.IRC.Fun.Messages.Mask+ ( parseMask+ , serializeMask+ , matches+ )+where++import Data.Maybe (isJust)+import qualified Network.IRC.Fun.Messages.Internal.Tokens.Wildcards as T+import Network.IRC.Fun.Messages.Internal.Types+import Text.Regex.Applicative++{-+TODO+"The mask MUST+ have at least 1 (one) "." in it and no wildcards following the last+ ".". This requirement exists to prevent people sending messages to+ "#*" or "$*", which would broadcast to all users."++handle this somehow! e.g. a function that tests a mask for validity+-}++-- | Parse a mask string (e.g. @"*!*@*"@) into a 'Mask' value. Returns+-- 'Nothing' if the string isn't a valid mask.+parseMask :: String -> Maybe Mask+parseMask = match T.mask++--TODO what about escaping and invalid chars? are they handled correctly?+--prepend mapped part to given string+serializeMaskPart :: MaskPart -> String -> String+serializeMaskPart (MaskChar '?') s = '\\' : '?' : s+serializeMaskPart (MaskChar '*') s = '\\' : '*' : s+serializeMaskPart (MaskChar c) s = c : s+serializeMaskPart (MaskWildOne) s = '?' : s+serializeMaskPart (MaskWildMany) s = '*' : s++-- | Converts a 'Mask' value into its string representation in IRC messages.+serializeMask :: Mask -> String+serializeMask (Mask parts) = foldr serializeMaskPart "" parts++-- TODO maybe fold MaskChars into strings? how much faster will it be?+maskToRegex :: Mask -> Regex String+maskToRegex (Mask parts) = snd <$> withMatched (foldr f (pure "") parts)+ where+ f (MaskChar c) regex = sym c *> regex+ f MaskWildOne regex = T.matchone *> regex+ f MaskWildMany regex = T.matchmany *> regex++matches :: String -> Mask -> Bool+matches s m = isJust $ match (maskToRegex m) s++infix 2 `matches`
+ src/Network/IRC/Fun/Messages/Modes.hs view
@@ -0,0 +1,188 @@+{- This file is part of irc-fun-messages.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++-- | This module handles user modes and channel modes.+module Network.IRC.Fun.Messages.Modes+ ( -- * User Modes+ umodeToLetter+ , umodeFromLetter+ , parseUserMode+ -- * Channel Modes+ , cmodeToLetter+ , cmodeFromLetter+ , parseChannelModeParams+ )+where++import Data.Either (isRight)+import Data.Maybe (fromMaybe)+import Data.List (nub, partition)+import Data.Tuple (swap)+import Network.IRC.Fun.Messages.Internal.Types+import Text.Regex.Applicative++userModeMap :: [(UserMode, Char)]+userModeMap =+ [ (UModeInvisible, 'i')+ , (UModeCallerID, 'g')+ , (UModeSeeWallops, 'w')+ , (UModeDeaf, 'D')+ , (UModeNoForwarding, 'Q')+ , (UModeBlockUnidentified, 'R')+ , (UModeConnectedViaSSL, 'Z')+ , (UModeAway, 'a')+ , (UModeRestricted, 'r')+ , (UModeOperator, 'o')+ , (UModeLocalOperator, 'O')+ , (UModeSeeNotices, 's')+ ]++umodeToLetter :: UserMode -> Char+umodeToLetter (UModeOther c) = c+umodeToLetter um =+ fromMaybe+ (error "Implementation error: User mode not assigned a letter")+ (lookup um userModeMap)++umodeFromLetter :: Char -> UserMode+umodeFromLetter c = fromMaybe (UModeOther c) (lookup c $ map swap userModeMap)++isAsciiLetter c = 'a' <= c && c <= 'z' || 'A' <= c && c <= 'Z'++-- 1 to remove, 2 to add+umode :: Regex ([UserMode], [UserMode])+umode = mix <$> many section+ where+ section = (,) <$> (True <$ sym '+' <|> False <$ sym '-')+ <*> (nub <$> many (psym isAsciiLetter))+ mix l =+ let (add, remove) = partition fst l+ add' = nub $ concatMap snd add+ remove' = nub $ concatMap snd remove+ in (map umodeFromLetter remove', map umodeFromLetter add')++-- the one from the MODE irc message+parseUserMode :: String -> Maybe ([UserMode], [UserMode])+parseUserMode = match umode++--TODO add modes from https://freenode.net/using_the_network.shtml+-- freenode it the main target anyway...+-- also maybe add a system for server-specific non-standard flags+channelModeMap :: [(ChannelMode, Char, ChannelModeType)]+channelModeMap = --eIbq,k,flj,CFLMPQScgimnprstz -- o and v type B syntax-wise+ [ (CModeCreator, 'O', ModeTypeMaybeSetting)+ , (CModeOperator, 'o', ModeTypeSetting)+ , (CModeVoice, 'v', ModeTypeSetting)+ , (CModeAnonymous, 'a', ModeTypeFlag)+ , (CModeInviteOnly, 'i', ModeTypeFlag)+ , (CModeModerated, 'm', ModeTypeFlag)+ , (CModeNoMessagesFromOutside, 'n', ModeTypeFlag)+ , (CModeQuiet, 'q', ModeTypeFlag)+ , (CModePrivate, 'p', ModeTypeFlag)+ , (CModeSecret, 's', ModeTypeFlag)+ , (CModeServerReop, 'r', ModeTypeFlag)+ , (CModeTopicSettableByChannelOpOnly, 't', ModeTypeFlag)+ , (CModeKey Nothing, 'k', ModeTypeFlag)+ , (CModeUserLimit Nothing, 'l', ModeTypeMaybeSetting)+ , (CModeBanMask Nothing, 'b', ModeTypeList)+ , (CModeExceptionMask Nothing, 'e', ModeTypeList)+ , (CModeInvitationMask Nothing, 'I', ModeTypeList)+ ]++freenodeOverride :: [(ChannelMode, Char, ChannelModeType)]+freenodeOverride =+ [ (CModeFreenodeQuiet Nothing, 'q', ModeTypeSetting)+ ]++lookupCLetter _ [] = Nothing+lookupCLetter q ((m, l, t):rest) =+ if q == m+ then Just l+ else lookupCLetter q rest++--TODO make the bool=True mean we use the freenode override+cmodeToLetter :: ChannelMode -> Bool -> Char+cmodeToLetter (CModeOther c _) _ = c+cmodeToLetter cm freenode =+ let m =+ if freenode+ then freenodeOverride ++ channelModeMap+ else channelModeMap+ in fromMaybe+ (error "Implementation error: Channel mode not assigned a letter")+ (lookupCLetter cm m)++lookupCMode _ [] = Nothing+lookupCMode c ((m, l, t):rest) = if c == l then Just m else lookupCMode c rest++--TODO make the bool=True mean we use the freenode override+cmodeFromLetter :: Char -> Bool -> ChannelMode+cmodeFromLetter c freenode =+ let m =+ if freenode+ then freenodeOverride ++ channelModeMap+ else channelModeMap+ in fromMaybe (CModeOther c []) (lookupCMode c m)++-- the one from the MODE irc message+-- http://www.irc.org/tech_docs/005.html+{-+some rules:++A++B++C++suppose we are setting 'l', then:++l : does nothing++l : does nothing+-l : unsets the mode+l 1000 : sets mode, same as +l 1000++l 1000 : sets mode+-l 1000 : unsets mode, the 1000 is ignored++D++-}+parseChannelModeParams :: [String]+ -> Bool -- whether to use freenode override+ -> Maybe+ ( [ChannelMode] -- list additions and boolean sets+ , [ChannelMode] -- list removals and boolean unsets+ , [ChannelMode] -- setting changes (sets and unsets)+ )+parseChannelModeParams l freenode =+ let l' = map f l+ -- Tag params, each is either a mode (e.g. +abc) or an arg (e.g. *!*@*)+ f s =+ case match section s of+ Just sect -> Right sect+ Nothing -> Left s+ section = (,) <$> optional (True <$ sym '+' <|> False <$ sym '-')+ <*> (nub <$> many (psym isAsciiLetter))+ -- Collect (sign, modes, [arg]) tuples into a list+ parts [] = Just []+ parts (Left _ : _) = Nothing+ parts (Right (sign, letters) : ss) =+ let (args, next) = break isRight ss+ in case parts next of+ Nothing -> Nothing+ Just pn -> Just $ (sign, letters, args) : pn+ -- Attach args to their modes by mode type+ --attach (+ in Nothing
+ src/Network/IRC/Fun/Messages/TypeAliases.hs view
@@ -0,0 +1,35 @@+{- This file is part of irc-fun-messages.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++-- | This module provides type aliases used throughout the package for+-- readability.+module Network.IRC.Fun.Messages.TypeAliases+ ( ServerName+ , ServiceName+ , UserName+ , NickName+ , ChannelName+ , CommandName+ , Parameter+ , Password+ , ChannelKey+ , ChannelTopic+ , RealName+ , Comment+ , PortNumber+ )+where++import Network.IRC.Fun.Messages.Internal.Types
+ src/Network/IRC/Fun/Messages/Types.hs view
@@ -0,0 +1,51 @@+{- This file is part of irc-fun-messages.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++-- | This module provides datatypes for modeling parts of IRC messages.+module Network.IRC.Fun.Messages.Types+ ( -- * Message Parts+ Prefix (..)+ , UserAddr (..)+ , Target (..)+ , Address (..)+ , Host (..)+ , Command (..)+ -- * Mask+ , MaskPart (..)+ , Mask (..)+ , TargetMask (..)+ -- * Message+ , GenericMessage (..)+ , SpecificMessage (..)+ , MessageTarget (..)+ , Message (..)+ -- * Modes+ , UserMode (..)+ , ChannelMode (..)+ , ChannelModeType (..)+ -- * Reply+ , CommandResponseCode (..)+ , ErrorReplyCode (..)+ , ReservedReplyCode (..)+ , ReservedErrorCode (..)+ , GenericReply (..)+ , Reply (..)+ , SpecificReply (..)+ , Privilege (..)+ , ChannelPrivacy (..)+ )+where++import Network.IRC.Fun.Messages.Internal.Types