{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE PatternGuards #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}

-- | This module implements a high-level view of the state of
-- the IRC connection. The library user calls 'advanceModel' to
-- step the 'IrcConnection' as new messages arrive.
module Irc.Model
  ( -- * IRC Connection model
    IrcConnection(..)
  , connNick
  , connChannels
  , connId
  , connChanModeTypes
  , connUserModeTypes
  , connKnock
  , connNickLen
  , connExcepts
  , connInvex
  , connStatusMsg
  , connTopicLen
  , connPhase
  , connModes
  , connUsers
  , connMyInfo
  , connSasl
  , connUmode
  , connSnoMask
  , connPingTime
  , defaultIrcConnection

  -- * Ping information
  , PingStatus(..)

  -- * Phases
  , Phase(..)

  -- * IRC Channel model
  , IrcChannel(..)
  , chanTopic
  , chanUsers
  , chanModes
  , chanCreation
  , chanMaskLists
  , chanUrl

  -- * Mode Settings
  , ModeTypes(..)
  , modesLists
  , modesAlwaysArg
  , modesSetArg
  , modesNeverArg
  , modesPrefixModes
  , defaultChanModeTypes
  , defaultUmodeTypes

  -- * Channel Mask Entry
  , IrcMaskEntry(..)
  , maskEntryMask
  , maskEntryWho
  , maskEntryStamp

  -- * User metadata
  , IrcUser(..)
  , usrAway
  , usrAccount
  , usrHost
  , defaultIrcUser

  -- * Model execution
  , runLogic
  , LogicOp(..)
  , Logic

  -- * General functionality
  , advanceModel
  , isChannelName
  , isNickName
  , isMyNick
  , splitStatusMsg
  , splitModes
  , unsplitModes
  , nickHasModeInChannel
  , channelHasMode
  ) where

import Control.Monad (guard)
import Control.Lens
import Control.Monad (foldM)
import Control.Monad.Free
import Control.Monad.Trans.Error
import Control.Monad.Trans.Reader
import Data.ByteString (ByteString)
import Data.Char (toUpper)
import Data.Fixed (Pico)
import Data.List (foldl',find,nub,delete,intersect)
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Data.Monoid
import Data.Text (Text)
import Data.Time
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map as Map
import Text.Read (readMaybe)

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif

import Irc.Format
import Irc.Message
import Irc.Cmd
import Irc.Core
import Irc.Core.Prisms

-- | 'IrcConnection' is the state of an IRC connection. It maintains
-- channel membership, user and channel modes, and other connection
-- state.
data IrcConnection = IrcConnection
  { _connNick     :: !Identifier
  , _connChannels :: !(Map Identifier IrcChannel)
  , _connId       :: Maybe ByteString
  , _connChanTypes :: [Char]
  , _connStatusMsg :: [Char]
  , _connKnock    :: !Bool
  , _connNickLen  :: !Int
  , _connExcepts  :: Maybe Char
  , _connInvex    :: Maybe Char
  , _connUsers    :: !(Map Identifier IrcUser)
  , _connChanModeTypes :: !ModeTypes
  , _connUserModeTypes :: !ModeTypes
  , _connModes    :: !Int
  , _connTopicLen :: !Int
  , _connMyInfo   :: Maybe (ByteString,ByteString)
  , _connSasl     :: Maybe (ByteString,ByteString)
  , _connUmode    :: !ByteString
  , _connSnoMask  :: !ByteString
  , _connPhase    :: !Phase
  , _connPingTime :: !PingStatus
  }
  deriving (Read, Show)

data PingStatus = PingTime Pico | PingSent UTCTime | NoPing
  deriving (Read, Show)

-- | 'IrcConnection' value with everything unspecified
defaultIrcConnection :: IrcConnection
defaultIrcConnection = IrcConnection
  { _connNick      = mkId ""
  , _connChannels  = mempty
  , _connId        = Nothing
  , _connChanTypes = "#&" -- default per RFC
  , _connStatusMsg = ""
  , _connKnock     = False
  , _connNickLen   = 9
  , _connExcepts   = Nothing
  , _connInvex     = Nothing
  , _connUsers     = mempty
  , _connModes     = 3
  , _connTopicLen  = 400 -- default is unbounded but message length is bounded
  , _connChanModeTypes = defaultChanModeTypes
  , _connUserModeTypes = defaultUmodeTypes
  , _connMyInfo    = Nothing
  , _connSasl      = Nothing
  , _connUmode     = ""
  , _connSnoMask   = ""
  , _connPhase     = RegistrationPhase
  , _connPingTime  = NoPing
  }

data Phase
  = RegistrationPhase
  | ActivePhase
  | SaslPhase
  deriving (Read, Show, Eq)

-- | Settings that describe how to interpret channel modes
data ModeTypes = ModeTypes
  { _modesLists :: String
  , _modesAlwaysArg :: String
  , _modesSetArg :: String
  , _modesNeverArg :: String
  , _modesPrefixModes :: [(Char,Char)]
  }
  deriving (Read, Show)

-- | The channel modes used by Freenode
defaultChanModeTypes :: ModeTypes
defaultChanModeTypes = ModeTypes
  { _modesLists     = "eIbq"
  , _modesAlwaysArg = "k"
  , _modesSetArg    = "flj"
  , _modesNeverArg  = "CFLMPQScgimnprstz"
  , _modesPrefixModes = [('o','@'),('v','+')]
  }

-- | The default UMODE as defined by Freenode
defaultUmodeTypes :: ModeTypes
defaultUmodeTypes = ModeTypes
  { _modesLists     = ""
  , _modesAlwaysArg = ""
  , _modesSetArg    = "s"
  , _modesNeverArg  = ""
  , _modesPrefixModes = []
  }

-- | 'IrcChannel' represents the current state of a channel
-- as seen on the connection. It includes all user lists,
-- modes, and other metadata about a channel.
data IrcChannel = IrcChannel
  { _chanTopic :: Maybe (Maybe (Text, ByteString, UTCTime)) -- TODO: use UserInfo
  , _chanUsers :: !(Map Identifier String) -- modes: ov
  , _chanModes :: Maybe (Map Char ByteString)
  , _chanCreation :: Maybe UTCTime
  , _chanMaskLists :: Map Char [IrcMaskEntry]
  , _chanUrl :: Maybe ByteString
  }
  deriving (Read, Show)

-- | Default value for 'IrcChannel' with everything unspecified.
defaultChannel :: IrcChannel
defaultChannel = IrcChannel
  { _chanTopic = Nothing
  , _chanModes = Nothing
  , _chanCreation = Nothing
  , _chanUsers = mempty
  , _chanMaskLists = mempty
  , _chanUrl = Nothing
  }

-- | Mask entries are used to represent an entry in a ban list for
-- a channel.
data IrcMaskEntry = IrcMaskEntry
  { _maskEntryMask  :: ByteString
  , _maskEntryWho   :: ByteString
  , _maskEntryStamp :: UTCTime
  }
  deriving (Read, Show)

-- | 'IrcUser' is the type of user-level metadata tracked for
-- the users visible on the current IRC connection.
data IrcUser = IrcUser
  { _usrAway :: !Bool
  , _usrAccount :: !(Maybe ByteString)
  , _usrHost    :: !(Maybe ByteString)
  }
  deriving (Read,Show)

-- | This represents the metadata of an unknown user.
defaultIrcUser :: IrcUser
defaultIrcUser = IrcUser
  { _usrAway    = False
  , _usrAccount = Nothing
  , _usrHost    = Nothing
  }

data Fuzzy a = Known !a | Unknown | None
  deriving (Read,Show)

makeLenses ''IrcConnection
makeLenses ''IrcChannel
makeLenses ''IrcUser
makeLenses ''IrcMaskEntry
makeLenses ''ModeTypes


-- | Primary state machine step function. Call this function with a timestamp
-- and a server message to update the 'IrcConnection' state. If additional
-- messages are required they will be requested via the 'Logic' type.
advanceModel :: MsgFromServer -> IrcConnection -> Logic IrcConnection
advanceModel msg0 conn =
  case msg0 of
       Ping x -> sendMessage (pongCmd x) >> return conn

       -- Treat numbers as POSIX times when PING was sent
       Pong _ txt
          | Just sec <- readMaybe (B8.unpack txt) ->
                do now <- getStamp
                   let past = posixSecondsToUTCTime (realToFrac (sec :: Pico))
                       delta = realToFrac (now `diffUTCTime` past)
                   return (set connPingTime (PingTime delta) conn)

       Pong mbServer msg ->
         doServerMessage "Pong" (maybe "" (<>" ") mbServer <> msg) conn

       RplWelcome  txt -> doServerMessage "Welcome" txt
                        $ set connPhase ActivePhase conn
       RplYourHost txt -> doServerMessage "YourHost" txt conn
       RplCreated  txt -> doServerMessage "Created" txt conn
       RplMyInfo host version _ ->
         return (set connMyInfo (Just (host,version)) conn)

       -- Random uninteresting statistics
       RplLuserOp _         -> return conn
       RplLuserChannels _   -> return conn
       RplLuserMe _         -> return conn
       RplLuserClient _     -> return conn
       RplLocalUsers _      -> return conn
       RplGlobalUsers _     -> return conn
       RplStatsConn _       -> return conn
       RplLuserUnknown _    -> return conn

       RplLuserAdminMe    txt ->
         doServerMessage "ADMIN" txt conn
       RplLuserAdminLoc1  txt ->
         doServerMessage "ADMIN" txt conn
       RplLuserAdminLoc2  txt ->
         doServerMessage "ADMIN" txt conn
       RplLuserAdminEmail txt ->
         doServerMessage "ADMIN" txt conn

       -- Channel list not implemented
       RplListStart     -> return conn
       RplList chan count topic -> doList chan count topic conn
       RplListEnd       -> return conn

       RplUserHost host ->
         doServerMessage "USERHOST" (B8.unwords host) conn

       RplTime server time -> doServerMessage "TIME" (B8.unwords [server,time]) conn

       RplInfo _ -> return conn
       RplEndOfInfo -> return conn

       Join who chan -> doJoinChannel who Unknown chan conn
       ExtJoin who chan account _realname -> doJoinChannel who (maybe None Known account) chan conn
       Part who chan reason -> doPart who chan reason conn
       Kick who chan tgt reason -> doKick who chan tgt reason conn
       Quit who reason -> doQuit who reason conn
       Nick who newnick -> doNick who newnick conn

       RplChannelUrl chan url ->
            return (set (connChannels . ix chan . chanUrl)
                        (Just url)
                        conn)

       RplNoTopicSet chan ->
          return (set (connChannels . ix chan . chanTopic)
                      (Just Nothing)
                      conn)

       RplTopic chan topic ->
         do RplTopicWhoTime _ who time <- getMessage
            return (set (connChannels . ix chan . chanTopic)
                        (Just (Just (asUtf8 topic,who,time)))
                        conn)
       RplTopicWhoTime _ _ _ ->
          fail "Unexpected RPL_TOPICWHOTIME"

       Topic who chan topic -> doTopic who chan topic conn

       PrivMsg who chan msg -> doPrivMsg who chan msg conn

       Notice who chan msg -> doNotifyChannel who chan msg conn

       Account who acct ->
         return (set (connUsers . ix (userNick who) . usrAccount) acct conn)

       Away who Just{} ->
         return (updateUserRecord (userNick who) (set usrAway True) conn)

       Away who Nothing ->
         return (updateUserRecord (userNick who) (set usrAway False) conn)

       RplYourId yourId -> return (set connId (Just yourId) conn)

       RplMotdStart -> return conn
       RplEndOfMotd -> return conn
       RplMotd x    -> doServerMessage "MOTD" x conn

       RplNameReply _ chan xs -> doNameReply chan xs conn
       RplEndOfNames _ -> return conn

       RplChannelModeIs chan modes params -> doChannelModeIs chan modes params conn

       RplCreationTime chan creation ->
         return (set (connChannels . ix chan . chanCreation) (Just creation) conn)

       RplWhoReply _chan _username hostname _servername nickname flags _realname ->
         doWhoReply nickname hostname flags conn

       RplEndOfWho _chan -> return conn

       RplIsOn nicks -> return (doIsOn nicks conn)

       RplBanList chan mask who when ->
         doMaskList (preview _RplBanList)
                    (has _RplEndOfBanList)
                    'b' chan
                    [IrcMaskEntry
                      { _maskEntryMask  = mask
                      , _maskEntryWho   = who
                      , _maskEntryStamp = when
                      } ] conn

       RplEndOfBanList chan ->
         return (set (connChannels . ix chan . chanMaskLists . at 'b') (Just []) conn)

       RplInviteList chan mask who when ->
         doMaskList (preview _RplInviteList)
                    (has _RplEndOfInviteList)
                    'I' chan
                    [IrcMaskEntry
                      { _maskEntryMask  = mask
                      , _maskEntryWho   = who
                      , _maskEntryStamp = when
                      } ] conn

       RplEndOfInviteList chan ->
         return (set (connChannels . ix chan . chanMaskLists . at 'I') (Just []) conn)

       RplExceptionList chan mask who when ->
         doMaskList (preview _RplExceptionList)
                    (has _RplEndOfExceptionList)
                    'e' chan
                    [IrcMaskEntry
                      { _maskEntryMask  = mask
                      , _maskEntryWho   = who
                      , _maskEntryStamp = when
                      } ] conn

       RplEndOfExceptionList chan ->
         return (set (connChannels . ix chan . chanMaskLists . at 'e') (Just []) conn)

       RplQuietList chan mode mask who when ->
         let fixup (a,_,c,d,e) = (a,c,d,e) in -- drop the matched mode field
         doMaskList (previews _RplQuietList fixup)
                    (has _RplEndOfQuietList)
                    mode chan
                    [IrcMaskEntry
                      { _maskEntryMask  = mask
                      , _maskEntryWho   = who
                      , _maskEntryStamp = when
                      } ] conn

       RplEndOfQuietList chan mode ->
         return (set (connChannels . ix chan . chanMaskLists . at mode) (Just []) conn)

       Mode _ _ [] -> fail "Unexpected MODE"
       Mode who target (modes:args) ->
         doModeChange who target modes args conn

       RplSnoMask snomask ->
         return (set connSnoMask snomask conn)

       RplUmodeIs mode _params -> -- TODO: params?
         return (set connUmode (B.tail mode) conn)

       Err target err ->
         do now <- getStamp
            let mesg = defaultIrcMessage
                  { _mesgType    = ErrMsgType err
                  , _mesgSender  = UserInfo "" Nothing Nothing
                  , _mesgStamp   = now
                  }
            recordMessage mesg target conn

       RplKnockDelivered chan ->
         doChannelError chan "Knock delivered" conn
       RplKnock chan who ->
         do now <- getStamp
            let mesg = defaultIrcMessage
                  { _mesgType    = KnockMsgType
                  , _mesgSender  = who
                  , _mesgStamp   = now
                  }
            recordMessage mesg chan conn

       RplInviting nick chan ->
         doChannelError chan ("Inviting " <> asUtf8 (idBytes nick)) conn
       Invite who chan ->
         do now <- getStamp
            let mesg = defaultIrcMessage
                  { _mesgType    = InviteMsgType
                  , _mesgSender  = who
                  , _mesgStamp   = now
                  }
            recordMessage mesg chan conn

       -- TODO: Structure this more nicely than as simple message,
       -- perhaps store it in the user map
       RplWhoisUser nick user host real ->
         doServerMessage "WHOIS" (B8.unwords [idBytes nick, user, host, real])
            (updateUserRecord nick (set usrHost (Just host)) conn)
       RplWhoisChannels _nick channels ->
         doServerMessage "WHOIS" channels conn
       RplWhoisServer _nick host txt ->
         doServerMessage "WHOIS" (B8.unwords [host,txt]) conn
       RplWhoisSecure _nick ->
         doServerMessage "WHOIS" "secure connection" conn
       RplWhoisHost _nick txt ->
         doServerMessage "WHOIS" txt conn
       RplWhoisIdle _nick idle signon ->
         doServerMessage "WHOIS" ("Idle seconds: " <> B8.pack (show idle) <>
                                  ", Sign-on: " <> maybe "unknown" (B8.pack . show)
                                                        signon
                                 ) conn
       RplWhoisAccount nick account ->
         doServerMessage "WHOIS" ("Logged in as: " <> account)
            (set (connUsers . ix nick . usrAccount) (Just account) conn)
       RplWhoisModes _nick modes args ->
         doServerMessage "WHOIS" ("Modes: " <> B8.unwords (modes:args)) conn
       RplWhoisOperator _nick txt  ->
         doServerMessage "WHOIS" ("Operator: " <> txt) conn
       RplWhoisCertFp _nick txt  ->
         doServerMessage "WHOIS" ("CertFP: " <> txt) conn
       RplEndOfWhois _nick ->
         doServerMessage "WHOIS" "--END--" conn

       RplSyntax txt ->
         doServerMessage "SYNTAX" txt conn
       RplAway nick message ->
         doAwayReply nick (asUtf8 message) conn
       RplUnAway ->
         doServerMessage "AWAY" "You are no longer marked away" conn
       RplNowAway ->
         doServerMessage "AWAY" "You are marked away" conn

       RplWhoWasUser nick user host real ->
         doServerMessage "WHOWAS" (B8.unwords [idBytes nick, user, host, real]) conn
       RplEndOfWhoWas _nick ->
         doServerMessage "WHOWAS" "--END--" conn

       RplHostHidden host ->
         doServerMessage "HOST" ("Host hidden: " <> host) conn
       RplYoureOper txt ->
         doServerMessage "OPER" txt conn

       RplHelpStart topic txt -> doServerMessage topic txt conn
       RplHelp      topic txt -> doServerMessage topic txt conn
       RplEndOfHelp topic     -> doServerMessage topic "--END--" conn

       Cap "LS" caps -> doCapLs caps conn
       Cap "ACK" caps -> doCapAck caps conn
       Cap "NACK" _caps -> sendMessage capEndCmd >> return conn
       Cap _ _ -> fail "Unexpected CAP"
       RplSaslAborted -> return conn

       RplLoadTooHigh cmd ->
         doServerError ("Command rate limited: " <> asUtf8 cmd) conn
       RplNickLocked ->
         doServerError "Nickname locked" conn
       RplLoggedIn account ->
         doServerMessage "LOGIN" account conn
       RplLoggedOut ->
         doServerMessage "LOGOUT" "" conn
       RplSaslTooLong ->
         doServerError "Unexpected SASL Too Long" conn
       RplSaslAlready ->
         doServerError "Unexpected SASL Already" conn
       RplSaslMechs _ ->
         doServerError "Unexpected SASL Mechanism List" conn

       Error e -> doServerError (asUtf8 e) conn

       RplISupport isupport -> doISupport isupport conn
       RplVersion version ->
         doServerMessage "VERSION" (B8.unwords version) conn

       RplUmodeGMsg nick mask -> doCallerId nick mask conn
       RplTargNotify nick -> doCallerIdDeliver nick conn

       RplAcceptList nick -> doAcceptList [nick] conn
       RplEndOfAccept -> doServerMessage "ACCEPTLIST" "Accept list empty" conn

       RplLinks mask server info -> doServerMessage "LINKS" (B8.unwords [mask,server,info]) conn
       RplEndOfLinks mask -> doServerMessage "LINKS" mask conn

       RplStatsLinkInfo linkinfo -> doServerMessage "LINKINFO" (B8.unwords linkinfo) conn
       RplStatsCommands commands -> doServerMessage "COMMANDS" (B8.unwords commands) conn
       RplStatsCLine cline -> doServerMessage "CLINE" (B8.unwords cline) conn
       RplStatsNLine nline -> doServerMessage "NLINE" (B8.unwords nline) conn
       RplStatsILine iline -> doServerMessage "ILINE" (B8.unwords iline) conn
       RplStatsKLine kline -> doServerMessage "KLINE" (B8.unwords kline) conn
       RplStatsQLine qline -> doServerMessage "QLINE" (B8.unwords qline) conn
       RplStatsYLine yline -> doServerMessage "YLINE" (B8.unwords yline) conn
       RplEndOfStats mode -> doServerMessage "ENDSTATS" (B8.pack [mode]) conn
       RplStatsPLine pline -> doServerMessage "PLINE" (B8.unwords pline) conn
       RplStatsDLine dline -> doServerMessage "DLINE" (B8.unwords dline) conn
       RplStatsVLine vline -> doServerMessage "VLINE" (B8.unwords vline) conn
       RplStatsLLine lline -> doServerMessage "LLINE" (B8.unwords lline) conn
       RplStatsUptime uptime -> doServerMessage "UPTIME" uptime conn
       RplStatsOLine oline -> doServerMessage "OLINE" (B8.unwords oline) conn
       RplStatsHLine hline -> doServerMessage "HLINE" (B8.unwords hline) conn
       RplStatsSLine sline -> doServerMessage "SLINE" (B8.unwords sline) conn
       RplStatsPing  ping  -> doServerMessage "STATSPING" (B8.unwords ping) conn
       RplStatsXLine xline -> doServerMessage "XLINE" (B8.unwords xline) conn
       RplStatsULine uline -> doServerMessage "ULINE" (B8.unwords uline) conn
       RplStatsDebug debug -> doServerMessage "STATSDEBUG" (B8.unwords debug) conn

       RplPrivs txt -> doServerMessage "PRIVS" txt conn

       Authenticate msg
         | view connPhase conn == SaslPhase
         , msg == "+"
         , Just (user,pass) <- view connSasl conn ->
             do sendMessage (authenticateCmd (encodePlainAuthentication user pass))
                return conn
         | otherwise ->
             doServerError "Unexpected Authenticate" conn

       RplSaslSuccess
         | view connPhase conn == SaslPhase ->
            do sendMessage capEndCmd
               doServerMessage "SASL" "Authentication successful"
                  $ set connPhase RegistrationPhase conn
         | otherwise ->
             doServerError "Unexpected SASL Success" conn

       RplSaslFail
         | view connPhase conn == SaslPhase ->
            do sendMessage capEndCmd
               doServerMessage "SASL" "Authentication failed"
                   $ set connPhase RegistrationPhase conn
         | otherwise ->
            doServerError "Unexpected SASL Fail" conn




-- ISUPPORT is defined by
-- https://tools.ietf.org/html/draft-brocklesby-irc-isupport-03#section-3.14
doISupport ::
  [(ByteString,ByteString)] {- ^ [(key,value)] -} ->
  IrcConnection -> Logic IrcConnection
doISupport params conn = return (foldl' (flip support) conn params)

support :: (ByteString,ByteString) -> IrcConnection -> IrcConnection
support ("CHANTYPES",types) = set connChanTypes (B8.unpack types)
support ("CHANMODES",modes) = updateChanModes (B8.unpack modes)
support ("STATUSMSG",modes) = set connStatusMsg (B8.unpack modes)
support ("PREFIX",modes) = updateChanPrefix (B8.unpack modes)
support ("KNOCK",_) = set connKnock True
support ("NICKLEN",len) =
  case B8.readInt len of
    Just (n,rest) | B.null rest -> set connNickLen n
    _                           -> id

support ("TOPICLEN",len) =
  case B8.readInt len of
    Just (n,rest) | B.null rest -> set connTopicLen n
    _                           -> id

support ("MODES",str) =
  case B8.readInt str of
    Just (n,rest) | B.null rest -> set connModes (max 1 n)
    _                           -> id

support ("INVEX",mode) =
  case B8.uncons mode of
    Nothing    -> set connInvex (Just 'I')
    Just (m,_) -> set connInvex (Just $! m)

support ("EXCEPTS",mode) =
  case B8.uncons mode of
    Nothing    -> set connExcepts (Just 'e')
    Just (m,_) -> set connExcepts (Just $! m)

support _ = id

updateChanModes ::
  String {- lists,always,set,never -} ->
  IrcConnection -> IrcConnection
updateChanModes modes
  = over connChanModeTypes
  $ set modesLists listModes
  . set modesAlwaysArg alwaysModes
  . set modesSetArg setModes
  . set modesNeverArg neverModes
  where
  next = over _2 (drop 1) . break (==',')
  (listModes  ,modes1) = next modes
  (alwaysModes,modes2) = next modes1
  (setModes   ,modes3) = next modes2
  (neverModes ,_)      = next modes3

updateChanPrefix ::
  String {- e.g. (ov)@+ -} ->
  IrcConnection -> IrcConnection
updateChanPrefix [] = id
updateChanPrefix (_:modes) =
  set (connChanModeTypes . modesPrefixModes) (zip a b)
  where
  (a,b) = over _2 (drop 1) (break (==')') modes)

doAcceptList ::
  [Identifier] {- ^ nicks -} ->
  IrcConnection -> Logic IrcConnection
doAcceptList acc conn =
  do msg <- getMessage
     case msg of
       RplAcceptList nick -> doAcceptList (nick:acc) conn
       RplEndOfAccept     -> doServerMessage "ACCEPTLIST"
                                (B8.unwords (map idBytes (reverse acc))) conn
       _ -> fail "doAcceptList: Unexpected message!"

doCallerIdDeliver ::
  Identifier {- ^ nick -} ->
  IrcConnection -> Logic IrcConnection
doCallerIdDeliver nick conn =
  do stamp <- getStamp
     let mesg = defaultIrcMessage
           { _mesgType    = CallerIdDeliveredMsgType
           , _mesgSender  = UserInfo nick Nothing Nothing
           , _mesgStamp   = stamp
           }
     recordMessage mesg nick conn

doCallerId ::
  Identifier {- ^ nick -} ->
  ByteString {- ^ user\@host -} ->
  IrcConnection -> Logic IrcConnection
doCallerId nick mask conn =
  do stamp <- getStamp
     let (user,host) = B8.break (=='@') mask
     let mesg = defaultIrcMessage
           { _mesgType    = CallerIdMsgType
           , _mesgSender  = UserInfo nick (Just user) (Just (B8.drop 1 host))
           , _mesgStamp   = stamp
           }
     recordMessage mesg nick conn

doList ::
  Identifier {- ^ channel -} ->
  Integer    {- ^ members -} ->
  ByteString {- ^ topic   -} ->
  IrcConnection -> Logic IrcConnection
doList chan num topic =
  doServerMessage "LIST"
    (B8.unwords [idBytes chan, " - ",
                 B8.pack (show num), " - ",
                 topic])

doAwayReply ::
  Identifier {- ^ nickname -} ->
  Text       {- ^ away message -} ->
  IrcConnection -> Logic IrcConnection
doAwayReply nick message conn =
  do stamp <- getStamp
     let mesg = defaultIrcMessage
           { _mesgType    = AwayMsgType message
           , _mesgSender  = UserInfo nick Nothing Nothing
           , _mesgStamp   = stamp
           }
     recordMessage mesg nick conn

doChannelError ::
  Identifier {- ^ channel -} ->
  Text       {- ^ error   -} ->
  IrcConnection -> Logic IrcConnection
doChannelError chan reason conn =
  do stamp <- getStamp
     let mesg = defaultIrcMessage
           { _mesgType    = ErrorMsgType reason
           , _mesgSender  = UserInfo (mkId "server") Nothing Nothing
           , _mesgStamp   = stamp
           }
     recordMessage mesg chan conn

-- | Event handler when receiving a new privmsg.
-- The message will be passed along as an event.
doPrivMsg ::
  UserInfo   {- ^ sender         -} ->
  Identifier {- ^ message target -} ->
  ByteString {- ^ message        -} ->
  IrcConnection -> Logic IrcConnection
doPrivMsg who chan msg conn =
  do stamp <- getStamp
     let (statusmsg, chan') = splitStatusMsg chan conn
         modes = view (connChannels . ix chan' . chanUsers . ix (userNick who)) conn
         mesg = defaultIrcMessage
                { _mesgType    = ty
                , _mesgSender  = who
                , _mesgStamp   = stamp
                , _mesgStatus  = statusmsg
                , _mesgModes   = modes
                }
         ty = case parseCtcpCommand msg of
                Nothing                 -> PrivMsgType (asUtf8 msg)
                Just ("ACTION", action) -> ActionMsgType (asUtf8 action)
                Just (command , args  ) -> CtcpReqMsgType command args

     recordMessage mesg chan' conn

parseCtcpCommand :: ByteString -> Maybe (ByteString, ByteString)
parseCtcpCommand msg
  | B8.length msg >= 3
  , B8.head   msg == '\^A'
  , B8.last   msg == '\^A' = Just (B8.map toUpper command, B8.drop 1 rest)
  | otherwise              = Nothing
  where
  sansControls = B8.tail (B8.init msg)
  (command,rest) = B8.break (==' ') sansControls

-- | Record the new topic as set by the given user and
-- emit a change event.
doTopic ::
  UserInfo  {- ^ changed by -} ->
  Identifier {- ^ channel -} ->
  ByteString {- ^ topic text -} ->
  IrcConnection -> Logic IrcConnection
doTopic who chan topic conn =
  do stamp <- getStamp
     let topicText = asUtf8 topic
         modes = view (connChannels . ix chan . chanUsers . ix (userNick who)) conn
         m = defaultIrcMessage
                { _mesgType = TopicMsgType topicText
                , _mesgSender = who
                , _mesgStamp = stamp
                , _mesgModes = modes
                }
         topicEntry = Just (topicText,renderUserInfo who,stamp)
         conn1 = set (connChannels . ix chan . chanTopic) (Just topicEntry) conn
     recordMessage m chan conn1

doCapLs :: ByteString -> IrcConnection -> Logic IrcConnection
doCapLs rawCaps conn =
  do sendMessage (capReqCmd activeCaps)
     return conn
  where
  activeCaps = intersect supportedCaps offeredCaps
  offeredCaps = B8.words rawCaps
  supportedCaps = saslSupport
               ++ ["away-notify","account-notify","userhost-in-names",
                   "extended-join","multi-prefix",
                   "znc.in/server-time-iso","server-time",
                   "znc.in/self-message"]
  saslSupport =
    case view connSasl conn of
      Nothing -> []
      Just{}  -> ["sasl"]

doCapAck ::
  ByteString {- ^ raw, spaces delimited caps list -} ->
  IrcConnection -> Logic IrcConnection
doCapAck rawCaps conn =
  let ackCaps = B8.words rawCaps in
  case view connSasl conn of
    Just{} | "sasl" `elem` ackCaps ->
         do sendMessage (authenticateCmd "PLAIN")
            return (set connPhase SaslPhase conn)
    _ -> do sendMessage capEndCmd
            return conn

encodePlainAuthentication ::
  ByteString {- ^ username -} ->
  ByteString {- ^ password -} ->
  ByteString
encodePlainAuthentication user pass
  = Base64.encode
  $ B8.intercalate "\0" [user,user,pass]


doChannelModeIs ::
  Identifier {- ^ Channel -} ->
  ByteString {- ^ modes -} ->
  [ByteString] {- ^ mode parameters -} ->
  IrcConnection -> Logic IrcConnection
doChannelModeIs chan modes args conn =
  case splitModes (view connChanModeTypes conn) modes args of
    Nothing -> fail "Bad mode string"
    Just xs -> return (set (connChannels . ix chan . chanModes) (Just modeMap) conn)
      where
      modeMap = Map.fromList [ (mode,arg) | (True,mode,arg) <- xs ]

doServerError :: Text -> IrcConnection -> Logic IrcConnection
doServerError err conn =
  do stamp <- getStamp
     let mesg = defaultIrcMessage
           { _mesgType    = ErrorMsgType err
           , _mesgSender  = UserInfo (mkId "server") Nothing Nothing
           , _mesgStamp   = stamp
           }
     recordFor "" mesg
     return conn

-- | Mark all the given nicks as active (not-away).
doIsOn ::
  [Identifier] {- ^ active nicks -} ->
  IrcConnection -> IrcConnection
doIsOn nicks conn = foldl' setIsOn conn nicks
  where
  setIsOn connAcc nick = updateUserRecord nick (set usrAway False) connAcc

doModeChange ::
  UserInfo     {- ^ who           -} ->
  Identifier   {- ^ target        -} ->
  ByteString   {- ^ modes changed -} ->
  [ByteString] {- ^ arguments     -} ->
  IrcConnection -> Logic IrcConnection
doModeChange who target modes0 args0 conn
  | isChannelName target conn =
      case splitModes modeSettings modes0 args0 of
        Nothing -> return conn
        Just ms -> doChannelModeChanges ms who target conn

  -- TODO: Implement user modes
  | otherwise =
      case splitModes (view connUserModeTypes conn) modes0 args0 of
        Nothing -> return conn
        Just ms -> return (doUserModeChanges ms conn)

  where
  modeSettings = view connChanModeTypes conn

doUserModeChanges ::
  [(Bool, Char, ByteString)] {- ^ [(+/-,mode,argument)] -} ->
  IrcConnection -> IrcConnection
doUserModeChanges ms =
  over connUmode addModes
  where
  addModes bs = B.sort (foldl' aux bs ms)
  aux bs (polarity,m,_)
    | polarity && B8.elem m bs = bs
    | polarity                 = B8.cons m bs
    | otherwise                = B8.filter (/= m) bs

doChannelModeChanges ::
  [(Bool, Char, ByteString)] {- ^ [(+/-,mode,argument)] -} ->
  UserInfo                   {- ^ changer               -} ->
  Identifier                 {- ^ channel               -} ->
  IrcConnection -> Logic IrcConnection
doChannelModeChanges ms who chan conn0 =
  do now <- getStamp
     foldM (aux now) conn0 ms
  where
  settings = view connChanModeTypes conn0

  aux now conn (polarity,m,a)
    = fmap (over (connChannels . ix chan)
                 (installModeChange settings now who polarity m a))
           (recordMessage modeMsg chan conn)
    where
    modeMsg = defaultIrcMessage
           { _mesgType   = ModeMsgType polarity m a
           , _mesgSender = who
           , _mesgStamp  = now
           , _mesgModes  = view ( connChannels . ix chan
                                . chanUsers . ix (userNick who)
                                ) conn
           }

installModeChange ::
  ModeTypes  {- ^ settings -} ->
  UTCTime    {- ^ timestamp -} ->
  UserInfo   {- ^ changer -} ->
  Bool       {- ^ +/-     -} ->
  Char       {- ^ mode    -} ->
  ByteString {- ^ argument -} ->
  IrcChannel -> IrcChannel
installModeChange settings now who polarity mode arg


  -- Handle bans, exceptions, invex, quiets
  | mode `elem` view modesLists settings =
      if polarity
         then over (chanMaskLists . ix mode)
                   (cons (IrcMaskEntry arg (renderUserInfo who) now))

         else over (chanMaskLists . ix mode)
                   (filter (\x -> ircFoldCase (view maskEntryMask x)
                               /= ircFoldCase arg))

  -- Handle ops and voices
  | mode `elem` views modesPrefixModes (map fst) settings =
      if polarity
         then over (chanUsers . ix (mkId arg))
                   (nub . cons mode)

         else over (chanUsers . ix (mkId arg))
                   (delete mode)

  | otherwise =
      if polarity
         then set (chanModes . mapped . at mode)
                  (Just arg)

         else set (chanModes . mapped . at mode)
                  Nothing

unsplitModes ::
  [(Bool,Char,ByteString)] ->
  [ByteString]
unsplitModes modes
  = B8.pack (foldr combineModeChars (const "") modes True)
  : [arg | (_,_,arg) <- modes, not (B.null arg)]
  where
  combineModeChars (q,m,_) rest p
    | p == q = m : rest p
    | q = '+' : m : rest True
    | otherwise = '-' : m : rest False


-- | Split up a mode change command and arguments into individual changes
-- given a configuration.
splitModes ::
  ModeTypes {- ^ mode interpretation -} ->
  ByteString   {- ^ modes               -} ->
  [ByteString] {- ^ arguments           -} ->
  Maybe [(Bool,Char,ByteString)]
splitModes icm modes0 =
  foldr aux (\_ args -> [] <$ guard (null args)) (B8.unpack modes0) True
  where
  aux ::
    Char                                        {- current mode -} ->
    (Bool -> [ByteString] -> Maybe [(Bool,Char,ByteString)])
           {- continuation with updated polarity and arguments -} ->
    Bool                                        {- current polarity -} ->
    [ByteString]                                {- current arguments -} ->
    Maybe [(Bool,Char,ByteString)]
  aux m rec polarity args =
    case m of
      '+' -> rec True  args
      '-' -> rec False args

      _ |             m `elem` view modesAlwaysArg icm
       || polarity && m `elem` view modesSetArg icm
       ||             m `elem` views modesPrefixModes (map fst) icm
       ||             m `elem` view modesLists icm ->
           do x:xs <- Just args
              fmap (cons (polarity,m,x)) (rec polarity xs)

        | otherwise -> -- default to no arg
              fmap (cons (polarity,m,"")) (rec polarity args)

doMaskList ::
  (MsgFromServer -> Maybe (Identifier,ByteString,ByteString,UTCTime)) ->
  (MsgFromServer -> Bool) ->
  Char ->
  Identifier ->
  [IrcMaskEntry] ->
  IrcConnection -> Logic IrcConnection
doMaskList matchEntry matchEnd mode chan acc conn =
  do msg <- getMessage
     case matchEntry msg of
       Just (_,mask,who,stamp) ->
         doMaskList
           matchEntry matchEnd
           mode chan
           (IrcMaskEntry
               { _maskEntryMask  = mask
               , _maskEntryWho   = who
               , _maskEntryStamp = stamp
               } : acc)
           conn

       _ | matchEnd msg ->
           return (set (connChannels . ix chan . chanMaskLists . at mode)
                       (Just (reverse acc))
                       conn)

       _ -> fail "Expected mode list end"


-- | Update an 'IrcConnection' when a user changes nicknames.
doNick ::
  UserInfo   {- ^ old user infomation -} ->
  Identifier {- ^ new nickname        -} ->
  IrcConnection -> Logic IrcConnection
doNick who newnick conn =
  do stamp <- getStamp
     let m = defaultIrcMessage
                { _mesgType = NickMsgType newnick
                , _mesgSender = who
                , _mesgStamp = stamp
                }

     let conn1 | isMyNick (userNick who) conn =
                        set connNick newnick conn
               | otherwise = conn

         conn2 = set (connUsers . at newnick)
                     (view (connUsers . at (userNick who)) conn1)
               $ set (connUsers . at (userNick who))
                     Nothing
               $ conn1

     iforOf (connChannels . itraversed) conn2 (updateChannel m)

  where
  oldnick = userNick who

  updateChannel :: IrcMessage -> Identifier -> IrcChannel -> Logic IrcChannel
  updateChannel m tgt chan
    | has (chanUsers . ix oldnick) chan
     = do recordFor tgt m
          pure $ set (chanUsers . at oldnick) Nothing
               $ set (chanUsers . at newnick) (view (chanUsers . at oldnick) chan)
               $ chan
    | otherwise = pure chan


-- | Update the 'IrcConnection' when a user parts from a channel.
doPart ::
  UserInfo   {- ^ user information -} ->
  Identifier {- ^ channel          -} ->
  ByteString {- ^ part reason      -} ->
  IrcConnection -> Logic IrcConnection
doPart who chan reason conn =
  do stamp <- getStamp
     let mesg = defaultIrcMessage
                { _mesgType = PartMsgType (asUtf8 reason)
                , _mesgSender = who
                , _mesgStamp = stamp
                }
         removeUser = set (chanUsers . at (userNick who)) Nothing

     conn1 <- fmap (over (connChannels . ix chan) removeUser)
                   (recordMessage mesg chan conn)

     let stillKnown = has (connChannels . folded . chanUsers . ix (userNick who))
                          conn1

         conn2 | stillKnown = conn1
               | otherwise  = set (connUsers . at (userNick who)) Nothing conn1

         conn3 | isMyNick (userNick who) conn =
                    set (connChannels . at chan) Nothing conn2
               | otherwise = conn2

     return conn3

-- | Update an 'IrcConnection' when a user is kicked from a channel.
doKick ::
  UserInfo   {- ^ kicker      -} ->
  Identifier {- ^ channel     -} ->
  Identifier {- ^ kicked      -} ->
  ByteString {- ^ kick reason -} ->
  IrcConnection -> Logic IrcConnection
doKick who chan tgt reason conn =
  do stamp <- getStamp
     let modes = view (connChannels . ix chan . chanUsers . ix (userNick who)) conn
         mesg = defaultIrcMessage
                { _mesgType = KickMsgType tgt (asUtf8 reason)
                , _mesgSender = who
                , _mesgStamp = stamp
                , _mesgModes = modes
                }

     let conn1 = set (connChannels . ix chan . chanUsers . at tgt)
                     Nothing
                     conn

         stillKnown = has (connChannels . folded . chanUsers . ix (userNick who))
                          conn1

         conn2 | stillKnown = conn1
               | otherwise  = set (connUsers . at (userNick who)) Nothing conn1

         conn3
           | isMyNick tgt conn2 =
                set (connChannels . at chan) Nothing conn2
           | otherwise = conn2

     recordMessage mesg chan conn3

updateUserRecord :: Identifier -> (IrcUser -> IrcUser) -> IrcConnection -> IrcConnection
updateUserRecord nick f conn =
  case view (connUsers . at nick) conn of
    Nothing -> conn
    Just old -> (set (connUsers . ix nick) $! f old) conn

doWhoReply :: Identifier -> ByteString -> ByteString -> IrcConnection -> Logic IrcConnection
doWhoReply nickname hostname flags conn =
  return $! updateUserRecord
              nickname
              (set usrAway away . updateHost)
              conn
  where
  away = not (B.null flags) && B.take 1 flags == "G"

  updateHost = set usrHost (Just hostname)

-- | Update an 'IrcConnection' with the quitting of a user.
doQuit ::
  UserInfo   {- ^ user info   -} ->
  ByteString {- ^ quit reason -} ->
  IrcConnection -> Logic IrcConnection
doQuit who reason conn =
  do stamp <- getStamp
     let mesg = defaultIrcMessage
                { _mesgType = QuitMsgType (asUtf8 reason)
                , _mesgSender = who
                , _mesgStamp = stamp
                }

     iforOf (connChannels . itraversed)
           (set (connUsers . at (userNick who)) Nothing conn)
           $ \tgt chan ->
       if has (chanUsers . ix (userNick who)) chan
         then do recordFor tgt mesg
                 pure (set (chanUsers . at (userNick who)) Nothing chan)
         else pure chan


doJoinChannel ::
  UserInfo         {- ^ who joined   -} ->
  Fuzzy ByteString {- ^ account name -} ->
  Identifier       {- ^ channel      -} ->
  IrcConnection -> Logic IrcConnection
doJoinChannel who acct chan conn =
  do stamp <- getStamp

     -- add channel if necessary
     let conn1
           | isMyNick (userNick who) conn =
               set (connChannels . at chan) (Just defaultChannel) conn
           | otherwise = conn

     -- add user to channel
         conn2 = set (connChannels . ix chan . chanUsers . at (userNick who))
                     (Just "") -- empty modes
                     conn1

         conn3 = recordAccount (learnUserInfo who (ensureRecord conn2))

     -- update user record
         ensureRecord = over (connUsers . at (userNick who)) (Just . fromMaybe defaultIrcUser)

         recordAccount = case acct of
                   None -> over (connUsers . ix (userNick who))
                                (set usrAccount Nothing)
                   Known a -> over (connUsers . ix (userNick who))
                                (set usrAccount (Just a))
                   Unknown -> id

     -- record join event
         m = defaultIrcMessage
               { _mesgType = JoinMsgType
               , _mesgSender = who
               , _mesgStamp = stamp
               }
     recordMessage m chan conn3

learnUserInfo :: UserInfo -> IrcConnection -> IrcConnection
learnUserInfo ui conn =
  case userHost ui of
    Nothing -> conn
    Just host ->
      let update Nothing = Just defaultIrcUser { _usrHost = Just host }
          update (Just u) = Just $! set usrHost (Just host) u
      in over (connUsers . at (userNick ui)) update conn


doNotifyChannel ::
  UserInfo ->
  Identifier ->
  ByteString ->
  IrcConnection ->
  Logic IrcConnection

doNotifyChannel who chan msg conn =
  do stamp <- getStamp
     let (statusmsg, chan') = splitStatusMsg chan conn
     let ty = case parseCtcpCommand msg of
                Nothing                 -> NoticeMsgType (asUtf8 msg)
                Just (command , args  ) -> CtcpRspMsgType command args
         modes = view (connChannels . ix chan' . chanUsers . ix (userNick who)) conn
         mesg = defaultIrcMessage
               { _mesgType = ty
               , _mesgSender = who
               , _mesgStamp = stamp
               , _mesgStatus = statusmsg
               , _mesgModes  = modes
               }
     recordMessage mesg chan' conn

doServerMessage ::
  ByteString {- ^ who -} ->
  ByteString {- ^ message -} ->
  IrcConnection -> Logic IrcConnection
doServerMessage who txt conn =
  do stamp <- getStamp
     let m = defaultIrcMessage
               { _mesgType    = PrivMsgType (asUtf8 txt)
               , _mesgSender  = UserInfo (mkId who) Nothing Nothing
               , _mesgStamp   = stamp
               }
     recordFor "" m
     return conn

doNameReply :: Identifier -> [ByteString] -> IrcConnection -> Logic IrcConnection
doNameReply chan xs conn =
  do msg <- getMessage
     case msg of
       RplNameReply _ _ x -> doNameReply chan (x++xs) conn
       RplEndOfNames _ -> return
                     $ learnAllHosts
                     $ set (connChannels . ix chan . chanUsers)
                           users
                           conn
       _ -> fail "Expected end of names"
       where
       modeMap = view (connChanModeTypes . modesPrefixModes) conn

       splitNames :: [(UserInfo, String)]
       splitNames = map (splitNamesReplyName modeMap) xs

       users :: Map Identifier String
       users = Map.fromList (map (over _1 userNick) splitNames)

       learnAllHosts x = foldl' (flip learnUserInfo) x (map fst splitNames)

-- | Compute the nickname and channel modes from an entry in
-- a NAMES reply. The leading channel prefixes are translated
-- into the appropriate modes.
splitNamesReplyName ::
  [(Char,Char)]        {- ^ [(mode,prefix)]   -} ->
  ByteString           {- ^ names entry       -} ->
  (UserInfo, String) {- ^ (nickname, modes) -}
splitNamesReplyName modeMap = aux []
  where
  aux modes n =
    case B8.uncons n of
      Just (x,xs)
        | Just (mode,_) <- find (\(_mode,symbol) -> x == symbol) modeMap
        -> aux (mode:modes) xs

      _ -> (parseUserInfo n,modes)

------------------------------------------------------------------------
-- Type describing computations that will require zero or more messages
-- to perform complex updates to the model.
------------------------------------------------------------------------

-- | Execute the 'Logic' value using a given operation for sending and
-- recieving IRC messages.
runLogic :: (Functor m,Monad m) =>
  UTCTime ->
  (forall r. LogicOp r -> m r) ->
  Logic a ->
  m (Either String a)
runLogic now ops (Logic f)
  = retract
  $ hoistFree ops
  $ runErrorT
  $ runReaderT f now

data LogicOp r
  = Expect  (MsgFromServer -> r)
  | Emit ByteString r
  | Record Identifier IrcMessage r
  deriving (Functor)

newtype Logic a = Logic (ReaderT UTCTime (ErrorT String (Free LogicOp)) a)
  deriving (Functor, Applicative, Monad)

getStamp :: Logic UTCTime
getStamp = Logic ask

recordFor :: Identifier -> IrcMessage -> Logic ()
recordFor target msg = Logic (wrap (Record target msg (return ())))

getMessage :: Logic MsgFromServer
getMessage = Logic (wrap (Expect return))

sendMessage :: ByteString -> Logic ()
sendMessage x = Logic (wrap (Emit x (return ())))


-- | Add a message to the client state for users and channels.
-- The user or channel record should be added if it does not already
-- exist.
recordMessage ::
  IrcMessage ->
  Identifier {- ^ target -} ->
  IrcConnection ->
  Logic IrcConnection
recordMessage mesg target conn =
  do let mesg1 = set mesgMe isMe mesg
     recordFor target mesg1
     return conn

  where
  isMe = isMyNick (views mesgSender userNick mesg) conn

-- | Predicate to determine if a given identifier is the primary nick
-- for the given connection.
isMyNick :: Identifier -> IrcConnection -> Bool
isMyNick nick conn = nick == view connNick conn

-- | Predicate for identifiers to identify which represent channel names.
-- Channel prefixes are configurable, but the most common is @#@
isChannelName :: Identifier -> IrcConnection -> Bool
isChannelName c conn =
  case B8.uncons (idBytes c) of
    Just (x,xs) -> not (B.null xs)
                && x `elem` view connChanTypes conn
    _ -> False -- probably shouldn't happen

-- | Predicate for identifiers to identify which represent nicknames
isNickName :: Identifier -> IrcConnection -> Bool
isNickName c conn =
  case B8.uncons (idBytes c) of
    Just (x,_) -> not (x `elem` view connChanTypes conn)
    _ -> False -- probably shouldn't happen

splitStatusMsg :: Identifier -> IrcConnection -> (String,Identifier)
splitStatusMsg target conn = aux [] (idBytes target)
  where
  aux acc bs =
    case B8.uncons bs of
      Just (x,xs) | x `elem` view connStatusMsg conn -> aux (x:acc) xs
      _ -> (reverse acc, mkId bs)

nickHasModeInChannel ::
  Identifier {- ^ nick    -} ->
  Char       {- ^ mode    -} ->
  Identifier {- ^ channel -} ->
  IrcConnection -> Bool
nickHasModeInChannel nick mode chan =
  elemOf ( connChannels . ix chan
         . chanUsers    . ix nick
         . folded)
         mode

channelHasMode ::
  Identifier {- ^ channel -} ->
  Char       {- ^ mode    -} ->
  IrcConnection -> Bool
channelHasMode chan mode =
  has ( connChannels . ix chan
      . chanModes . folded . ix mode
      )