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

       Pong _ txt ->
         case view connPingTime conn of
           PingSent sentTime ->
             do now <- getStamp
                let delta = realToFrac (now `diffUTCTime` sentTime)
                return (set connPingTime (PingTime delta) conn)
           _ -> return 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 (statusmsg, target') = splitStatusMsg target conn
            let mesg = defaultIrcMessage
                  { _mesgType    = ErrMsgType err
                  , _mesgSender  = UserInfo "" Nothing Nothing
                  , _mesgStamp   = now
                  , _mesgStatus  = statusmsg
                  }
            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
advanceModel :: MsgFromServer -> IrcConnection -> Logic IrcConnection
advanceModel msg0 conn =
  case msg0 of
       Ping x -> sendMessage (pongCmd x) >> return conn

       Pong _ txt ->
         case view connPingTime conn of
           PingSent sentTime ->
             do now <- getStamp
                let delta = realToFrac (now `diffUTCTime` sentTime)
                return (set connPingTime (PingTime delta) conn)
           _ -> return 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 (statusmsg, target') = splitStatusMsg target conn
            let mesg = defaultIrcMessage
                  { _mesgType    = ErrMsgType err
                  , _mesgSender  = UserInfo "" Nothing Nothing
                  , _mesgStamp   = now
                  , _mesgStatus  = statusmsg
                  }
            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
advanceModel msg0 conn =
  case msg0 of
       Ping x -> sendMessage (pongCmd x) >> return conn

       Pong _ txt ->
         case view connPingTime conn of
           PingSent sentTime ->
             do now <- getStamp
                let delta = realToFrac (now `diffUTCTime` sentTime)
                return (set connPingTime (PingTime delta) conn)
           _ -> return 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 (statusmsg, target') = splitStatusMsg target conn
            let mesg = defaultIrcMessage
                  { _mesgType    = ErrMsgType err
                  , _mesgSender  = UserInfo "" Nothing Nothing
                  , _mesgStamp   = now
                  , _mesgStatus  = statusmsg
                  }
            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