From 45eb76c8afe7aeee6176d82efdd15621462b65ea Mon Sep 17 00:00:00 2001 From: Levi Pearson Date: Tue, 4 Mar 2014 00:31:46 -0700 Subject: [PATCH] Lots of haddock comments --- src/Pipes/IRC/Server.hs | 5 +- src/Pipes/IRC/Server/Channel.hs | 177 +++++++++++++++++++++++++++----- src/Pipes/IRC/Server/Server.hs | 21 +++- src/Pipes/IRC/Server/Types.hs | 88 ++++++++++++++-- 4 files changed, 247 insertions(+), 44 deletions(-) diff --git a/src/Pipes/IRC/Server.hs b/src/Pipes/IRC/Server.hs index 1523a21..cb6524a 100644 --- a/src/Pipes/IRC/Server.hs +++ b/src/Pipes/IRC/Server.hs @@ -126,10 +126,7 @@ cmdHandler srv cid = -- handle resulting events aliveL <- liftIO $ forM events $ ircEventHandler srv -{- -- debug - sState <- liftIO $ readTVarIO $ srv ^. ircState - liftIO $ BS.putStrLn $ BS.pack (show sState) --} + -- loop for the next command when (and aliveL) $ handle h newReg diff --git a/src/Pipes/IRC/Server/Channel.hs b/src/Pipes/IRC/Server/Channel.hs index 101c8a7..cf771b9 100644 --- a/src/Pipes/IRC/Server/Channel.hs +++ b/src/Pipes/IRC/Server/Channel.hs @@ -41,7 +41,10 @@ import Data.Set (delete, empty, fromList, insert, import Pipes.IRC.Server.Types -newChannel :: NickKey -> IrcChannel +-- | Create a new 'IrcChannel' record with the given nickname as the +-- only member. +newChannel :: NickKey -- ^ the nickname of the channel creator + -> IrcChannel -- ^ the resulting new 'IrcChannel' record newChannel creator = IrcChannel { _chanTopic = Nothing , _chanPass = Nothing , _chanModeFlags = empty @@ -51,62 +54,154 @@ newChannel creator = IrcChannel { _chanTopic = Nothing , _chanInvites = empty } -chanAddModeFlag, chanDelModeFlag :: IrcChanModeFlags -> IrcChannel -> IrcChannel +chanAddModeFlag, chanDelModeFlag :: IrcChanModeFlags + -- ^ channel mode flag to change + -> IrcChannel + -- ^ channel on which to change mode + -> IrcChannel + -- ^ resulting channel with mode change +-- | Add a mode flag to the channel's set of mode flags. See +-- 'IrcChanModeFlags' for the available modes. chanAddModeFlag cm = chanModeFlags %~ insert cm +-- | Remove the mode flag from the channel's set of mode flags. See +-- 'IrcChanModeFlags' for the available modes. chanDelModeFlag cm = chanModeFlags %~ delete cm -chanAddUser, chanDelUser :: NickKey -> IrcChannel -> IrcChannel -chanAddUser un = chanUsers %~ insert un -chanDelUser un = (chanUsers %~ delete un) - . (chanOpers %~ delete un) - . (chanVoices %~ delete un) +chanAddUser, chanDelUser :: NickKey -- ^ user to add to channel + -> IrcChannel -- ^ channel on which to add user + -> IrcChannel -- ^ channel with user added -chanHasUser :: NickKey -> IrcChannel -> Bool +-- | Add a user to the channel's list of users. This does not change +-- the set of set of channels on the user or perform any checking; +-- this just performs the low-level change to the channel. +chanAddUser un = chanUsers %~ insert un + +-- | Delete a user from the channel's list of users. This does not +-- change the set of channels on the user or perform any checking; +-- this just performs the low-level change to the channel. +chanDelUser un = (chanUsers %~ delete un) + . (chanOpers %~ delete un) + . (chanVoices %~ delete un) + +-- | Is the user owning the given nick on the channel? Returns 'True' +-- if the user is in fact on the channel. +chanHasUser :: NickKey -- ^ user to check presence of on the channel + -> IrcChannel -- ^ channel in which to look for the user + -> Bool -- ^ 'True' if the user is in the channel chanHasUser un ch = member un (ch ^. chanUsers) -chanSetTopic :: ByteString -> IrcChannel -> IrcChannel +-- | Set the topic of discussion in the channel. This does not do any +-- permission or size checking; it just performs the low-level action. +chanSetTopic :: ByteString -- ^ topic of discussion for the channel + -> IrcChannel -- ^ channel on which to set the topic + -> IrcChannel -- ^ channel with the topic set chanSetTopic top = chanTopic .~ Just top -chanHasTopic :: IrcChannel -> Bool +-- | Does the channel have a topic of discussion set? Returns 'True' +-- if the topic is set. +chanHasTopic :: IrcChannel -- ^ channel on which to look for a topic + -> Bool -- ^ 'True' if the channel has a topic chanHasTopic ch = isJust $ ch ^. chanTopic -chanHasModeFlag :: IrcChanModeFlags -> IrcChannel -> Bool +-- | Does the channel have a specific mode flag set? Returns 'True' +-- if it has the specified flag set. +chanHasModeFlag :: IrcChanModeFlags -- ^ mode flag to check for + -> IrcChannel -- ^ channel on which to check + -> Bool -- ^ 'True' if the flag is set chanHasModeFlag cm ch = member cm $ ch ^. chanModeFlags -chanSigil :: IrcChannel -> ByteString +-- | Find the mode sigil determined by what privacy modes it has +-- set, if any. +chanSigil :: IrcChannel -- ^ channel of which to find the sigil + -> ByteString -- ^ the sigil associated with the channel chanSigil ch | chanHasModeFlag Secret ch = "@" | chanHasModeFlag Private ch = "*" | otherwise = "=" -chanUserSigil :: NickKey -> IrcChannel -> ByteString +-- | Find the mode sigil determined by a user's status on a channel, +-- e.g. "@" for a channel op or "+" for a user with voice status. +chanUserSigil :: NickKey -- ^ nickname of user of which to find sigil + -> IrcChannel -- ^ channel the user may have status in + -> ByteString -- ^ the sigil associated with the user's status chanUserSigil un ch | member un $ ch ^. chanOpers = "@" | member un $ ch ^. chanVoices = "+" | otherwise = "" -chanSetPass :: ByteString -> IrcChannel -> IrcChannel +-- | Set a password key that must be given with a JOIN command in +-- order to join the channel. This does no permission or error +-- checking, it just performs the low-level operation. +chanSetPass :: PassKey -- ^ password key to set for a channel + -> IrcChannel -- ^ channel to set the password key on + -> IrcChannel -- ^ channel with the password set chanSetPass pwd = chanPass .~ Just pwd -chanHasPass :: IrcChannel -> Bool +-- | Does the channel have a password key set? Returns 'True' if the +-- channel does have a password key set. +chanHasPass :: IrcChannel -- ^ channel on which to look for password key + -> Bool -- ^ 'True' if there is a password key set chanHasPass ch = isJust $ ch ^. chanPass -chanCheckPass :: ByteString -> IrcChannel -> Bool +-- | Determine whether the given password key should give access to +-- the channel. If it matches the set password or there is no +-- password, the response will be 'True'. +chanCheckPass :: ByteString -- ^ password to try against the channel + -> IrcChannel -- ^ channel against which to try the password + -> Bool -- ^ 'True' if access should be granted chanCheckPass pwd ch = case ch ^. chanPass of Just chPass -> pwd == chPass Nothing -> True -chanAddOper, chanDelOper :: NickKey -> IrcChannel -> IrcChannel +chanAddOper, chanDelOper :: NickKey -- ^ nickname of user + -> IrcChannel -- ^ channel to change status on + -> IrcChannel -- ^ channel with status changed + +-- | Add the given nickname as an operator on the channel. This does +-- not perform any permission or error checks, it just performs the +-- low-level operation. chanAddOper un = chanOpers %~ insert un + +-- | Remove the given nickname as an operator on the channel. This +-- does not perform any permission or error checks, it just performs +-- the low-level operation. chanDelOper un = chanOpers %~ delete un -chanAddVoice, chanDelVoice :: NickKey -> IrcChannel -> IrcChannel +chanAddVoice, chanDelVoice :: NickKey -- ^ nickname of user + -> IrcChannel -- ^ channel to change voice on + -> IrcChannel -- ^ changed channel + +-- | Give voice status to the given nickname on the channel. This +-- does not perform any permission or error checks, it just performs +-- the low-level operation. chanAddVoice un = chanVoices %~ insert un + +-- | Remove voice status from the given nickname on the channel. This +-- does not perform any permission or error checks, it just performs +-- the low-level operation. chanDelVoice un = chanVoices %~ delete un -chanAddInvite, chanDelInvite :: NickKey -> IrcChannel -> IrcChannel +chanAddInvite, chanDelInvite :: NickKey -- ^ nickname of user + -> IrcChannel -- ^ channel to change invitation + -> IrcChannel -- ^ channel with change applied + +-- | Add a record of invitation for the nickname to join the channel. +-- This will allow the user to join when the channel is invite-only. +-- This does not perform any permission or error checks, it just does +-- the operation. chanAddInvite un = chanInvites %~ insert un + +-- | Remove record of the invitation for the nickname to join the +-- channel. This does not perform permission or error checks, it just +-- does the low-level operation. chanDelInvite un = chanInvites %~ delete un -chanChangeNick :: NickKey -> NickKey -> IrcChannel -> IrcChannel +-- | Change the nick of a user on the channel. This will replace the +-- old name with the news name in the member list, invitation list, +-- and the mode flags for privileges. It will only affect the +-- channel, not the user or other server records. +chanChangeNick :: NickKey -- ^ old nickname + -> NickKey -- ^ new nickname + -> IrcChannel -- ^ channel to modify + -> IrcChannel -- ^ channel with nickname changed chanChangeNick old new ch = (chOps . chVoice . chInvite . chUsers) ch where chOps @@ -122,16 +217,37 @@ chanChangeNick old new ch = (chOps . chVoice . chInvite . chUsers) ch | chanHasUser old ch = chanDelUser old . chanAddUser new | otherwise = id -chanUserIsOper :: NickKey -> IrcChannel -> Bool +-- | Is the nickname an operator of the channel? Returns 'True' if +-- the user is a channel op. This does not consider any other +-- privileges. +chanUserIsOper :: NickKey -- ^ nickname to check + -> IrcChannel -- ^ channel to check + -> Bool -- ^ 'True' if nickname has ops on channel chanUserIsOper un ch = member un $ ch ^. chanOpers -chanUserHasVoice :: NickKey -> IrcChannel -> Bool +-- | Does the nickname have voice on the channel? Returns 'True' if +-- the user has the voice mode flag. This does not consider any other +-- privileges or conditions. +chanUserHasVoice :: NickKey -- ^ nickname to check + -> IrcChannel -- ^ channel to check + -> Bool -- ^ 'True' if nickname has voice on channel chanUserHasVoice un ch = member un $ ch ^. chanVoices -chanUserIsInvited :: NickKey -> IrcChannel -> Bool +-- | Has the nickname been invited to the channel? Returns 'True' if +-- the user has been invited. This does not consider any other +-- privileges or conditions. +chanUserIsInvited :: NickKey -- ^ nickname to check + -> IrcChannel -- ^ channel to check + -> Bool -- ^ 'True' if nickname has been invited chanUserIsInvited un ch = member un $ ch ^. chanInvites -chanUserMaySpeak :: NickKey -> IrcChannel -> Bool +-- | Is the nickname allowed to speak on the channel? Returns 'True' +-- if the relevant permission checks all pass. The checks consider +-- channel membership, the NoOutsideMsgs flag, the Moderated flag and +-- Voice status, and channel Operator status. +chanUserMaySpeak :: NickKey -- ^ nickname to check + -> IrcChannel -- ^ channel to check + -> Bool -- ^ 'True' if nickname may speak on channel chanUserMaySpeak un ch | (chanHasUser un ch || not (chanHasModeFlag NoOutsideMsgs ch)) && not (chanHasModeFlag Moderated ch) = True @@ -139,13 +255,22 @@ chanUserMaySpeak un ch | chanUserHasVoice un ch = True | otherwise = False -chanUserMayJoin :: NickKey -> IrcChannel -> Bool +-- | Is the nickname allowed to join the channel? Returns 'True' if +-- the relevant permission checks all pass. The checks consider the +-- InviteOnly flag and whether an invitation has been issued. +chanUserMayJoin :: NickKey -- ^ nickname to check + -> IrcChannel -- ^ channel to check + -> Bool -- ^ 'True' if nickname may join the channel chanUserMayJoin un ch | not $ chanHasModeFlag InviteOnly ch = True | chanUserIsInvited un ch = True | otherwise = False -chanUserMaySetTopic :: NickKey -> IrcChannel -> Bool +-- | Is the nickname allowed to set the topic for the channel? +-- Returns 'True' if the relevant permission checks all pass. +chanUserMaySetTopic :: NickKey -- ^ nickname to check + -> IrcChannel -- ^ channel to check + -> Bool -- ^ 'True' if nickname may set the topic chanUserMaySetTopic un ch | not (chanHasModeFlag TopicOperOnly ch) && chanHasUser un ch = True diff --git a/src/Pipes/IRC/Server/Server.hs b/src/Pipes/IRC/Server/Server.hs index a63ae7e..9dc41bd 100644 --- a/src/Pipes/IRC/Server/Server.hs +++ b/src/Pipes/IRC/Server/Server.hs @@ -1,11 +1,22 @@ -- | This module contains the pure functions for transforming the state of -- the IRC server record ('IrcServer') as commands are processed. It depends --- on the "Server.User" and "Server.Channel" modules for some transformations --- of user and channel ('IrcUser' and 'IrcChannel') structures. +-- on the "User" and "Channel" modules for some transformations of user and +-- channel ('IrcUser' and 'IrcChannel') structures. module Pipes.IRC.Server.Server - ( ircAddUser, ircDelUser, ircHasUser, ircHasChan, ircJoin - , ircPart, ircInvite, ircInviteCheck, ircPassCheck - , ircChangeNick ) + ( ircAddUser + , ircDelUser + , ircHasUser + , ircHasChan + , ircJoin + , ircPart + , ircInvite + , ircInviteCheck + , ircPassCheck + , ircChangeNick + , NickKey + , IrcUser(..) + , IrcUserMode(..) + ) where import Control.Lens diff --git a/src/Pipes/IRC/Server/Types.hs b/src/Pipes/IRC/Server/Types.hs index def112b..8c07e52 100644 --- a/src/Pipes/IRC/Server/Types.hs +++ b/src/Pipes/IRC/Server/Types.hs @@ -3,7 +3,10 @@ module Pipes.IRC.Server.Types ( module Pipes.IRC.Server.Types - , HostPreference (..), ServiceName, SockAddr, Socket + , HostPreference (..) + , ServiceName + , SockAddr + , Socket ) where @@ -19,72 +22,139 @@ import Pipes.IRC.Message.Types (IrcMessage, NickName) import Pipes.Network.TCP (HostPreference (..), ServiceName, SockAddr, Socket) +-- * Data structures for managing the pure component of the server + +-- | A type alias for nicknames type NickKey = ByteString + +-- | A type alias for channel names type ChanKey = ByteString + +-- | A type alias for password keys type PassKey = ByteString +-- | A sequence of 'IrcEvent's type IrcEvents = [IrcEvent] +-- | An 'IrcEvent' represents an action that should occur due to the processing +-- of actions within the 'IrcMonad'. It includes sending messages, closing +-- connections, etc. data IrcEvent = Msg { _outMsg :: !IrcMessage + -- ^ An 'IrcMessage' to send over the network , _outDest :: ![Int] + -- ^ The connection ids to send the message on } - | Close { _closeConn :: Int } - | Pong { _pongConn :: Int } + | Close { _closeConn :: Int + -- ^ The connection id to close + } + | Pong { _pongConn :: Int + -- ^ The connection id to send a PONG message to + } deriving (Show) makeLenses ''IrcEvent -data IrcUserMode = Away | Invisible | WallOps | Restricted - | Oper | LocalOper | ServerNotices +-- | An 'IrcUserMode' represents some privilege or state of a user. They are +-- used for various different purposes. +data IrcUserMode = Away -- ^ the user is marked as away from keyboard + | Invisible -- ^ the user does not show in WHO listings + | WallOps -- ^ the user receives WALLOPS messages + | Restricted -- ^ ??? + | Oper -- ^ the user is an IRC operator + | LocalOper -- ^ the user is a local server operator + | ServerNotices -- ^ the user receives server notices deriving (Show, Eq, Enum, Ord) +-- | An 'IrcUser' record tracks the state of a registered user that is not +-- channel-specific. data IrcUser = IrcUser { _userServerName :: !ByteString + -- ^ the server that the user connected from , _userModes :: !(Set IrcUserMode) + -- ^ the mode flags that the user has set , _userChannels :: !(Set ChanKey) + -- ^ channels that the user is a current member of , _userConn :: !Int + -- ^ an integer identifying the user's connection , _userInvites :: !(Set ChanKey) + -- ^ the set of channels that the user is invited to } deriving (Show, Eq) makeLenses ''IrcUser -data IrcChanModeFlags = Anonymous | InviteOnly | Moderated | NoOutsideMsgs - | Quiet | Private | Secret | TopicOperOnly +-- | The 'IrcChanModeFlags' represent some state that is specific to a channel. +-- They are used for various purposes. +data IrcChanModeFlags = Anonymous -- ^ all communication is anonymized + | InviteOnly -- ^ only invited users may join + | Moderated -- ^ only ops or voice may speak + | NoOutsideMsgs -- ^ only members may speak + | Quiet -- ^ ??? + | Private -- ^ channel shows up as private in list + | Secret -- ^ channel does not appear in list + | TopicOperOnly -- ^ topic may only be set by ops deriving (Show, Eq, Enum, Ord) +-- | An 'IrcChannel' record tracks the state of a channel. data IrcChannel = IrcChannel { _chanTopic :: !(Maybe ByteString) + -- ^ the topic of discussion for the channel , _chanPass :: !(Maybe ByteString) + -- ^ key that must be given to join the channel , _chanModeFlags :: !(Set IrcChanModeFlags) + -- ^ various configuration options for channel behavior , _chanUsers :: !(Set NickKey) + -- ^ users that have joined the channel , _chanOpers :: !(Set NickKey) + -- ^ users in the channel with ops , _chanVoices :: !(Set NickKey) + -- ^ users in the channel with voice , _chanInvites :: !(Set NickKey) + -- ^ users that have been invited to the channel } deriving (Show, Eq) makeLenses ''IrcChannel +-- | An 'IrcServer' record tracks the pure state of the server. data IrcServer = IrcServer { _ircNicks :: !(Set NickKey) + -- ^ the nicknames currently known to be in use , _ircUsers :: !(Map NickKey IrcUser) + -- ^ users that have been registered , _ircChannels :: !(Map ChanKey IrcChannel) + -- ^ channels that have at least one user , _ircVersion :: !ByteString + -- ^ version of the server } deriving (Show) makeLenses ''IrcServer +-- | Configuration options for the server data IrcConfig = IrcConfig { _ircPort :: !ServiceName + -- ^ port on which the server should listen for connections , _ircHost :: !HostPreference + -- ^ interface name on which the server should listen , _ircHostName :: !ByteString + -- ^ official server name of the server , _ircMotd :: ![ByteString] + -- ^ MOTD to send to new connections to the server , _ircPass :: !(Maybe ByteString) + -- ^ a secret password that must be entered to register } deriving (Show) makeLenses ''IrcConfig +-- | Data that tracks the registration information of clients data RegState = Unreg { _rcvdPass :: !(Maybe ByteString) + -- ^ the password given via PASS , _rcvdNick :: !(Maybe NickKey) - , _rcvdName :: !(Maybe ByteString) } - | RegUser { _regdNick :: !NickName } + -- ^ the nickname given during registration + , _rcvdName :: !(Maybe ByteString) + -- ^ the real name given during registration + } + | RegUser { _regdNick :: !NickName + -- ^ information about a user from registration + } deriving (Show) makeLenses ''RegState +-- * Data structures for managing the IO portion of the server + data IrcConnection = IrcConnection { _sock :: !Socket , _addr :: !SockAddr