Lots of haddock comments
Levi Pearson
parent
91fcf5f78c
commit
45eb76c8af
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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, chanDelUser :: NickKey -- ^ user to add to channel
|
||||
-> IrcChannel -- ^ channel on which to add user
|
||||
-> IrcChannel -- ^ channel with user added
|
||||
|
||||
-- | 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)
|
||||
|
||||
chanHasUser :: NickKey -> IrcChannel -> Bool
|
||||
-- | 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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
-- ^ The connection id to close
|
||||
}
|
||||
| Pong { _pongConn :: Int
|
||||
-- ^ The connection id to send a PONG message to
|
||||
}
|
||||
| Close { _closeConn :: Int }
|
||||
| Pong { _pongConn :: Int }
|
||||
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue