{-# Language BlockArguments, TemplateHaskell, OverloadedStrings, BangPatterns #-}

{-|
Module      : Client.State.Network
Description : IRC network session state
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module is responsible for tracking the state of an individual IRC
connection while the client is connected to it. This state includes
user information, server settings, channel membership, and more.

This module is more complicated than many of the other modules in the
client because it is responsible for interpreting each IRC message from
the server and updating the connection state accordingly.
-}

module Client.State.Network
  (
  -- * Connection state
    NetworkState(..)
  , AuthenticateState(..)
  , ConnectRestriction(..)
  , newNetworkState

  -- * Lenses
  , csNick
  , csChannels
  , csSocket
  , csModeTypes
  , csChannelTypes
  , csTransaction
  , csModes
  , csSnomask
  , csStatusMsg
  , csSettings
  , csUserInfo
  , csUsers
  , csUser
  , csModeCount
  , csNetwork
  , csNextPingTime
  , csPingStatus
  , csLatency
  , csLastReceived
  , csCertificate
  , csMessageHooks
  , csAuthenticationState
  , csSeed
  , csAway

  -- * Cross-message state
  , Transaction(..)

  -- * Connection predicates
  , isChannelIdentifier
  , iHaveOp

  -- * Messages interactions
  , sendMsg
  , initialMessages
  , squelchIrcMsg

  -- * NetworkState update
  , Apply(..)
  , applyMessage
  , hideMessage

  -- * Timer information
  , PingStatus(..)
  , _PingConnecting
  , TimedAction(..)
  , nextTimedAction
  , applyTimedAction

  -- * Moderation
  , useChanServ
  , sendModeration
  , sendTopic
  ) where

import qualified Client.Authentication.Ecdsa as Ecdsa
import qualified Client.Authentication.Ecdh as Ecdh
import qualified Client.Authentication.Scram as Scram
import           Client.Configuration.ServerSettings
import           Client.Network.Async
import           Client.State.Channel
import           Client.UserHost
import           Client.Hook (MessageHook)
import           Client.Hooks (messageHooks)
import           Control.Lens
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashSet as HashSet
import qualified Data.ByteString as B
import qualified Data.Map.Strict as Map
import           Data.Bits
import           Data.Foldable
import           Data.List
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Maybe
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Read as Text
import           Data.Time
import           Data.Time.Clock.POSIX
import           Irc.Codes
import           Irc.Commands
import           Irc.Identifier
import           Irc.Message
import           Irc.Modes
import           Irc.RawIrcMsg
import           Irc.UserInfo
import           LensUtils
import qualified System.Random as Random
import qualified Data.ByteString.Base64 as B64

-- | State tracked for each IRC connection
data NetworkState = NetworkState
  { NetworkState -> HashMap Identifier ChannelState
_csChannels     :: !(HashMap Identifier ChannelState) -- ^ joined channels
  , NetworkState -> NetworkConnection
_csSocket       :: !NetworkConnection -- ^ network socket
  , NetworkState -> ModeTypes
_csModeTypes    :: !ModeTypes -- ^ channel mode meanings
  , NetworkState -> ModeTypes
_csUmodeTypes   :: !ModeTypes -- ^ user mode meanings
  , NetworkState -> [Char]
_csChannelTypes :: ![Char] -- ^ channel identifier prefixes
  , NetworkState -> Transaction
_csTransaction  :: !Transaction -- ^ state for multi-message sequences
  , NetworkState -> [Char]
_csModes        :: ![Char] -- ^ modes for the connected user
  , NetworkState -> [Char]
_csSnomask      :: ![Char] -- ^ server notice modes for the connected user
  , NetworkState -> [Char]
_csStatusMsg    :: ![Char] -- ^ modes that prefix statusmsg channel names
  , NetworkState -> ServerSettings
_csSettings     :: !ServerSettings -- ^ settings used for this connection
  , NetworkState -> UserInfo
_csUserInfo     :: !UserInfo -- ^ usermask used by the server for this connection
  , NetworkState -> HashMap Identifier UserAndHost
_csUsers        :: !(HashMap Identifier UserAndHost) -- ^ user and hostname for other nicks
  , NetworkState -> Int
_csModeCount    :: !Int -- ^ maximum mode changes per MODE command
  , NetworkState -> Text
_csNetwork      :: !Text -- ^ name of network connection
  , NetworkState -> [MessageHook]
_csMessageHooks :: ![MessageHook] -- ^ names of message hooks to apply to this connection
  , NetworkState -> AuthenticateState
_csAuthenticationState :: !AuthenticateState
  , NetworkState -> Bool
_csAway         :: !Bool -- ^ Tracks when you are marked away

  -- Timing information
  , NetworkState -> Maybe UTCTime
_csNextPingTime :: !(Maybe UTCTime) -- ^ time for next ping event
  , NetworkState -> Maybe NominalDiffTime
_csLatency      :: !(Maybe NominalDiffTime) -- ^ latency calculated from previous pong
  , NetworkState -> PingStatus
_csPingStatus   :: !PingStatus      -- ^ state of ping timer
  , NetworkState -> Maybe UTCTime
_csLastReceived :: !(Maybe UTCTime) -- ^ time of last message received
  , NetworkState -> [Text]
_csCertificate  :: ![Text]

  -- Randomization
  , NetworkState -> StdGen
_csSeed         :: Random.StdGen
  }

-- | State of the authentication transaction
data AuthenticateState
  = AS_None               -- ^ no active transaction
  | AS_PlainStarted       -- ^ PLAIN mode initiated
  | AS_EcdsaStarted       -- ^ ECDSA-NIST mode initiated
  | AS_EcdsaWaitChallenge -- ^ ECDSA-NIST user sent waiting for challenge
  | AS_ExternalStarted    -- ^ EXTERNAL mode initiated
  | AS_ScramStarted
  | AS_Scram1 Scram.Phase1
  | AS_Scram2 Scram.Phase2
  | AS_EcdhStarted
  | AS_EcdhWaitChallenge Ecdh.Phase1

-- | Status of the ping timer
data PingStatus
  = PingSent !UTCTime -- ^ ping sent at given time, waiting for pong
  | PingNone          -- ^ not waiting for a pong
  | PingConnecting !Int !(Maybe UTCTime) !ConnectRestriction -- ^ number of attempts, last known connection time
  deriving Int -> PingStatus -> ShowS
[PingStatus] -> ShowS
PingStatus -> [Char]
(Int -> PingStatus -> ShowS)
-> (PingStatus -> [Char])
-> ([PingStatus] -> ShowS)
-> Show PingStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PingStatus] -> ShowS
$cshowList :: [PingStatus] -> ShowS
show :: PingStatus -> [Char]
$cshow :: PingStatus -> [Char]
showsPrec :: Int -> PingStatus -> ShowS
$cshowsPrec :: Int -> PingStatus -> ShowS
Show

data ConnectRestriction
  = NoRestriction       -- ^ no message restriction
  | StartTLSRestriction -- ^ STARTTLS hasn't finished
  | WaitTLSRestriction  -- ^ No messages allowed until TLS starts
  deriving Int -> ConnectRestriction -> ShowS
[ConnectRestriction] -> ShowS
ConnectRestriction -> [Char]
(Int -> ConnectRestriction -> ShowS)
-> (ConnectRestriction -> [Char])
-> ([ConnectRestriction] -> ShowS)
-> Show ConnectRestriction
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConnectRestriction] -> ShowS
$cshowList :: [ConnectRestriction] -> ShowS
show :: ConnectRestriction -> [Char]
$cshow :: ConnectRestriction -> [Char]
showsPrec :: Int -> ConnectRestriction -> ShowS
$cshowsPrec :: Int -> ConnectRestriction -> ShowS
Show

-- | Timer-based events
data TimedAction
  = TimedDisconnect    -- ^ terminate the connection due to timeout
  | TimedSendPing      -- ^ transmit a ping to the server
  | TimedForgetLatency -- ^ erase latency (when it is outdated)
  deriving (TimedAction -> TimedAction -> Bool
(TimedAction -> TimedAction -> Bool)
-> (TimedAction -> TimedAction -> Bool) -> Eq TimedAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimedAction -> TimedAction -> Bool
$c/= :: TimedAction -> TimedAction -> Bool
== :: TimedAction -> TimedAction -> Bool
$c== :: TimedAction -> TimedAction -> Bool
Eq, Eq TimedAction
Eq TimedAction
-> (TimedAction -> TimedAction -> Ordering)
-> (TimedAction -> TimedAction -> Bool)
-> (TimedAction -> TimedAction -> Bool)
-> (TimedAction -> TimedAction -> Bool)
-> (TimedAction -> TimedAction -> Bool)
-> (TimedAction -> TimedAction -> TimedAction)
-> (TimedAction -> TimedAction -> TimedAction)
-> Ord TimedAction
TimedAction -> TimedAction -> Bool
TimedAction -> TimedAction -> Ordering
TimedAction -> TimedAction -> TimedAction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimedAction -> TimedAction -> TimedAction
$cmin :: TimedAction -> TimedAction -> TimedAction
max :: TimedAction -> TimedAction -> TimedAction
$cmax :: TimedAction -> TimedAction -> TimedAction
>= :: TimedAction -> TimedAction -> Bool
$c>= :: TimedAction -> TimedAction -> Bool
> :: TimedAction -> TimedAction -> Bool
$c> :: TimedAction -> TimedAction -> Bool
<= :: TimedAction -> TimedAction -> Bool
$c<= :: TimedAction -> TimedAction -> Bool
< :: TimedAction -> TimedAction -> Bool
$c< :: TimedAction -> TimedAction -> Bool
compare :: TimedAction -> TimedAction -> Ordering
$ccompare :: TimedAction -> TimedAction -> Ordering
$cp1Ord :: Eq TimedAction
Ord, Int -> TimedAction -> ShowS
[TimedAction] -> ShowS
TimedAction -> [Char]
(Int -> TimedAction -> ShowS)
-> (TimedAction -> [Char])
-> ([TimedAction] -> ShowS)
-> Show TimedAction
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TimedAction] -> ShowS
$cshowList :: [TimedAction] -> ShowS
show :: TimedAction -> [Char]
$cshow :: TimedAction -> [Char]
showsPrec :: Int -> TimedAction -> ShowS
$cshowsPrec :: Int -> TimedAction -> ShowS
Show)

data Transaction
  = NoTransaction
  | NamesTransaction [Text]
  | BanTransaction [(Text,MaskListEntry)]
  | WhoTransaction [UserInfo]
  | CapLsTransaction [(Text, Maybe Text)]
  deriving Int -> Transaction -> ShowS
[Transaction] -> ShowS
Transaction -> [Char]
(Int -> Transaction -> ShowS)
-> (Transaction -> [Char])
-> ([Transaction] -> ShowS)
-> Show Transaction
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Transaction] -> ShowS
$cshowList :: [Transaction] -> ShowS
show :: Transaction -> [Char]
$cshow :: Transaction -> [Char]
showsPrec :: Int -> Transaction -> ShowS
$cshowsPrec :: Int -> Transaction -> ShowS
Show

makeLenses ''NetworkState
makePrisms ''Transaction
makePrisms ''PingStatus
makePrisms ''TimedAction

defaultChannelTypes :: String
defaultChannelTypes :: [Char]
defaultChannelTypes = [Char]
"#&"

csNick :: Lens' NetworkState Identifier
csNick :: (Identifier -> f Identifier) -> NetworkState -> f NetworkState
csNick = (UserInfo -> f UserInfo) -> NetworkState -> f NetworkState
Lens' NetworkState UserInfo
csUserInfo ((UserInfo -> f UserInfo) -> NetworkState -> f NetworkState)
-> ((Identifier -> f Identifier) -> UserInfo -> f UserInfo)
-> (Identifier -> f Identifier)
-> NetworkState
-> f NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier -> f Identifier) -> UserInfo -> f UserInfo
forall (f :: * -> *).
Functor f =>
(Identifier -> f Identifier) -> UserInfo -> f UserInfo
uiNick

-- | Transmit a 'RawIrcMsg' on the connection associated
-- with the given network. For @PRIVMSG@ and @NOTICE@ overlong
-- commands are detected and transmitted as multiple messages.
sendMsg :: NetworkState -> RawIrcMsg -> IO ()
sendMsg :: NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs RawIrcMsg
msg =
  case (Getting Text RawIrcMsg Text -> RawIrcMsg -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text RawIrcMsg Text
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> RawIrcMsg -> f RawIrcMsg
msgCommand RawIrcMsg
msg, Getting [Text] RawIrcMsg [Text] -> RawIrcMsg -> [Text]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Text] RawIrcMsg [Text]
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg
msgParams RawIrcMsg
msg) of
    (Text
"PRIVMSG", [Text
tgt,Text
txt]) -> Text -> Text -> Text -> IO ()
multiline Text
"PRIVMSG" Text
tgt Text
txt
    (Text
"NOTICE",  [Text
tgt,Text
txt]) -> Text -> Text -> Text -> IO ()
multiline Text
"NOTICE"  Text
tgt Text
txt
    (Text, [Text])
_ -> RawIrcMsg -> IO ()
transmit RawIrcMsg
msg
  where
    transmit :: RawIrcMsg -> IO ()
transmit = NetworkConnection -> ByteString -> IO ()
send (Getting NetworkConnection NetworkState NetworkConnection
-> NetworkState -> NetworkConnection
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NetworkConnection NetworkState NetworkConnection
Lens' NetworkState NetworkConnection
csSocket NetworkState
cs) (ByteString -> IO ())
-> (RawIrcMsg -> ByteString) -> RawIrcMsg -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawIrcMsg -> ByteString
renderRawIrcMsg

    actionPrefix :: Text
actionPrefix = Text
"\^AACTION "
    actionSuffix :: Text
actionSuffix = Text
"\^A"

    -- Special case for splitting a single CTCP ACTION into
    -- multiple actions
    multiline :: Text -> Text -> Text -> IO ()
multiline Text
cmd Text
tgt Text
txt
      | Just Text
txt1 <- Text -> Text -> Maybe Text
Text.stripPrefix Text
actionPrefix Text
txt
      , Just Text
txt2 <- Text -> Text -> Maybe Text
Text.stripSuffix Text
actionSuffix Text
txt1 =
      let txtChunks :: [Text]
txtChunks     = Int -> Text -> [Text]
utf8ChunksOf Int
maxContentLen Text
txt2
          maxContentLen :: Int
maxContentLen = UserInfo -> Text -> Int
computeMaxMessageLength (Getting UserInfo NetworkState UserInfo -> NetworkState -> UserInfo
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserInfo NetworkState UserInfo
Lens' NetworkState UserInfo
csUserInfo NetworkState
cs) Text
tgt
                        Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
actionPrefix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
actionSuffix
      in [Text] -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Text]
txtChunks ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
txtChunk ->
           RawIrcMsg -> IO ()
transmit (RawIrcMsg -> IO ()) -> RawIrcMsg -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
cmd [Text
tgt, Text
actionPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txtChunk Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
actionSuffix]

    -- Normal case
    multiline Text
cmd Text
tgt Text
txt =
      let txtChunks :: [Text]
txtChunks     = Int -> Text -> [Text]
utf8ChunksOf Int
maxContentLen Text
txt
          maxContentLen :: Int
maxContentLen = UserInfo -> Text -> Int
computeMaxMessageLength (Getting UserInfo NetworkState UserInfo -> NetworkState -> UserInfo
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserInfo NetworkState UserInfo
Lens' NetworkState UserInfo
csUserInfo NetworkState
cs) Text
tgt
      in [Text] -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Text]
txtChunks ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
txtChunk ->
           RawIrcMsg -> IO ()
transmit (RawIrcMsg -> IO ()) -> RawIrcMsg -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> RawIrcMsg
rawIrcMsg Text
cmd [Text
tgt, Text
txtChunk]

-- This is an approximation for splitting the text. It doesn't
-- understand combining characters. A correct implementation
-- probably needs to use icu, but its going to take some work
-- to use that library to do this.
utf8ChunksOf :: Int -> Text -> [Text]
utf8ChunksOf :: Int -> Text -> [Text]
utf8ChunksOf Int
n Text
txt
  | ByteString -> Int
B.length ByteString
enc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n = [Text
txt] -- fast/common case
  | Bool
otherwise         = Int -> Int -> Text -> [(Int, Int, Int)] -> [Text]
search Int
0 Int
0 Text
txt [(Int, Int, Int)]
info
  where
    isBeginning :: a -> Bool
isBeginning a
b = a
b a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xc0 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0x80

    enc :: ByteString
enc = Text -> ByteString
Text.encodeUtf8 Text
txt

    beginnings :: [Int]
beginnings = (Word8 -> Bool) -> ByteString -> [Int]
B.findIndices Word8 -> Bool
forall a. (Bits a, Num a) => a -> Bool
isBeginning ByteString
enc

    info :: [(Int, Int, Int)]
info = [Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..] -- charIndex
                [Int]
beginnings
                (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 [Int]
beginnings [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [ByteString -> Int
B.length ByteString
enc])

    search :: Int -> Int -> Text -> [(Int, Int, Int)] -> [Text]
search Int
startByte Int
startChar Text
currentTxt [(Int, Int, Int)]
xs =
      case ((Int, Int, Int) -> Bool) -> [(Int, Int, Int)] -> [(Int, Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Int
_,Int
_,Int
byteLen) -> Int
byteLenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
startByte Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n) [(Int, Int, Int)]
xs of
        [] -> [Text
currentTxt]
        (Int
charIx,Int
byteIx,Int
_):[(Int, Int, Int)]
xs' ->
          case Int -> Text -> (Text, Text)
Text.splitAt (Int
charIx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startChar) Text
currentTxt of
            (Text
a,Text
b) -> Text
a Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Int -> Text -> [(Int, Int, Int)] -> [Text]
search Int
byteIx Int
charIx Text
b [(Int, Int, Int)]
xs'

-- | Construct a new network state using the given settings and
-- default values as specified by the IRC specification.
newNetworkState ::
  Text              {- ^ network name              -} ->
  ServerSettings    {- ^ server settings           -} ->
  NetworkConnection {- ^ active network connection -} ->
  PingStatus        {- ^ initial ping status       -} ->
  Random.StdGen     {- ^ initial random seed       -} ->
  NetworkState      {- ^ new network state         -}
newNetworkState :: Text
-> ServerSettings
-> NetworkConnection
-> PingStatus
-> StdGen
-> NetworkState
newNetworkState Text
network ServerSettings
settings NetworkConnection
sock PingStatus
ping StdGen
seed = NetworkState :: HashMap Identifier ChannelState
-> NetworkConnection
-> ModeTypes
-> ModeTypes
-> [Char]
-> Transaction
-> [Char]
-> [Char]
-> [Char]
-> ServerSettings
-> UserInfo
-> HashMap Identifier UserAndHost
-> Int
-> Text
-> [MessageHook]
-> AuthenticateState
-> Bool
-> Maybe UTCTime
-> Maybe NominalDiffTime
-> PingStatus
-> Maybe UTCTime
-> [Text]
-> StdGen
-> NetworkState
NetworkState
  { _csUserInfo :: UserInfo
_csUserInfo     = Identifier -> Text -> Text -> UserInfo
UserInfo Identifier
"*" Text
"" Text
""
  , _csChannels :: HashMap Identifier ChannelState
_csChannels     = HashMap Identifier ChannelState
forall k v. HashMap k v
HashMap.empty
  , _csSocket :: NetworkConnection
_csSocket       = NetworkConnection
sock
  , _csChannelTypes :: [Char]
_csChannelTypes = [Char]
defaultChannelTypes
  , _csModeTypes :: ModeTypes
_csModeTypes    = ModeTypes
defaultModeTypes
  , _csUmodeTypes :: ModeTypes
_csUmodeTypes   = ModeTypes
defaultUmodeTypes
  , _csTransaction :: Transaction
_csTransaction  = Transaction
NoTransaction
  , _csModes :: [Char]
_csModes        = [Char]
""
  , _csSnomask :: [Char]
_csSnomask      = [Char]
""
  , _csStatusMsg :: [Char]
_csStatusMsg    = [Char]
""
  , _csSettings :: ServerSettings
_csSettings     = ServerSettings
settings
  , _csModeCount :: Int
_csModeCount    = Int
3
  , _csUsers :: HashMap Identifier UserAndHost
_csUsers        = HashMap Identifier UserAndHost
forall k v. HashMap k v
HashMap.empty
  , _csNetwork :: Text
_csNetwork      = Text
network
  , _csMessageHooks :: [MessageHook]
_csMessageHooks = [HookConfig] -> [MessageHook]
buildMessageHooks (Getting [HookConfig] ServerSettings [HookConfig]
-> ServerSettings -> [HookConfig]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [HookConfig] ServerSettings [HookConfig]
Lens' ServerSettings [HookConfig]
ssMessageHooks ServerSettings
settings)
  , _csAuthenticationState :: AuthenticateState
_csAuthenticationState = AuthenticateState
AS_None
  , _csAway :: Bool
_csAway         = Bool
False
  , _csPingStatus :: PingStatus
_csPingStatus   = PingStatus
ping
  , _csLatency :: Maybe NominalDiffTime
_csLatency      = Maybe NominalDiffTime
forall a. Maybe a
Nothing
  , _csNextPingTime :: Maybe UTCTime
_csNextPingTime = Maybe UTCTime
forall a. Maybe a
Nothing
  , _csLastReceived :: Maybe UTCTime
_csLastReceived = Maybe UTCTime
forall a. Maybe a
Nothing
  , _csCertificate :: [Text]
_csCertificate  = []
  , _csSeed :: StdGen
_csSeed         = StdGen
seed
  }

buildMessageHooks :: [HookConfig] -> [MessageHook]
buildMessageHooks :: [HookConfig] -> [MessageHook]
buildMessageHooks = (HookConfig -> Maybe MessageHook) -> [HookConfig] -> [MessageHook]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe \(HookConfig Text
name [Text]
args) ->
  do [Text] -> Maybe MessageHook
hookFun <- Text
-> HashMap Text ([Text] -> Maybe MessageHook)
-> Maybe ([Text] -> Maybe MessageHook)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
name HashMap Text ([Text] -> Maybe MessageHook)
messageHooks
     [Text] -> Maybe MessageHook
hookFun [Text]
args

data Apply = Apply [RawIrcMsg] NetworkState

hideMessage :: IrcMsg -> Bool
hideMessage :: IrcMsg -> Bool
hideMessage IrcMsg
m =
  case IrcMsg
m of
    Authenticate{} -> Bool
True
    BatchStart{} -> Bool
True
    BatchEnd{} -> Bool
True
    Ping{} -> Bool
True
    Pong{} -> Bool
True
    Reply Text
_ ReplyCode
RPL_WHOSPCRPL [Text
_,Text
"616",Text
_,Text
_,Text
_,Text
_] -> Bool
True
    IrcMsg
_ -> Bool
False

-- | Used for updates to a 'NetworkState' that require no reply.
noReply :: NetworkState -> Apply
noReply :: NetworkState -> Apply
noReply = [RawIrcMsg] -> NetworkState -> Apply
reply []

reply :: [RawIrcMsg] -> NetworkState -> Apply
reply :: [RawIrcMsg] -> NetworkState -> Apply
reply = [RawIrcMsg] -> NetworkState -> Apply
Apply

overChannel :: Identifier -> (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannel :: Identifier
-> (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannel Identifier
chan = LensLike
  ((,) StrictUnit)
  NetworkState
  NetworkState
  ChannelState
  ChannelState
-> (ChannelState -> ChannelState) -> NetworkState -> NetworkState
forall s t a b.
LensLike ((,) StrictUnit) s t a b -> (a -> b) -> s -> t
overStrict ((HashMap Identifier ChannelState
 -> (StrictUnit, HashMap Identifier ChannelState))
-> NetworkState -> (StrictUnit, NetworkState)
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> (StrictUnit, HashMap Identifier ChannelState))
 -> NetworkState -> (StrictUnit, NetworkState))
-> ((ChannelState -> (StrictUnit, ChannelState))
    -> HashMap Identifier ChannelState
    -> (StrictUnit, HashMap Identifier ChannelState))
-> LensLike
     ((,) StrictUnit)
     NetworkState
     NetworkState
     ChannelState
     ChannelState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier ChannelState)
chan)

overChannels :: (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannels :: (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannels = LensLike
  ((,) StrictUnit)
  NetworkState
  NetworkState
  ChannelState
  ChannelState
-> (ChannelState -> ChannelState) -> NetworkState -> NetworkState
forall s t a b.
LensLike ((,) StrictUnit) s t a b -> (a -> b) -> s -> t
overStrict ((HashMap Identifier ChannelState
 -> (StrictUnit, HashMap Identifier ChannelState))
-> NetworkState -> (StrictUnit, NetworkState)
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> (StrictUnit, HashMap Identifier ChannelState))
 -> NetworkState -> (StrictUnit, NetworkState))
-> ((ChannelState -> (StrictUnit, ChannelState))
    -> HashMap Identifier ChannelState
    -> (StrictUnit, HashMap Identifier ChannelState))
-> LensLike
     ((,) StrictUnit)
     NetworkState
     NetworkState
     ChannelState
     ChannelState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChannelState -> (StrictUnit, ChannelState))
-> HashMap Identifier ChannelState
-> (StrictUnit, HashMap Identifier ChannelState)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)

applyMessage :: ZonedTime -> IrcMsg -> NetworkState -> Apply
applyMessage :: ZonedTime -> IrcMsg -> NetworkState -> Apply
applyMessage ZonedTime
msgWhen IrcMsg
msg NetworkState
cs
  = ZonedTime -> IrcMsg -> NetworkState -> Apply
applyMessage' ZonedTime
msgWhen IrcMsg
msg
  (NetworkState -> Apply) -> NetworkState -> Apply
forall a b. (a -> b) -> a -> b
$ ASetter NetworkState NetworkState (Maybe UTCTime) (Maybe UTCTime)
-> Maybe UTCTime -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState (Maybe UTCTime) (Maybe UTCTime)
Lens' NetworkState (Maybe UTCTime)
csLastReceived (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$! ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
msgWhen) NetworkState
cs

applyMessage' :: ZonedTime -> IrcMsg -> NetworkState -> Apply
applyMessage' :: ZonedTime -> IrcMsg -> NetworkState -> Apply
applyMessage' ZonedTime
msgWhen IrcMsg
msg NetworkState
cs =
  case IrcMsg
msg of
    Ping [Text]
args -> [RawIrcMsg] -> NetworkState -> Apply
reply [[Text] -> RawIrcMsg
ircPong [Text]
args] NetworkState
cs
    Pong [Text]
_    -> NetworkState -> Apply
noReply (ZonedTime -> NetworkState -> NetworkState
doPong ZonedTime
msgWhen NetworkState
cs)
    Join Source
user Identifier
chan Text
acct Text
_ ->
         [RawIrcMsg] -> NetworkState -> Apply
reply [RawIrcMsg]
response
         (NetworkState -> Apply) -> NetworkState -> Apply
forall a b. (a -> b) -> a -> b
$ UserInfo -> Text -> NetworkState -> NetworkState
recordUser (Source -> UserInfo
srcUser Source
user) Text
acct
         (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ Identifier
-> (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannel Identifier
chan (Identifier -> ChannelState -> ChannelState
joinChannel (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user)))
         (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ UserInfo -> Identifier -> NetworkState -> NetworkState
createOnJoin (Source -> UserInfo
srcUser Source
user) Identifier
chan NetworkState
cs
     where
       response :: [RawIrcMsg]
response =
         [Identifier -> [Text] -> RawIrcMsg
ircMode Identifier
chan [] | UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user) Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Getting Identifier NetworkState Identifier
-> NetworkState -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier NetworkState Identifier
Lens' NetworkState Identifier
csNick NetworkState
cs]

    Account Source
user Text
acct ->
           NetworkState -> Apply
noReply
         (NetworkState -> Apply) -> NetworkState -> Apply
forall a b. (a -> b) -> a -> b
$ UserInfo -> Text -> NetworkState -> NetworkState
recordUser (Source -> UserInfo
srcUser Source
user) Text
acct NetworkState
cs

    Chghost Source
user Text
newUser Text
newHost ->
           NetworkState -> Apply
noReply
         (NetworkState -> Apply) -> NetworkState -> Apply
forall a b. (a -> b) -> a -> b
$ Identifier -> Text -> Text -> NetworkState -> NetworkState
updateUserInfo (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user)) Text
newUser Text
newHost NetworkState
cs

    Quit Source
user Maybe Text
_reason ->
           NetworkState -> Apply
noReply
         (NetworkState -> Apply) -> NetworkState -> Apply
forall a b. (a -> b) -> a -> b
$ Identifier -> NetworkState -> NetworkState
forgetUser (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user))
         (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannels (Identifier -> ChannelState -> ChannelState
partChannel (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user))) NetworkState
cs

    Part Source
user Identifier
chan Maybe Text
_mbreason -> Identifier -> Identifier -> Apply
exitChannel Identifier
chan (UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
user))

    Kick Source
_kicker Identifier
chan Identifier
nick Text
_reason -> Identifier -> Identifier -> Apply
exitChannel Identifier
chan Identifier
nick

    Nick Source
oldNick Identifier
newNick ->
         let nick :: Identifier
nick = UserInfo -> Identifier
userNick (Source -> UserInfo
srcUser Source
oldNick) in
           NetworkState -> Apply
noReply
         (NetworkState -> Apply) -> NetworkState -> Apply
forall a b. (a -> b) -> a -> b
$ Identifier -> Identifier -> NetworkState -> NetworkState
renameUser Identifier
nick Identifier
newNick
         (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ Identifier -> Identifier -> NetworkState -> NetworkState
updateMyNick Identifier
nick Identifier
newNick
         (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannels (Identifier -> Identifier -> ChannelState -> ChannelState
nickChange Identifier
nick Identifier
newNick) NetworkState
cs

    Reply Text
_ ReplyCode
RPL_WELCOME (Text
me:[Text]
_) -> ZonedTime -> Identifier -> NetworkState -> Apply
doWelcome ZonedTime
msgWhen (Text -> Identifier
mkId Text
me) NetworkState
cs
    Reply Text
_ ReplyCode
RPL_SASLSUCCESS [Text]
_ -> [RawIrcMsg] -> NetworkState -> Apply
reply [RawIrcMsg
ircCapEnd] NetworkState
cs
    Reply Text
_ ReplyCode
ERR_SASLFAIL [Text]
_ -> [RawIrcMsg] -> NetworkState -> Apply
reply [RawIrcMsg
ircCapEnd] NetworkState
cs
    Reply Text
_ ReplyCode
ERR_SASLABORTED [Text]
_ -> [RawIrcMsg] -> NetworkState -> Apply
reply [RawIrcMsg
ircCapEnd] NetworkState
cs
    Reply Text
_ ReplyCode
RPL_SASLMECHS [Text]
_ -> [RawIrcMsg] -> NetworkState -> Apply
reply [RawIrcMsg
ircCapEnd] NetworkState
cs

    Reply Text
_ ReplyCode
ERR_NICKNAMEINUSE (Text
_:Text
badnick:[Text]
_)
      | PingConnecting{} <- Getting PingStatus NetworkState PingStatus
-> NetworkState -> PingStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PingStatus NetworkState PingStatus
Lens' NetworkState PingStatus
csPingStatus NetworkState
cs -> Text -> NetworkState -> Apply
doBadNick Text
badnick NetworkState
cs
    Reply Text
_ ReplyCode
ERR_BANNEDNICK (Text
_:Text
badnick:[Text]
_)
      | PingConnecting{} <- Getting PingStatus NetworkState PingStatus
-> NetworkState -> PingStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PingStatus NetworkState PingStatus
Lens' NetworkState PingStatus
csPingStatus NetworkState
cs -> Text -> NetworkState -> Apply
doBadNick Text
badnick NetworkState
cs
    Reply Text
_ ReplyCode
ERR_ERRONEUSNICKNAME (Text
_:Text
badnick:[Text]
_)
      | PingConnecting{} <- Getting PingStatus NetworkState PingStatus
-> NetworkState -> PingStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PingStatus NetworkState PingStatus
Lens' NetworkState PingStatus
csPingStatus NetworkState
cs -> Text -> NetworkState -> Apply
doBadNick Text
badnick NetworkState
cs
    Reply Text
_ ReplyCode
ERR_UNAVAILRESOURCE (Text
_:Text
badnick:[Text]
_)
      | PingConnecting{} <- Getting PingStatus NetworkState PingStatus
-> NetworkState -> PingStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PingStatus NetworkState PingStatus
Lens' NetworkState PingStatus
csPingStatus NetworkState
cs -> Text -> NetworkState -> Apply
doBadNick Text
badnick NetworkState
cs

    Reply Text
_ ReplyCode
RPL_HOSTHIDDEN (Text
_:Text
host:[Text]
_) ->
        NetworkState -> Apply
noReply (ASetter NetworkState NetworkState Text Text
-> Text -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ((UserInfo -> Identity UserInfo)
-> NetworkState -> Identity NetworkState
Lens' NetworkState UserInfo
csUserInfo ((UserInfo -> Identity UserInfo)
 -> NetworkState -> Identity NetworkState)
-> ((Text -> Identity Text) -> UserInfo -> Identity UserInfo)
-> ASetter NetworkState NetworkState Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Identity Text) -> UserInfo -> Identity UserInfo
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> UserInfo -> f UserInfo
uiHost) Text
host NetworkState
cs)

    -- /who <#channel> %tuhna,616
    Reply Text
_ ReplyCode
RPL_WHOSPCRPL [Text
_me,Text
"616",Text
user,Text
host,Text
nick,Text
acct] ->
       let acct' :: Text
acct' = if Text
acct Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"0" then Text
"*" else Text
acct
       in NetworkState -> Apply
noReply (UserInfo -> Text -> NetworkState -> NetworkState
recordUser (Identifier -> Text -> Text -> UserInfo
UserInfo (Text -> Identifier
mkId Text
nick) Text
user Text
host) Text
acct' NetworkState
cs)

    Reply Text
_ ReplyCode
code [Text]
args      -> ReplyCode -> ZonedTime -> [Text] -> NetworkState -> Apply
doRpl ReplyCode
code ZonedTime
msgWhen [Text]
args NetworkState
cs
    Cap CapCmd
cmd                -> CapCmd -> NetworkState -> Apply
doCap CapCmd
cmd NetworkState
cs
    Authenticate Text
param     -> Text -> NetworkState -> Apply
doAuthenticate Text
param NetworkState
cs
    Mode Source
who Identifier
target (Text
modes:[Text]
params) -> ZonedTime
-> UserInfo
-> Identifier
-> Text
-> [Text]
-> NetworkState
-> Apply
doMode ZonedTime
msgWhen (Source -> UserInfo
srcUser Source
who) Identifier
target Text
modes [Text]
params NetworkState
cs
    Topic Source
user Identifier
chan Text
topic  -> NetworkState -> Apply
noReply (ZonedTime
-> UserInfo -> Identifier -> Text -> NetworkState -> NetworkState
doTopic ZonedTime
msgWhen (Source -> UserInfo
srcUser Source
user) Identifier
chan Text
topic NetworkState
cs)
    IrcMsg
_                      -> NetworkState -> Apply
noReply NetworkState
cs
  where
    exitChannel :: Identifier -> Identifier -> Apply
exitChannel Identifier
chan Identifier
nick
      | Identifier
nick Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Getting Identifier NetworkState Identifier
-> NetworkState -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier NetworkState Identifier
Lens' NetworkState Identifier
csNick NetworkState
cs = NetworkState -> Apply
noReply (NetworkState -> Apply) -> NetworkState -> Apply
forall a b. (a -> b) -> a -> b
$ NetworkState -> NetworkState
pruneUsers
                               (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ ASetter
  NetworkState
  NetworkState
  (HashMap Identifier ChannelState)
  (HashMap Identifier ChannelState)
-> (HashMap Identifier ChannelState
    -> HashMap Identifier ChannelState)
-> NetworkState
-> NetworkState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  NetworkState
  NetworkState
  (HashMap Identifier ChannelState)
  (HashMap Identifier ChannelState)
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels (Index (HashMap Identifier ChannelState)
-> HashMap Identifier ChannelState
-> HashMap Identifier ChannelState
forall m. At m => Index m -> m -> m
sans Identifier
Index (HashMap Identifier ChannelState)
chan) NetworkState
cs

      | Bool
otherwise              = NetworkState -> Apply
noReply (NetworkState -> Apply) -> NetworkState -> Apply
forall a b. (a -> b) -> a -> b
$ Identifier -> NetworkState -> NetworkState
forgetUser' Identifier
nick
                               (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ Identifier
-> (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannel Identifier
chan (Identifier -> ChannelState -> ChannelState
partChannel Identifier
nick) NetworkState
cs

-- | Restrict 'csUsers' to only users are in a channel that the client
-- is connected to.
pruneUsers :: NetworkState -> NetworkState
pruneUsers :: NetworkState -> NetworkState
pruneUsers NetworkState
cs = ASetter
  NetworkState
  NetworkState
  (HashMap Identifier UserAndHost)
  (HashMap Identifier UserAndHost)
-> (HashMap Identifier UserAndHost
    -> HashMap Identifier UserAndHost)
-> NetworkState
-> NetworkState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  NetworkState
  NetworkState
  (HashMap Identifier UserAndHost)
  (HashMap Identifier UserAndHost)
Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers (HashMap Identifier UserAndHost
-> HashMap Identifier [Char] -> HashMap Identifier UserAndHost
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
`HashMap.intersection` HashMap Identifier [Char]
u) NetworkState
cs
  where
    u :: HashMap Identifier [Char]
u = Getting
  (HashMap Identifier [Char])
  NetworkState
  (HashMap Identifier [Char])
-> NetworkState -> HashMap Identifier [Char]
forall a s. Getting a s a -> s -> a
foldOf ((HashMap Identifier ChannelState
 -> Const
      (HashMap Identifier [Char]) (HashMap Identifier ChannelState))
-> NetworkState -> Const (HashMap Identifier [Char]) NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const
       (HashMap Identifier [Char]) (HashMap Identifier ChannelState))
 -> NetworkState -> Const (HashMap Identifier [Char]) NetworkState)
-> ((HashMap Identifier [Char]
     -> Const (HashMap Identifier [Char]) (HashMap Identifier [Char]))
    -> HashMap Identifier ChannelState
    -> Const
         (HashMap Identifier [Char]) (HashMap Identifier ChannelState))
-> Getting
     (HashMap Identifier [Char])
     NetworkState
     (HashMap Identifier [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChannelState -> Const (HashMap Identifier [Char]) ChannelState)
-> HashMap Identifier ChannelState
-> Const
     (HashMap Identifier [Char]) (HashMap Identifier ChannelState)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded ((ChannelState -> Const (HashMap Identifier [Char]) ChannelState)
 -> HashMap Identifier ChannelState
 -> Const
      (HashMap Identifier [Char]) (HashMap Identifier ChannelState))
-> ((HashMap Identifier [Char]
     -> Const (HashMap Identifier [Char]) (HashMap Identifier [Char]))
    -> ChannelState -> Const (HashMap Identifier [Char]) ChannelState)
-> (HashMap Identifier [Char]
    -> Const (HashMap Identifier [Char]) (HashMap Identifier [Char]))
-> HashMap Identifier ChannelState
-> Const
     (HashMap Identifier [Char]) (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier [Char]
 -> Const (HashMap Identifier [Char]) (HashMap Identifier [Char]))
-> ChannelState -> Const (HashMap Identifier [Char]) ChannelState
Lens' ChannelState (HashMap Identifier [Char])
chanUsers) NetworkState
cs

-- | 001 'RPL_WELCOME' is the first message received when transitioning
-- from the initial handshake to a connected state. At this point we know
-- what nickname the server is using for our connection, and we can start
-- scheduling PINGs.
doWelcome ::
  ZonedTime  {- ^ message received -} ->
  Identifier {- ^ my nickname      -} ->
  NetworkState ->
  Apply
doWelcome :: ZonedTime -> Identifier -> NetworkState -> Apply
doWelcome ZonedTime
msgWhen Identifier
me
  = NetworkState -> Apply
noReply
  (NetworkState -> Apply)
-> (NetworkState -> NetworkState) -> NetworkState -> Apply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter NetworkState NetworkState Identifier Identifier
-> Identifier -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState Identifier Identifier
Lens' NetworkState Identifier
csNick Identifier
me
  (NetworkState -> NetworkState)
-> (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter NetworkState NetworkState (Maybe UTCTime) (Maybe UTCTime)
-> Maybe UTCTime -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState (Maybe UTCTime) (Maybe UTCTime)
Lens' NetworkState (Maybe UTCTime)
csNextPingTime (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$! NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
30 (ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
msgWhen))
  (NetworkState -> NetworkState)
-> (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter NetworkState NetworkState PingStatus PingStatus
-> PingStatus -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState PingStatus PingStatus
Lens' NetworkState PingStatus
csPingStatus PingStatus
PingNone

-- | Handle 'ERR_NICKNAMEINUSE' errors when connecting.
doBadNick ::
  Text {- ^ bad nickname -} ->
  NetworkState ->
  Apply
doBadNick :: Text -> NetworkState -> Apply
doBadNick Text
badNick NetworkState
cs =
  case (Text -> Bool) -> NonEmpty Text -> [Text]
forall a. (a -> Bool) -> NonEmpty a -> [a]
NonEmpty.dropWhile (Text
badNickText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Getting (NonEmpty Text) NetworkState (NonEmpty Text)
-> NetworkState -> NonEmpty Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ServerSettings -> Const (NonEmpty Text) ServerSettings)
-> NetworkState -> Const (NonEmpty Text) NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const (NonEmpty Text) ServerSettings)
 -> NetworkState -> Const (NonEmpty Text) NetworkState)
-> ((NonEmpty Text -> Const (NonEmpty Text) (NonEmpty Text))
    -> ServerSettings -> Const (NonEmpty Text) ServerSettings)
-> Getting (NonEmpty Text) NetworkState (NonEmpty Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty Text -> Const (NonEmpty Text) (NonEmpty Text))
-> ServerSettings -> Const (NonEmpty Text) ServerSettings
Lens' ServerSettings (NonEmpty Text)
ssNicks) NetworkState
cs) of
    Text
_:Text
next:[Text]
_ -> [RawIrcMsg] -> NetworkState -> Apply
reply [Text -> RawIrcMsg
ircNick Text
next] NetworkState
cs
    [Text]
_        -> NetworkState -> Apply
doRandomNick NetworkState
cs

-- | Pick a random nickname now that we've run out of choices
doRandomNick :: NetworkState -> Apply
doRandomNick :: NetworkState -> Apply
doRandomNick NetworkState
cs = [RawIrcMsg] -> NetworkState -> Apply
reply [Text -> RawIrcMsg
ircNick Text
candidate] NetworkState
cs'
  where
    limit :: Int
limit       = Int
9 -- RFC 2812 puts the maximum nickname length as low as 9!
    range :: (Int, Int)
range       = (Int
0, Int
99999::Int) -- up to 5 random digits
    suffix :: [Char]
suffix      = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
    primaryNick :: Text
primaryNick = NonEmpty Text -> Text
forall a. NonEmpty a -> a
NonEmpty.head (Getting (NonEmpty Text) NetworkState (NonEmpty Text)
-> NetworkState -> NonEmpty Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ServerSettings -> Const (NonEmpty Text) ServerSettings)
-> NetworkState -> Const (NonEmpty Text) NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const (NonEmpty Text) ServerSettings)
 -> NetworkState -> Const (NonEmpty Text) NetworkState)
-> ((NonEmpty Text -> Const (NonEmpty Text) (NonEmpty Text))
    -> ServerSettings -> Const (NonEmpty Text) ServerSettings)
-> Getting (NonEmpty Text) NetworkState (NonEmpty Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty Text -> Const (NonEmpty Text) (NonEmpty Text))
-> ServerSettings -> Const (NonEmpty Text) ServerSettings
Lens' ServerSettings (NonEmpty Text)
ssNicks) NetworkState
cs)
    candidate :: Text
candidate   = Int -> Text -> Text
Text.take (Int
limitInt -> Int -> Int
forall a. Num a => a -> a -> a
-[Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
suffix) Text
primaryNick Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
suffix

    (Int
n, NetworkState
cs')    = NetworkState
cs NetworkState
-> (NetworkState -> (Int, NetworkState)) -> (Int, NetworkState)
forall a b. a -> (a -> b) -> b
& (StdGen -> (Int, StdGen)) -> NetworkState -> (Int, NetworkState)
Lens' NetworkState StdGen
csSeed ((StdGen -> (Int, StdGen)) -> NetworkState -> (Int, NetworkState))
-> (StdGen -> (Int, StdGen)) -> NetworkState -> (Int, NetworkState)
forall k (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ (Int, Int) -> StdGen -> (Int, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
Random.randomR (Int, Int)
range

doTopic :: ZonedTime -> UserInfo -> Identifier -> Text -> NetworkState -> NetworkState
doTopic :: ZonedTime
-> UserInfo -> Identifier -> Text -> NetworkState -> NetworkState
doTopic ZonedTime
when UserInfo
user Identifier
chan Text
topic =
  Identifier
-> (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannel Identifier
chan (Text -> ChannelState -> ChannelState
setTopic Text
topic (ChannelState -> ChannelState)
-> (ChannelState -> ChannelState) -> ChannelState -> ChannelState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  ChannelState
  ChannelState
  (Maybe TopicProvenance)
  (Maybe TopicProvenance)
-> Maybe TopicProvenance -> ChannelState -> ChannelState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  ChannelState
  ChannelState
  (Maybe TopicProvenance)
  (Maybe TopicProvenance)
Lens' ChannelState (Maybe TopicProvenance)
chanTopicProvenance (TopicProvenance -> Maybe TopicProvenance
forall a. a -> Maybe a
Just (TopicProvenance -> Maybe TopicProvenance)
-> TopicProvenance -> Maybe TopicProvenance
forall a b. (a -> b) -> a -> b
$! TopicProvenance
prov))
  where
    prov :: TopicProvenance
prov = TopicProvenance :: UserInfo -> UTCTime -> TopicProvenance
TopicProvenance
             { _topicAuthor :: UserInfo
_topicAuthor = UserInfo
user
             , _topicTime :: UTCTime
_topicTime   = ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
when
             }

parseTimeParam :: Text -> Maybe UTCTime
parseTimeParam :: Text -> Maybe UTCTime
parseTimeParam Text
txt =
  case Reader Integer
forall a. Integral a => Reader a
Text.decimal Text
txt of
    Right (Integer
i, Text
rest) | Text -> Bool
Text.null Text
rest ->
      UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$! NominalDiffTime -> UTCTime
posixSecondsToUTCTime (Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger Integer
i)
    Either [Char] (Integer, Text)
_ -> Maybe UTCTime
forall a. Maybe a
Nothing

doRpl :: ReplyCode -> ZonedTime -> [Text] -> NetworkState -> Apply
doRpl :: ReplyCode -> ZonedTime -> [Text] -> NetworkState -> Apply
doRpl ReplyCode
cmd ZonedTime
msgWhen [Text]
args NetworkState
cs =
  case ReplyCode
cmd of
    ReplyCode
RPL_UMODEIS ->
      case [Text]
args of
        Text
_me:Text
modes:[Text]
params
          | Just [(Bool, Char, Text)]
xs <- ModeTypes -> Text -> [Text] -> Maybe [(Bool, Char, Text)]
splitModes (Getting ModeTypes NetworkState ModeTypes
-> NetworkState -> ModeTypes
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ModeTypes NetworkState ModeTypes
Lens' NetworkState ModeTypes
csUmodeTypes NetworkState
cs) Text
modes [Text]
params ->
                 NetworkState -> Apply
noReply
               (NetworkState -> Apply) -> NetworkState -> Apply
forall a b. (a -> b) -> a -> b
$ [(Bool, Char, Text)] -> NetworkState -> NetworkState
doMyModes [(Bool, Char, Text)]
xs
               (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ ASetter NetworkState NetworkState [Char] [Char]
-> [Char] -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState [Char] [Char]
Lens' NetworkState [Char]
csModes [Char]
"" NetworkState
cs -- reset modes
        [Text]
_ -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_SNOMASK ->
      case [Text]
args of
        Text
_me:Text
snomask0:[Text]
_
          | Just Text
snomask <- Text -> Text -> Maybe Text
Text.stripPrefix Text
"+" Text
snomask0 ->
           NetworkState -> Apply
noReply (ASetter NetworkState NetworkState [Char] [Char]
-> [Char] -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState [Char] [Char]
Lens' NetworkState [Char]
csSnomask (Text -> [Char]
Text.unpack Text
snomask) NetworkState
cs)
        [Text]
_ -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_NOTOPIC ->
      case [Text]
args of
        Text
_me:Text
chan:[Text]
_ -> NetworkState -> Apply
noReply
                    (NetworkState -> Apply) -> NetworkState -> Apply
forall a b. (a -> b) -> a -> b
$ Identifier
-> (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannel
                        (Text -> Identifier
mkId Text
chan)
                        (Text -> ChannelState -> ChannelState
setTopic Text
"" (ChannelState -> ChannelState)
-> (ChannelState -> ChannelState) -> ChannelState -> ChannelState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  ChannelState
  ChannelState
  (Maybe TopicProvenance)
  (Maybe TopicProvenance)
-> Maybe TopicProvenance -> ChannelState -> ChannelState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  ChannelState
  ChannelState
  (Maybe TopicProvenance)
  (Maybe TopicProvenance)
Lens' ChannelState (Maybe TopicProvenance)
chanTopicProvenance Maybe TopicProvenance
forall a. Maybe a
Nothing)
                        NetworkState
cs
        [Text]
_ -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_TOPIC ->
      case [Text]
args of
        Text
_me:Text
chan:Text
topic:[Text]
_ -> NetworkState -> Apply
noReply (Identifier
-> (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannel (Text -> Identifier
mkId Text
chan) (Text -> ChannelState -> ChannelState
setTopic Text
topic) NetworkState
cs)
        [Text]
_                -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_TOPICWHOTIME ->
      case [Text]
args of
        Text
_me:Text
chan:Text
who:Text
whenTxt:[Text]
_ | Just UTCTime
when <- Text -> Maybe UTCTime
parseTimeParam Text
whenTxt ->
          let !prov :: TopicProvenance
prov = TopicProvenance :: UserInfo -> UTCTime -> TopicProvenance
TopicProvenance
                       { _topicAuthor :: UserInfo
_topicAuthor = Text -> UserInfo
parseUserInfo Text
who
                       , _topicTime :: UTCTime
_topicTime   = UTCTime
when
                       }
          in NetworkState -> Apply
noReply (Identifier
-> (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannel (Text -> Identifier
mkId Text
chan) (ASetter
  ChannelState
  ChannelState
  (Maybe TopicProvenance)
  (Maybe TopicProvenance)
-> Maybe TopicProvenance -> ChannelState -> ChannelState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  ChannelState
  ChannelState
  (Maybe TopicProvenance)
  (Maybe TopicProvenance)
Lens' ChannelState (Maybe TopicProvenance)
chanTopicProvenance (TopicProvenance -> Maybe TopicProvenance
forall a. a -> Maybe a
Just TopicProvenance
prov)) NetworkState
cs)
        [Text]
_ -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_CREATIONTIME ->
      case [Text]
args of
        Text
_me:Text
chan:Text
whenTxt:[Text]
_ | Just UTCTime
when <- Text -> Maybe UTCTime
parseTimeParam Text
whenTxt ->
          NetworkState -> Apply
noReply (Identifier
-> (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannel (Text -> Identifier
mkId Text
chan) (ASetter ChannelState ChannelState (Maybe UTCTime) (Maybe UTCTime)
-> Maybe UTCTime -> ChannelState -> ChannelState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ChannelState ChannelState (Maybe UTCTime) (Maybe UTCTime)
Lens' ChannelState (Maybe UTCTime)
chanCreation (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
when)) NetworkState
cs)
        [Text]
_ -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_CHANNEL_URL ->
      case [Text]
args of
        Text
_me:Text
chan:Text
urlTxt:[Text]
_ ->
          NetworkState -> Apply
noReply (Identifier
-> (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannel (Text -> Identifier
mkId Text
chan) (ASetter ChannelState ChannelState (Maybe Text) (Maybe Text)
-> Maybe Text -> ChannelState -> ChannelState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ChannelState ChannelState (Maybe Text) (Maybe Text)
Lens' ChannelState (Maybe Text)
chanUrl (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
urlTxt)) NetworkState
cs)
        [Text]
_ -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_MYINFO -> NetworkState -> Apply
noReply ([Text] -> NetworkState -> NetworkState
myinfo [Text]
args NetworkState
cs)

    ReplyCode
RPL_ISUPPORT -> NetworkState -> Apply
noReply ([Text] -> NetworkState -> NetworkState
isupport [Text]
args NetworkState
cs)

    ReplyCode
RPL_NAMREPLY ->
      case [Text]
args of
        Text
_me:Text
_sym:Text
_tgt:Text
x:[Text]
_ ->
           NetworkState -> Apply
noReply (NetworkState -> Apply) -> NetworkState -> Apply
forall a b. (a -> b) -> a -> b
$
           ASetter NetworkState NetworkState Transaction Transaction
-> (Transaction -> Transaction) -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter NetworkState NetworkState Transaction Transaction
Lens' NetworkState Transaction
csTransaction
                (\Transaction
t -> let xs :: [Text]
xs = Getting [Text] Transaction [Text] -> Transaction -> [Text]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Text] Transaction [Text]
Prism' Transaction [Text]
_NamesTransaction Transaction
t
                       in [Text]
xs [Text] -> Transaction -> Transaction
`seq` [Text] -> Transaction
NamesTransaction (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
xs))
                NetworkState
cs
        [Text]
_ -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_ENDOFNAMES ->
      case [Text]
args of
        Text
_me:Text
tgt:[Text]
_ -> NetworkState -> Apply
noReply (Identifier -> NetworkState -> NetworkState
loadNamesList (Text -> Identifier
mkId Text
tgt) NetworkState
cs)
        [Text]
_         -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_BANLIST ->
      case [Text]
args of
        Text
_me:Text
_tgt:Text
mask:Text
who:Text
whenTxt:[Text]
_ -> NetworkState -> Apply
noReply (Text -> Text -> Text -> NetworkState -> NetworkState
recordListEntry Text
mask Text
who Text
whenTxt NetworkState
cs)
        [Text]
_                           -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_ENDOFBANLIST ->
      case [Text]
args of
        Text
_me:Text
tgt:[Text]
_ -> NetworkState -> Apply
noReply (Char -> Text -> NetworkState -> NetworkState
saveList Char
'b' Text
tgt NetworkState
cs)
        [Text]
_         -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_QUIETLIST ->
      case [Text]
args of
        Text
_me:Text
_tgt:Text
_q:Text
mask:Text
who:Text
whenTxt:[Text]
_ -> NetworkState -> Apply
noReply (Text -> Text -> Text -> NetworkState -> NetworkState
recordListEntry Text
mask Text
who Text
whenTxt NetworkState
cs)
        [Text]
_                              -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_ENDOFQUIETLIST ->
      case [Text]
args of
        Text
_me:Text
tgt:[Text]
_ -> NetworkState -> Apply
noReply (Char -> Text -> NetworkState -> NetworkState
saveList Char
'q' Text
tgt NetworkState
cs)
        [Text]
_         -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_INVEXLIST ->
      case [Text]
args of
        Text
_me:Text
_tgt:Text
mask:Text
who:Text
whenTxt:[Text]
_ -> NetworkState -> Apply
noReply (Text -> Text -> Text -> NetworkState -> NetworkState
recordListEntry Text
mask Text
who Text
whenTxt NetworkState
cs)
        [Text]
_                           -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_ENDOFINVEXLIST ->
      case [Text]
args of
        Text
_me:Text
tgt:[Text]
_ -> NetworkState -> Apply
noReply (Char -> Text -> NetworkState -> NetworkState
saveList Char
'I' Text
tgt NetworkState
cs)
        [Text]
_         -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_EXCEPTLIST ->
      case [Text]
args of
        Text
_me:Text
_tgt:Text
mask:Text
who:Text
whenTxt:[Text]
_ -> NetworkState -> Apply
noReply (Text -> Text -> Text -> NetworkState -> NetworkState
recordListEntry Text
mask Text
who Text
whenTxt NetworkState
cs)
        [Text]
_                           -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_ENDOFEXCEPTLIST ->
      case [Text]
args of
        Text
_me:Text
tgt:[Text]
_ -> NetworkState -> Apply
noReply (Char -> Text -> NetworkState -> NetworkState
saveList Char
'e' Text
tgt NetworkState
cs)
        [Text]
_         -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_WHOREPLY ->
      case [Text]
args of
        Text
_me:Text
_tgt:Text
uname:Text
host:Text
_server:Text
nick:[Text]
_ ->
          NetworkState -> Apply
noReply (NetworkState -> Apply) -> NetworkState -> Apply
forall a b. (a -> b) -> a -> b
$
          ASetter NetworkState NetworkState Transaction Transaction
-> (Transaction -> Transaction) -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter NetworkState NetworkState Transaction Transaction
Lens' NetworkState Transaction
csTransaction (\Transaction
t ->
            let !x :: UserInfo
x  = Identifier -> Text -> Text -> UserInfo
UserInfo (Text -> Identifier
mkId Text
nick) Text
uname Text
host
                !xs :: [UserInfo]
xs = Getting [UserInfo] Transaction [UserInfo]
-> Transaction -> [UserInfo]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [UserInfo] Transaction [UserInfo]
Prism' Transaction [UserInfo]
_WhoTransaction Transaction
t
            in [UserInfo] -> Transaction
WhoTransaction (UserInfo
x UserInfo -> [UserInfo] -> [UserInfo]
forall a. a -> [a] -> [a]
: [UserInfo]
xs))
            NetworkState
cs
        [Text]
_ -> NetworkState -> Apply
noReply NetworkState
cs

    ReplyCode
RPL_ENDOFWHO -> NetworkState -> Apply
noReply (NetworkState -> NetworkState
massRegistration NetworkState
cs)

    ReplyCode
RPL_CHANNELMODEIS ->
      case [Text]
args of
        Text
_me:Text
chan:Text
modes:[Text]
params ->
              ZonedTime
-> UserInfo
-> Identifier
-> Text
-> [Text]
-> NetworkState
-> Apply
doMode ZonedTime
msgWhen UserInfo
who Identifier
chanId Text
modes [Text]
params
            (NetworkState -> Apply) -> NetworkState -> Apply
forall a b. (a -> b) -> a -> b
$ ASetter NetworkState NetworkState (Map Char Text) (Map Char Text)
-> Map Char Text -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set (ASetter
  NetworkState
  NetworkState
  (HashMap Identifier ChannelState)
  (HashMap Identifier ChannelState)
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ASetter
  NetworkState
  NetworkState
  (HashMap Identifier ChannelState)
  (HashMap Identifier ChannelState)
-> ((Map Char Text -> Identity (Map Char Text))
    -> HashMap Identifier ChannelState
    -> Identity (HashMap Identifier ChannelState))
-> ASetter
     NetworkState NetworkState (Map Char Text) (Map Char Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier ChannelState)
chanId ((ChannelState -> Identity ChannelState)
 -> HashMap Identifier ChannelState
 -> Identity (HashMap Identifier ChannelState))
-> ((Map Char Text -> Identity (Map Char Text))
    -> ChannelState -> Identity ChannelState)
-> (Map Char Text -> Identity (Map Char Text))
-> HashMap Identifier ChannelState
-> Identity (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Char Text -> Identity (Map Char Text))
-> ChannelState -> Identity ChannelState
Lens' ChannelState (Map Char Text)
chanModes) Map Char Text
forall k a. Map k a
Map.empty NetworkState
cs
            where chanId :: Identifier
chanId = Text -> Identifier
mkId Text
chan
                  !who :: UserInfo
who = Identifier -> Text -> Text -> UserInfo
UserInfo Identifier
"*" Text
"" Text
""
        [Text]
_ -> NetworkState -> Apply
noReply NetworkState
cs

    -- Away flag tracking
    ReplyCode
RPL_NOWAWAY -> NetworkState -> Apply
noReply (ASetter NetworkState NetworkState Bool Bool
-> Bool -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState Bool Bool
Lens' NetworkState Bool
csAway Bool
True NetworkState
cs)
    ReplyCode
RPL_UNAWAY  -> NetworkState -> Apply
noReply (ASetter NetworkState NetworkState Bool Bool
-> Bool -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState Bool Bool
Lens' NetworkState Bool
csAway Bool
False NetworkState
cs)

    ReplyCode
_ -> NetworkState -> Apply
noReply NetworkState
cs


-- | Add an entry to a mode list transaction
recordListEntry ::
  Text {- ^ mask -} ->
  Text {- ^ set by -} ->
  Text {- ^ set time -} ->
  NetworkState -> NetworkState
recordListEntry :: Text -> Text -> Text -> NetworkState -> NetworkState
recordListEntry Text
mask Text
who Text
whenTxt =
  case Text -> Maybe UTCTime
parseTimeParam Text
whenTxt of
    Maybe UTCTime
Nothing   -> NetworkState -> NetworkState
forall a. a -> a
id
    Just UTCTime
when ->
      ASetter NetworkState NetworkState Transaction Transaction
-> (Transaction -> Transaction) -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter NetworkState NetworkState Transaction Transaction
Lens' NetworkState Transaction
csTransaction ((Transaction -> Transaction) -> NetworkState -> NetworkState)
-> (Transaction -> Transaction) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ \Transaction
t ->
        let !x :: MaskListEntry
x = MaskListEntry :: Text -> UTCTime -> MaskListEntry
MaskListEntry
                    { _maskListSetter :: Text
_maskListSetter = Text
who
                    , _maskListTime :: UTCTime
_maskListTime   = UTCTime
when
                    }
            !xs :: [(Text, MaskListEntry)]
xs = Getting [(Text, MaskListEntry)] Transaction [(Text, MaskListEntry)]
-> Transaction -> [(Text, MaskListEntry)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(Text, MaskListEntry)] Transaction [(Text, MaskListEntry)]
Prism' Transaction [(Text, MaskListEntry)]
_BanTransaction Transaction
t
        in [(Text, MaskListEntry)] -> Transaction
BanTransaction ((Text
mask,MaskListEntry
x)(Text, MaskListEntry)
-> [(Text, MaskListEntry)] -> [(Text, MaskListEntry)]
forall a. a -> [a] -> [a]
:[(Text, MaskListEntry)]
xs)


-- | Save a completed ban, quiet, invex, or exempt list into the channel
-- state.
saveList ::
  Char {- ^ mode -} ->
  Text {- ^ channel -} ->
  NetworkState -> NetworkState
saveList :: Char -> Text -> NetworkState -> NetworkState
saveList Char
mode Text
tgt NetworkState
cs
   = ASetter NetworkState NetworkState Transaction Transaction
-> Transaction -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState Transaction Transaction
Lens' NetworkState Transaction
csTransaction Transaction
NoTransaction
   (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ ASetter
  NetworkState
  NetworkState
  (Maybe (HashMap Text MaskListEntry))
  (Maybe (HashMap Text MaskListEntry))
-> Maybe (HashMap Text MaskListEntry)
-> NetworkState
-> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
setStrict
        (ASetter
  NetworkState
  NetworkState
  (HashMap Identifier ChannelState)
  (HashMap Identifier ChannelState)
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ASetter
  NetworkState
  NetworkState
  (HashMap Identifier ChannelState)
  (HashMap Identifier ChannelState)
-> ((Maybe (HashMap Text MaskListEntry)
     -> Identity (Maybe (HashMap Text MaskListEntry)))
    -> HashMap Identifier ChannelState
    -> Identity (HashMap Identifier ChannelState))
-> ASetter
     NetworkState
     NetworkState
     (Maybe (HashMap Text MaskListEntry))
     (Maybe (HashMap Text MaskListEntry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> Identifier
mkId Text
tgt) ((ChannelState -> Identity ChannelState)
 -> HashMap Identifier ChannelState
 -> Identity (HashMap Identifier ChannelState))
-> ((Maybe (HashMap Text MaskListEntry)
     -> Identity (Maybe (HashMap Text MaskListEntry)))
    -> ChannelState -> Identity ChannelState)
-> (Maybe (HashMap Text MaskListEntry)
    -> Identity (Maybe (HashMap Text MaskListEntry)))
-> HashMap Identifier ChannelState
-> Identity (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Char (HashMap Text MaskListEntry)
 -> Identity (Map Char (HashMap Text MaskListEntry)))
-> ChannelState -> Identity ChannelState
Lens' ChannelState (Map Char (HashMap Text MaskListEntry))
chanLists ((Map Char (HashMap Text MaskListEntry)
  -> Identity (Map Char (HashMap Text MaskListEntry)))
 -> ChannelState -> Identity ChannelState)
-> ((Maybe (HashMap Text MaskListEntry)
     -> Identity (Maybe (HashMap Text MaskListEntry)))
    -> Map Char (HashMap Text MaskListEntry)
    -> Identity (Map Char (HashMap Text MaskListEntry)))
-> (Maybe (HashMap Text MaskListEntry)
    -> Identity (Maybe (HashMap Text MaskListEntry)))
-> ChannelState
-> Identity ChannelState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Char (HashMap Text MaskListEntry))
-> Lens'
     (Map Char (HashMap Text MaskListEntry))
     (Maybe (IxValue (Map Char (HashMap Text MaskListEntry))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Char
Index (Map Char (HashMap Text MaskListEntry))
mode)
        (HashMap Text MaskListEntry -> Maybe (HashMap Text MaskListEntry)
forall a. a -> Maybe a
Just (HashMap Text MaskListEntry -> Maybe (HashMap Text MaskListEntry))
-> HashMap Text MaskListEntry -> Maybe (HashMap Text MaskListEntry)
forall a b. (a -> b) -> a -> b
$! HashMap Text MaskListEntry
newList)
        NetworkState
cs
  where
    newList :: HashMap Text MaskListEntry
newList = [(Text, MaskListEntry)] -> HashMap Text MaskListEntry
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (Getting
  [(Text, MaskListEntry)] NetworkState [(Text, MaskListEntry)]
-> NetworkState -> [(Text, MaskListEntry)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Transaction -> Const [(Text, MaskListEntry)] Transaction)
-> NetworkState -> Const [(Text, MaskListEntry)] NetworkState
Lens' NetworkState Transaction
csTransaction ((Transaction -> Const [(Text, MaskListEntry)] Transaction)
 -> NetworkState -> Const [(Text, MaskListEntry)] NetworkState)
-> Getting
     [(Text, MaskListEntry)] Transaction [(Text, MaskListEntry)]
-> Getting
     [(Text, MaskListEntry)] NetworkState [(Text, MaskListEntry)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [(Text, MaskListEntry)] Transaction [(Text, MaskListEntry)]
Prism' Transaction [(Text, MaskListEntry)]
_BanTransaction) NetworkState
cs)


-- | These replies are interpreted by the client and should only be shown
-- in the detailed view.
squelchReply :: ReplyCode -> Bool
squelchReply :: ReplyCode -> Bool
squelchReply ReplyCode
rpl =
  case ReplyCode
rpl of
    ReplyCode
RPL_NAMREPLY        -> Bool
True
    ReplyCode
RPL_ENDOFNAMES      -> Bool
True
    ReplyCode
RPL_BANLIST         -> Bool
True
    ReplyCode
RPL_ENDOFBANLIST    -> Bool
True
    ReplyCode
RPL_INVEXLIST       -> Bool
True
    ReplyCode
RPL_ENDOFINVEXLIST  -> Bool
True
    ReplyCode
RPL_EXCEPTLIST      -> Bool
True
    ReplyCode
RPL_ENDOFEXCEPTLIST -> Bool
True
    ReplyCode
RPL_QUIETLIST       -> Bool
True
    ReplyCode
RPL_ENDOFQUIETLIST  -> Bool
True
    ReplyCode
RPL_CHANNELMODEIS   -> Bool
True
    ReplyCode
RPL_UMODEIS         -> Bool
True
    ReplyCode
RPL_SNOMASK         -> Bool
True
    ReplyCode
RPL_WHOREPLY        -> Bool
True
    ReplyCode
RPL_ENDOFWHO        -> Bool
True
    ReplyCode
RPL_WHOSPCRPL       -> Bool
True
    ReplyCode
RPL_TOPICWHOTIME    -> Bool
True
    ReplyCode
RPL_CREATIONTIME    -> Bool
True
    ReplyCode
RPL_CHANNEL_URL     -> Bool
True
    ReplyCode
RPL_NOTOPIC         -> Bool
True
    ReplyCode
_                   -> Bool
False

-- | Return 'True' for messages that should be hidden outside of
-- full detail view. These messages are interpreted by the client
-- so the user shouldn't need to see them directly to get the
-- relevant information.
squelchIrcMsg :: IrcMsg -> Bool
squelchIrcMsg :: IrcMsg -> Bool
squelchIrcMsg (Reply Text
_ ReplyCode
rpl [Text]
_) = ReplyCode -> Bool
squelchReply ReplyCode
rpl
squelchIrcMsg IrcMsg
_               = Bool
False

doMode ::
  ZonedTime {- ^ time of message -} ->
  UserInfo  {- ^ sender          -} ->
  Identifier {- ^ channel        -} ->
  Text       {- ^ mode flags     -} ->
  [Text]     {- ^ mode parameters -} ->
  NetworkState ->
  Apply
doMode :: ZonedTime
-> UserInfo
-> Identifier
-> Text
-> [Text]
-> NetworkState
-> Apply
doMode ZonedTime
when UserInfo
who Identifier
target Text
modes [Text]
args NetworkState
cs
  | Getting Identifier NetworkState Identifier
-> NetworkState -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier NetworkState Identifier
Lens' NetworkState Identifier
csNick NetworkState
cs Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
target
  , Just [(Bool, Char, Text)]
xs <- ModeTypes -> Text -> [Text] -> Maybe [(Bool, Char, Text)]
splitModes (Getting ModeTypes NetworkState ModeTypes
-> NetworkState -> ModeTypes
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ModeTypes NetworkState ModeTypes
Lens' NetworkState ModeTypes
csUmodeTypes NetworkState
cs) Text
modes [Text]
args =
        NetworkState -> Apply
noReply ([(Bool, Char, Text)] -> NetworkState -> NetworkState
doMyModes [(Bool, Char, Text)]
xs NetworkState
cs)

  | NetworkState -> Identifier -> Bool
isChannelIdentifier NetworkState
cs Identifier
target
  , Just [(Bool, Char, Text)]
xs <- ModeTypes -> Text -> [Text] -> Maybe [(Bool, Char, Text)]
splitModes (Getting ModeTypes NetworkState ModeTypes
-> NetworkState -> ModeTypes
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ModeTypes NetworkState ModeTypes
Lens' NetworkState ModeTypes
csModeTypes NetworkState
cs) Text
modes [Text]
args
  , let cs' :: NetworkState
cs' = ZonedTime
-> UserInfo
-> Identifier
-> [(Bool, Char, Text)]
-> NetworkState
-> NetworkState
doChannelModes ZonedTime
when UserInfo
who Identifier
target [(Bool, Char, Text)]
xs NetworkState
cs =

    if Identifier -> NetworkState -> Bool
iHaveOp Identifier
target NetworkState
cs'
      then let ([RawIrcMsg]
response, NetworkState
cs_) = NetworkState
cs' NetworkState
-> (NetworkState -> ([RawIrcMsg], NetworkState))
-> ([RawIrcMsg], NetworkState)
forall a b. a -> (a -> b) -> b
& (HashMap Identifier ChannelState
 -> ([RawIrcMsg], HashMap Identifier ChannelState))
-> NetworkState -> ([RawIrcMsg], NetworkState)
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> ([RawIrcMsg], HashMap Identifier ChannelState))
 -> NetworkState -> ([RawIrcMsg], NetworkState))
-> (([RawIrcMsg] -> ([RawIrcMsg], [RawIrcMsg]))
    -> HashMap Identifier ChannelState
    -> ([RawIrcMsg], HashMap Identifier ChannelState))
-> ([RawIrcMsg] -> ([RawIrcMsg], [RawIrcMsg]))
-> NetworkState
-> ([RawIrcMsg], NetworkState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier ChannelState)
target ((ChannelState -> ([RawIrcMsg], ChannelState))
 -> HashMap Identifier ChannelState
 -> ([RawIrcMsg], HashMap Identifier ChannelState))
-> (([RawIrcMsg] -> ([RawIrcMsg], [RawIrcMsg]))
    -> ChannelState -> ([RawIrcMsg], ChannelState))
-> ([RawIrcMsg] -> ([RawIrcMsg], [RawIrcMsg]))
-> HashMap Identifier ChannelState
-> ([RawIrcMsg], HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RawIrcMsg] -> ([RawIrcMsg], [RawIrcMsg]))
-> ChannelState -> ([RawIrcMsg], ChannelState)
Lens' ChannelState [RawIrcMsg]
chanQueuedModeration (([RawIrcMsg] -> ([RawIrcMsg], [RawIrcMsg]))
 -> NetworkState -> ([RawIrcMsg], NetworkState))
-> [RawIrcMsg] -> NetworkState -> ([RawIrcMsg], NetworkState)
forall a s t b. LensLike ((,) a) s t a b -> b -> s -> (a, t)
<<.~ []
           in [RawIrcMsg] -> NetworkState -> Apply
reply [RawIrcMsg]
response NetworkState
cs_
      else NetworkState -> Apply
noReply NetworkState
cs'

doMode ZonedTime
_ UserInfo
_ Identifier
_ Text
_ [Text]
_ NetworkState
cs = NetworkState -> Apply
noReply NetworkState
cs -- ignore bad mode command

-- | Predicate to test if the connection has op in a given channel.
iHaveOp :: Identifier -> NetworkState -> Bool
iHaveOp :: Identifier -> NetworkState -> Bool
iHaveOp Identifier
channel NetworkState
cs =
  Getting Any NetworkState Char -> Char -> NetworkState -> Bool
forall a s. Eq a => Getting Any s a -> a -> s -> Bool
elemOf ((HashMap Identifier ChannelState
 -> Const Any (HashMap Identifier ChannelState))
-> NetworkState -> Const Any NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const Any (HashMap Identifier ChannelState))
 -> NetworkState -> Const Any NetworkState)
-> ((Char -> Const Any Char)
    -> HashMap Identifier ChannelState
    -> Const Any (HashMap Identifier ChannelState))
-> Getting Any NetworkState Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier ChannelState)
channel ((ChannelState -> Const Any ChannelState)
 -> HashMap Identifier ChannelState
 -> Const Any (HashMap Identifier ChannelState))
-> ((Char -> Const Any Char)
    -> ChannelState -> Const Any ChannelState)
-> (Char -> Const Any Char)
-> HashMap Identifier ChannelState
-> Const Any (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier [Char]
 -> Const Any (HashMap Identifier [Char]))
-> ChannelState -> Const Any ChannelState
Lens' ChannelState (HashMap Identifier [Char])
chanUsers ((HashMap Identifier [Char]
  -> Const Any (HashMap Identifier [Char]))
 -> ChannelState -> Const Any ChannelState)
-> ((Char -> Const Any Char)
    -> HashMap Identifier [Char]
    -> Const Any (HashMap Identifier [Char]))
-> (Char -> Const Any Char)
-> ChannelState
-> Const Any ChannelState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier [Char])
-> Traversal'
     (HashMap Identifier [Char]) (IxValue (HashMap Identifier [Char]))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier [Char])
me (([Char] -> Const Any [Char])
 -> HashMap Identifier [Char]
 -> Const Any (HashMap Identifier [Char]))
-> ((Char -> Const Any Char) -> [Char] -> Const Any [Char])
-> (Char -> Const Any Char)
-> HashMap Identifier [Char]
-> Const Any (HashMap Identifier [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Const Any Char) -> [Char] -> Const Any [Char]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded) Char
'@' NetworkState
cs
  where
    me :: Identifier
me = Getting Identifier NetworkState Identifier
-> NetworkState -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier NetworkState Identifier
Lens' NetworkState Identifier
csNick NetworkState
cs


doChannelModes :: ZonedTime -> UserInfo -> Identifier -> [(Bool, Char, Text)] -> NetworkState -> NetworkState
doChannelModes :: ZonedTime
-> UserInfo
-> Identifier
-> [(Bool, Char, Text)]
-> NetworkState
-> NetworkState
doChannelModes ZonedTime
when UserInfo
who Identifier
chan [(Bool, Char, Text)]
changes NetworkState
cs = Identifier
-> (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannel Identifier
chan ChannelState -> ChannelState
applyChannelModes NetworkState
cs
  where
    modeTypes :: ModeTypes
modeTypes = Getting ModeTypes NetworkState ModeTypes
-> NetworkState -> ModeTypes
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ModeTypes NetworkState ModeTypes
Lens' NetworkState ModeTypes
csModeTypes NetworkState
cs
    sigilMap :: [(Char, Char)]
sigilMap  = Getting [(Char, Char)] ModeTypes [(Char, Char)]
-> ModeTypes -> [(Char, Char)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(Char, Char)] ModeTypes [(Char, Char)]
forall (f :: * -> *).
Functor f =>
([(Char, Char)] -> f [(Char, Char)]) -> ModeTypes -> f ModeTypes
modesPrefixModes ModeTypes
modeTypes
    listModes :: [Char]
listModes = Getting [Char] ModeTypes [Char] -> ModeTypes -> [Char]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Char] ModeTypes [Char]
forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesLists ModeTypes
modeTypes

    applyChannelModes :: ChannelState -> ChannelState
applyChannelModes ChannelState
c = (ChannelState -> (Bool, Char, Text) -> ChannelState)
-> ChannelState -> [(Bool, Char, Text)] -> ChannelState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ChannelState -> (Bool, Char, Text) -> ChannelState
applyChannelMode ChannelState
c [(Bool, Char, Text)]
changes

    applyChannelMode :: ChannelState -> (Bool, Char, Text) -> ChannelState
applyChannelMode ChannelState
c (Bool
polarity, Char
mode, Text
arg)

      | Just Char
sigil <- Char -> [(Char, Char)] -> Maybe Char
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
mode [(Char, Char)]
sigilMap =
          LensLike ((,) StrictUnit) ChannelState ChannelState [Char] [Char]
-> ShowS -> ChannelState -> ChannelState
forall s t a b.
LensLike ((,) StrictUnit) s t a b -> (a -> b) -> s -> t
overStrict ((HashMap Identifier [Char]
 -> (StrictUnit, HashMap Identifier [Char]))
-> ChannelState -> (StrictUnit, ChannelState)
Lens' ChannelState (HashMap Identifier [Char])
chanUsers ((HashMap Identifier [Char]
  -> (StrictUnit, HashMap Identifier [Char]))
 -> ChannelState -> (StrictUnit, ChannelState))
-> (([Char] -> (StrictUnit, [Char]))
    -> HashMap Identifier [Char]
    -> (StrictUnit, HashMap Identifier [Char]))
-> LensLike
     ((,) StrictUnit) ChannelState ChannelState [Char] [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier [Char])
-> Traversal'
     (HashMap Identifier [Char]) (IxValue (HashMap Identifier [Char]))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Text -> Identifier
mkId Text
arg))
                     (Bool -> Char -> ShowS
setPrefixMode Bool
polarity Char
sigil)
                     ChannelState
c

      | Char
mode Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
listModes =
        let entry :: Maybe MaskListEntry
entry | Bool
polarity = MaskListEntry -> Maybe MaskListEntry
forall a. a -> Maybe a
Just (MaskListEntry -> Maybe MaskListEntry)
-> MaskListEntry -> Maybe MaskListEntry
forall a b. (a -> b) -> a -> b
$! MaskListEntry :: Text -> UTCTime -> MaskListEntry
MaskListEntry
                         { _maskListSetter :: Text
_maskListSetter = UserInfo -> Text
renderUserInfo UserInfo
who
                         , _maskListTime :: UTCTime
_maskListTime   = ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
when
                         }
                  | Bool
otherwise = Maybe MaskListEntry
forall a. Maybe a
Nothing
        in ASetter
  ChannelState
  ChannelState
  (Maybe MaskListEntry)
  (Maybe MaskListEntry)
-> Maybe MaskListEntry -> ChannelState -> ChannelState
forall s t a b. ASetter s t a b -> b -> s -> t
setStrict ((Map Char (HashMap Text MaskListEntry)
 -> Identity (Map Char (HashMap Text MaskListEntry)))
-> ChannelState -> Identity ChannelState
Lens' ChannelState (Map Char (HashMap Text MaskListEntry))
chanLists ((Map Char (HashMap Text MaskListEntry)
  -> Identity (Map Char (HashMap Text MaskListEntry)))
 -> ChannelState -> Identity ChannelState)
-> ((Maybe MaskListEntry -> Identity (Maybe MaskListEntry))
    -> Map Char (HashMap Text MaskListEntry)
    -> Identity (Map Char (HashMap Text MaskListEntry)))
-> ASetter
     ChannelState
     ChannelState
     (Maybe MaskListEntry)
     (Maybe MaskListEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Char (HashMap Text MaskListEntry))
-> Traversal'
     (Map Char (HashMap Text MaskListEntry))
     (IxValue (Map Char (HashMap Text MaskListEntry)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Char
Index (Map Char (HashMap Text MaskListEntry))
mode ((HashMap Text MaskListEntry
  -> Identity (HashMap Text MaskListEntry))
 -> Map Char (HashMap Text MaskListEntry)
 -> Identity (Map Char (HashMap Text MaskListEntry)))
-> ((Maybe MaskListEntry -> Identity (Maybe MaskListEntry))
    -> HashMap Text MaskListEntry
    -> Identity (HashMap Text MaskListEntry))
-> (Maybe MaskListEntry -> Identity (Maybe MaskListEntry))
-> Map Char (HashMap Text MaskListEntry)
-> Identity (Map Char (HashMap Text MaskListEntry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text MaskListEntry)
-> Lens'
     (HashMap Text MaskListEntry)
     (Maybe (IxValue (HashMap Text MaskListEntry)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (HashMap Text MaskListEntry)
arg) Maybe MaskListEntry
entry ChannelState
c

      | Bool
polarity  = ASetter ChannelState ChannelState (Maybe Text) (Maybe Text)
-> Maybe Text -> ChannelState -> ChannelState
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Map Char Text -> Identity (Map Char Text))
-> ChannelState -> Identity ChannelState
Lens' ChannelState (Map Char Text)
chanModes ((Map Char Text -> Identity (Map Char Text))
 -> ChannelState -> Identity ChannelState)
-> ((Maybe Text -> Identity (Maybe Text))
    -> Map Char Text -> Identity (Map Char Text))
-> ASetter ChannelState ChannelState (Maybe Text) (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Char Text)
-> Lens' (Map Char Text) (Maybe (IxValue (Map Char Text)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Char
Index (Map Char Text)
mode) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
arg) ChannelState
c
      | Bool
otherwise = ((Map Char Text -> Identity (Map Char Text))
 -> ChannelState -> Identity ChannelState)
-> (Map Char Text -> Map Char Text) -> ChannelState -> ChannelState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Map Char Text -> Identity (Map Char Text))
-> ChannelState -> Identity ChannelState
Lens' ChannelState (Map Char Text)
chanModes (Index (Map Char Text) -> Map Char Text -> Map Char Text
forall m. At m => Index m -> m -> m
sans Char
Index (Map Char Text)
mode) ChannelState
c

    setPrefixMode :: Bool -> Char -> ShowS
setPrefixMode Bool
polarity Char
sigil [Char]
sigils
      | Bool -> Bool
not Bool
polarity        = Char -> ShowS
forall a. Eq a => a -> [a] -> [a]
delete Char
sigil [Char]
sigils
      | Char
sigil Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
sigils = [Char]
sigils
      | Bool
otherwise           = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
sigils') (((Char, Char) -> Char) -> [(Char, Char)] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (Char, Char) -> Char
forall a b. (a, b) -> b
snd [(Char, Char)]
sigilMap)
      where
        sigils' :: [Char]
sigils' = Char
sigil Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
sigils


doMyModes :: [(Bool, Char, Text)] -> NetworkState -> NetworkState
doMyModes :: [(Bool, Char, Text)] -> NetworkState -> NetworkState
doMyModes [(Bool, Char, Text)]
changes = ASetter NetworkState NetworkState [Char] [Char]
-> ShowS -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter NetworkState NetworkState [Char] [Char]
Lens' NetworkState [Char]
csModes (ShowS -> NetworkState -> NetworkState)
-> ShowS -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ \[Char]
modes -> ShowS
forall a. Ord a => [a] -> [a]
sort (([Char] -> (Bool, Char, Text) -> [Char])
-> [Char] -> [(Bool, Char, Text)] -> [Char]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Char] -> (Bool, Char, Text) -> [Char]
forall a c. Eq a => [a] -> (Bool, a, c) -> [a]
applyOne [Char]
modes [(Bool, Char, Text)]
changes)
  where
    applyOne :: [a] -> (Bool, a, c) -> [a]
applyOne [a]
modes (Bool
True, a
mode, c
_)
      | a
mode a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
modes = [a]
modes
      | Bool
otherwise         = a
modea -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
modes
    applyOne [a]
modes (Bool
False, a
mode, c
_) = a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
delete a
mode [a]
modes

selectCaps ::
  NetworkState         {- ^ network state  -} ->
  [(Text, Maybe Text)] {- ^ server caps    -} ->
  [Text]               {- ^ caps to enable -}
selectCaps :: NetworkState -> [(Text, Maybe Text)] -> [Text]
selectCaps NetworkState
cs [(Text, Maybe Text)]
offered = ([Text]
supported [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` Map Text (Maybe Text) -> [Text]
forall k a. Map k a -> [k]
Map.keys Map Text (Maybe Text)
capMap)
                        [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
`union`
                        Getting [Text] NetworkState [Text] -> NetworkState -> [Text]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ServerSettings -> Const [Text] ServerSettings)
-> NetworkState -> Const [Text] NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const [Text] ServerSettings)
 -> NetworkState -> Const [Text] NetworkState)
-> (([Text] -> Const [Text] [Text])
    -> ServerSettings -> Const [Text] ServerSettings)
-> Getting [Text] NetworkState [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Const [Text] [Text])
-> ServerSettings -> Const [Text] ServerSettings
Lens' ServerSettings [Text]
ssCapabilities) NetworkState
cs
  where
    capMap :: Map Text (Maybe Text)
capMap = [(Text, Maybe Text)] -> Map Text (Maybe Text)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Maybe Text)]
offered

    supported :: [Text]
supported =
      [Text]
sasl [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
serverTime [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
      [Text
"multi-prefix", Text
"batch", Text
"znc.in/playback", Text
"znc.in/self-message"
      , Text
"cap-notify", Text
"extended-join", Text
"account-notify", Text
"chghost"
      , Text
"userhost-in-names", Text
"account-tag", Text
"solanum.chat/identify-msg"
      , Text
"solanum.chat/realhost" ]

    -- logic for using IRCv3.2 server-time if available and falling back
    -- to ZNC's specific extension otherwise.
    serverTime :: [Text]
serverTime
      | Text
"server-time"            Text -> Map Text (Maybe Text) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Text (Maybe Text)
capMap = [Text
"server-time"]
      | Text
"znc.in/server-time-iso" Text -> Map Text (Maybe Text) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Text (Maybe Text)
capMap = [Text
"znc.in/server-time-iso"]
      | Bool
otherwise                                    = []

    ss :: ServerSettings
ss = Getting ServerSettings NetworkState ServerSettings
-> NetworkState -> ServerSettings
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ServerSettings NetworkState ServerSettings
Lens' NetworkState ServerSettings
csSettings NetworkState
cs
    sasl :: [Text]
sasl = [Text
"sasl" | Maybe SaslMechanism -> Bool
forall a. Maybe a -> Bool
isJust (Getting (Maybe SaslMechanism) ServerSettings (Maybe SaslMechanism)
-> ServerSettings -> Maybe SaslMechanism
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe SaslMechanism) ServerSettings (Maybe SaslMechanism)
Lens' ServerSettings (Maybe SaslMechanism)
ssSaslMechanism ServerSettings
ss) ]

decodeAuthParam :: Text -> Maybe B.ByteString
decodeAuthParam :: Text -> Maybe ByteString
decodeAuthParam Text
"+" = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
""
decodeAuthParam Text
xs =
  case ByteString -> Either [Char] ByteString
B64.decode (Text -> ByteString
Text.encodeUtf8 Text
xs) of
    Right ByteString
bs -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs
    Left [Char]
_ -> Maybe ByteString
forall a. Maybe a
Nothing

abortAuth :: NetworkState -> Apply
abortAuth :: NetworkState -> Apply
abortAuth = [RawIrcMsg] -> NetworkState -> Apply
reply [Text -> RawIrcMsg
ircAuthenticate Text
"*"] (NetworkState -> Apply)
-> (NetworkState -> NetworkState) -> NetworkState -> Apply
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
-> AuthenticateState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState AuthenticateState
AS_None

doAuthenticate :: Text -> NetworkState -> Apply
doAuthenticate :: Text -> NetworkState -> Apply
doAuthenticate Text
paramTxt NetworkState
cs =
  case Text -> Maybe ByteString
decodeAuthParam Text
paramTxt of
    Maybe ByteString
Nothing -> NetworkState -> Apply
abortAuth NetworkState
cs
    Just ByteString
param -> ByteString -> NetworkState -> Apply
doAuthenticate' ByteString
param NetworkState
cs

doAuthenticate' :: B.ByteString -> NetworkState -> Apply
doAuthenticate' :: ByteString -> NetworkState -> Apply
doAuthenticate' ByteString
param NetworkState
cs =
  case Getting AuthenticateState NetworkState AuthenticateState
-> NetworkState -> AuthenticateState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting AuthenticateState NetworkState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState NetworkState
cs of
    AuthenticateState
AS_PlainStarted
      | ByteString -> Bool
B.null ByteString
param
      , Just (SaslPlain Maybe Text
mbAuthz Text
authc (SecretText Text
pass)) <- Getting (Maybe SaslMechanism) ServerSettings (Maybe SaslMechanism)
-> ServerSettings -> Maybe SaslMechanism
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe SaslMechanism) ServerSettings (Maybe SaslMechanism)
Lens' ServerSettings (Maybe SaslMechanism)
ssSaslMechanism ServerSettings
ss
      , let authz :: Text
authz = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mbAuthz
      -> [RawIrcMsg] -> NetworkState -> Apply
reply
           (AuthenticatePayload -> [RawIrcMsg]
ircAuthenticates (Text -> Text -> Text -> AuthenticatePayload
encodePlainAuthentication Text
authz Text
authc Text
pass))
           (ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
-> AuthenticateState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState AuthenticateState
AS_None NetworkState
cs)

    AuthenticateState
AS_ExternalStarted
      | ByteString -> Bool
B.null ByteString
param
      , Just (SaslExternal Maybe Text
mbAuthz) <- Getting (Maybe SaslMechanism) ServerSettings (Maybe SaslMechanism)
-> ServerSettings -> Maybe SaslMechanism
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe SaslMechanism) ServerSettings (Maybe SaslMechanism)
Lens' ServerSettings (Maybe SaslMechanism)
ssSaslMechanism ServerSettings
ss
      , let authz :: Text
authz = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mbAuthz
      -> [RawIrcMsg] -> NetworkState -> Apply
reply
           (AuthenticatePayload -> [RawIrcMsg]
ircAuthenticates (Text -> AuthenticatePayload
encodeExternalAuthentication Text
authz))
           (ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
-> AuthenticateState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState AuthenticateState
AS_None NetworkState
cs)

    AuthenticateState
AS_EcdsaStarted
      | ByteString -> Bool
B.null ByteString
param
      , Just (SaslEcdsa Maybe Text
mbAuthz Text
authc [Char]
_) <- Getting (Maybe SaslMechanism) ServerSettings (Maybe SaslMechanism)
-> ServerSettings -> Maybe SaslMechanism
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe SaslMechanism) ServerSettings (Maybe SaslMechanism)
Lens' ServerSettings (Maybe SaslMechanism)
ssSaslMechanism ServerSettings
ss
      -> [RawIrcMsg] -> NetworkState -> Apply
reply
           (AuthenticatePayload -> [RawIrcMsg]
ircAuthenticates (Maybe Text -> Text -> AuthenticatePayload
Ecdsa.encodeAuthentication Maybe Text
mbAuthz Text
authc))
           (ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
-> AuthenticateState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState AuthenticateState
AS_EcdsaWaitChallenge NetworkState
cs)

    AuthenticateState
AS_EcdsaWaitChallenge -> NetworkState -> Apply
noReply NetworkState
cs -- handled in Client.EventLoop!

    AuthenticateState
AS_ScramStarted
      | ByteString -> Bool
B.null ByteString
param
      , Just (SaslScram ScramDigest
digest Maybe Text
mbAuthz Text
user (SecretText Text
pass))
          <- Getting (Maybe SaslMechanism) ServerSettings (Maybe SaslMechanism)
-> ServerSettings -> Maybe SaslMechanism
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe SaslMechanism) ServerSettings (Maybe SaslMechanism)
Lens' ServerSettings (Maybe SaslMechanism)
ssSaslMechanism ServerSettings
ss
      , let authz :: Text
authz = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mbAuthz
      , (ByteString
nonce, NetworkState
cs') <- NetworkState
cs NetworkState
-> (NetworkState -> (ByteString, NetworkState))
-> (ByteString, NetworkState)
forall a b. a -> (a -> b) -> b
& (StdGen -> (ByteString, StdGen))
-> NetworkState -> (ByteString, NetworkState)
Lens' NetworkState StdGen
csSeed ((StdGen -> (ByteString, StdGen))
 -> NetworkState -> (ByteString, NetworkState))
-> (StdGen -> (ByteString, StdGen))
-> NetworkState
-> (ByteString, NetworkState)
forall k (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ StdGen -> (ByteString, StdGen)
scramNonce
      , (AuthenticatePayload
msg, Phase1
scram1) <-
          ScramDigest
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> (AuthenticatePayload, Phase1)
Scram.initiateScram ScramDigest
digest
            (Text -> ByteString
Text.encodeUtf8 Text
user)
            (Text -> ByteString
Text.encodeUtf8 Text
authz)
            (Text -> ByteString
Text.encodeUtf8 Text
pass)
            ByteString
nonce
      -> [RawIrcMsg] -> NetworkState -> Apply
reply
           (AuthenticatePayload -> [RawIrcMsg]
ircAuthenticates AuthenticatePayload
msg)
           (ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
-> AuthenticateState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState (Phase1 -> AuthenticateState
AS_Scram1 Phase1
scram1) NetworkState
cs')

    AS_Scram1 Phase1
scram1
      | Just (AuthenticatePayload
rsp, Phase2
scram2) <- Phase1 -> ByteString -> Maybe (AuthenticatePayload, Phase2)
Scram.addServerFirst Phase1
scram1 ByteString
param
      -> [RawIrcMsg] -> NetworkState -> Apply
reply
           (AuthenticatePayload -> [RawIrcMsg]
ircAuthenticates AuthenticatePayload
rsp)
           (ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
-> AuthenticateState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState (Phase2 -> AuthenticateState
AS_Scram2 Phase2
scram2) NetworkState
cs)

    AS_Scram2 Phase2
scram2
      | Phase2 -> ByteString -> Bool
Scram.addServerFinal Phase2
scram2 ByteString
param
      -> [RawIrcMsg] -> NetworkState -> Apply
reply
           [Text -> RawIrcMsg
ircAuthenticate Text
"+"]
           (ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
-> AuthenticateState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState AuthenticateState
AS_None NetworkState
cs)

    AuthenticateState
AS_EcdhStarted
      | ByteString -> Bool
B.null ByteString
param
      , Just (SaslEcdh Maybe Text
mbAuthz Text
authc (SecretText Text
key)) <- Getting (Maybe SaslMechanism) ServerSettings (Maybe SaslMechanism)
-> ServerSettings -> Maybe SaslMechanism
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe SaslMechanism) ServerSettings (Maybe SaslMechanism)
Lens' ServerSettings (Maybe SaslMechanism)
ssSaslMechanism ServerSettings
ss
      , Just (AuthenticatePayload
rsp, Phase1
ecdh1) <- Maybe Text -> Text -> Text -> Maybe (AuthenticatePayload, Phase1)
Ecdh.clientFirst Maybe Text
mbAuthz Text
authc Text
key
      -> [RawIrcMsg] -> NetworkState -> Apply
reply
           (AuthenticatePayload -> [RawIrcMsg]
ircAuthenticates AuthenticatePayload
rsp)
           (ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
-> AuthenticateState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState (Phase1 -> AuthenticateState
AS_EcdhWaitChallenge Phase1
ecdh1) NetworkState
cs)
    
    AS_EcdhWaitChallenge Phase1
ecdh1
      | Just AuthenticatePayload
rsp <- Phase1 -> ByteString -> Maybe AuthenticatePayload
Ecdh.clientResponse Phase1
ecdh1 ByteString
param
      -> [RawIrcMsg] -> NetworkState -> Apply
reply (AuthenticatePayload -> [RawIrcMsg]
ircAuthenticates AuthenticatePayload
rsp) (ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
-> AuthenticateState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState AuthenticateState
AS_None NetworkState
cs)

    AuthenticateState
_ -> NetworkState -> Apply
abortAuth NetworkState
cs

  where
    ss :: ServerSettings
ss = Getting ServerSettings NetworkState ServerSettings
-> NetworkState -> ServerSettings
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ServerSettings NetworkState ServerSettings
Lens' NetworkState ServerSettings
csSettings NetworkState
cs

scramNonce :: Random.StdGen -> (B.ByteString, Random.StdGen)
scramNonce :: StdGen -> (ByteString, StdGen)
scramNonce = [Word8] -> Int -> StdGen -> (ByteString, StdGen)
forall t t.
(Eq t, Num t, RandomGen t) =>
[Word8] -> t -> t -> (ByteString, t)
go [] Int
nonceSize
  where
    alphabet :: ByteString
alphabet = ByteString
"!\"#$%&'()*+-./0123456789:;<=>?@\
               \ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`\
               \abcdefghijklmnopqrstuvwxyz{|}~"

    nonceSize :: Int
nonceSize = Int
20 :: Int -- ceiling (128 / logBase 9 (length alphabet))

    go :: [Word8] -> t -> t -> (ByteString, t)
go [Word8]
acc t
0 t
g = ([Word8] -> ByteString
B.pack [Word8]
acc, t
g)
    go [Word8]
acc t
i t
g =
      case (Int, Int) -> t -> (Int, t)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
Random.randomR (Int
0, ByteString -> Int
B.length ByteString
alphabetInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) t
g of
        (Int
x,t
g') -> [Word8] -> t -> t -> (ByteString, t)
go (ByteString -> Int -> Word8
B.index ByteString
alphabet Int
xWord8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:[Word8]
acc) (t
it -> t -> t
forall a. Num a => a -> a -> a
-t
1) t
g'

doCap :: CapCmd -> NetworkState -> Apply
doCap :: CapCmd -> NetworkState -> Apply
doCap CapCmd
cmd NetworkState
cs =
  case CapCmd
cmd of
    (CapLs CapMore
CapMore [(Text, Maybe Text)]
caps) ->
      NetworkState -> Apply
noReply (ASetter NetworkState NetworkState Transaction Transaction
-> Transaction -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState Transaction Transaction
Lens' NetworkState Transaction
csTransaction ([(Text, Maybe Text)] -> Transaction
CapLsTransaction ([(Text, Maybe Text)]
caps [(Text, Maybe Text)]
-> [(Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Maybe Text)]
prevCaps)) NetworkState
cs)
      where
        prevCaps :: [(Text, Maybe Text)]
prevCaps = Getting [(Text, Maybe Text)] NetworkState [(Text, Maybe Text)]
-> NetworkState -> [(Text, Maybe Text)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Transaction -> Const [(Text, Maybe Text)] Transaction)
-> NetworkState -> Const [(Text, Maybe Text)] NetworkState
Lens' NetworkState Transaction
csTransaction ((Transaction -> Const [(Text, Maybe Text)] Transaction)
 -> NetworkState -> Const [(Text, Maybe Text)] NetworkState)
-> (([(Text, Maybe Text)]
     -> Const [(Text, Maybe Text)] [(Text, Maybe Text)])
    -> Transaction -> Const [(Text, Maybe Text)] Transaction)
-> Getting [(Text, Maybe Text)] NetworkState [(Text, Maybe Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, Maybe Text)]
 -> Const [(Text, Maybe Text)] [(Text, Maybe Text)])
-> Transaction -> Const [(Text, Maybe Text)] Transaction
Prism' Transaction [(Text, Maybe Text)]
_CapLsTransaction) NetworkState
cs

    CapLs CapMore
CapDone [(Text, Maybe Text)]
caps
      | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
reqCaps -> [RawIrcMsg] -> NetworkState -> Apply
reply [RawIrcMsg
ircCapEnd] NetworkState
cs'
      | Bool
otherwise    -> [RawIrcMsg] -> NetworkState -> Apply
reply [[Text] -> RawIrcMsg
ircCapReq [Text]
reqCaps] NetworkState
cs'
      where
        reqCaps :: [Text]
reqCaps = NetworkState -> [(Text, Maybe Text)] -> [Text]
selectCaps NetworkState
cs ([(Text, Maybe Text)]
caps [(Text, Maybe Text)]
-> [(Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. [a] -> [a] -> [a]
++ Getting [(Text, Maybe Text)] NetworkState [(Text, Maybe Text)]
-> NetworkState -> [(Text, Maybe Text)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Transaction -> Const [(Text, Maybe Text)] Transaction)
-> NetworkState -> Const [(Text, Maybe Text)] NetworkState
Lens' NetworkState Transaction
csTransaction ((Transaction -> Const [(Text, Maybe Text)] Transaction)
 -> NetworkState -> Const [(Text, Maybe Text)] NetworkState)
-> (([(Text, Maybe Text)]
     -> Const [(Text, Maybe Text)] [(Text, Maybe Text)])
    -> Transaction -> Const [(Text, Maybe Text)] Transaction)
-> Getting [(Text, Maybe Text)] NetworkState [(Text, Maybe Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, Maybe Text)]
 -> Const [(Text, Maybe Text)] [(Text, Maybe Text)])
-> Transaction -> Const [(Text, Maybe Text)] Transaction
Prism' Transaction [(Text, Maybe Text)]
_CapLsTransaction) NetworkState
cs)
        cs' :: NetworkState
cs' = ASetter NetworkState NetworkState Transaction Transaction
-> Transaction -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState Transaction Transaction
Lens' NetworkState Transaction
csTransaction Transaction
NoTransaction NetworkState
cs

    CapNew [(Text, Maybe Text)]
caps
      | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
reqCaps -> NetworkState -> Apply
noReply NetworkState
cs
      | Bool
otherwise    -> [RawIrcMsg] -> NetworkState -> Apply
reply [[Text] -> RawIrcMsg
ircCapReq [Text]
reqCaps] NetworkState
cs
      where
        reqCaps :: [Text]
reqCaps = NetworkState -> [(Text, Maybe Text)] -> [Text]
selectCaps NetworkState
cs [(Text, Maybe Text)]
caps

    CapDel [Text]
_ -> NetworkState -> Apply
noReply NetworkState
cs

    CapAck [Text]
caps
      | let ss :: ServerSettings
ss = Getting ServerSettings NetworkState ServerSettings
-> NetworkState -> ServerSettings
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ServerSettings NetworkState ServerSettings
Lens' NetworkState ServerSettings
csSettings NetworkState
cs
      , Text
"sasl" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
caps
      , Just SaslMechanism
mech <- Getting (Maybe SaslMechanism) ServerSettings (Maybe SaslMechanism)
-> ServerSettings -> Maybe SaslMechanism
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe SaslMechanism) ServerSettings (Maybe SaslMechanism)
Lens' ServerSettings (Maybe SaslMechanism)
ssSaslMechanism ServerSettings
ss ->
        case SaslMechanism
mech of
          SaslEcdsa{} ->
            [RawIrcMsg] -> NetworkState -> Apply
reply [Text -> RawIrcMsg
ircAuthenticate Text
Ecdsa.authenticationMode]
                  (ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
-> AuthenticateState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState AuthenticateState
AS_EcdsaStarted NetworkState
cs)
          SaslPlain{} ->
            [RawIrcMsg] -> NetworkState -> Apply
reply [Text -> RawIrcMsg
ircAuthenticate Text
"PLAIN"]
                  (ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
-> AuthenticateState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState AuthenticateState
AS_PlainStarted NetworkState
cs)
          SaslExternal{} ->
            [RawIrcMsg] -> NetworkState -> Apply
reply [Text -> RawIrcMsg
ircAuthenticate Text
"EXTERNAL"]
                  (ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
-> AuthenticateState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState AuthenticateState
AS_ExternalStarted NetworkState
cs)
          SaslScram ScramDigest
digest Maybe Text
_ Text
_ Secret
_ ->
            [RawIrcMsg] -> NetworkState -> Apply
reply [Text -> RawIrcMsg
ircAuthenticate (ScramDigest -> Text
Scram.mechanismName ScramDigest
digest)]
                  (ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
-> AuthenticateState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState AuthenticateState
AS_ScramStarted NetworkState
cs)
          SaslEcdh{} ->
            [RawIrcMsg] -> NetworkState -> Apply
reply [Text -> RawIrcMsg
ircAuthenticate Text
Ecdh.mechanismName]
                  (ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
-> AuthenticateState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState NetworkState AuthenticateState AuthenticateState
Lens' NetworkState AuthenticateState
csAuthenticationState AuthenticateState
AS_EcdhStarted NetworkState
cs)

    CapCmd
_ -> [RawIrcMsg] -> NetworkState -> Apply
reply [RawIrcMsg
ircCapEnd] NetworkState
cs

initialMessages :: NetworkState -> [RawIrcMsg]
initialMessages :: NetworkState -> [RawIrcMsg]
initialMessages NetworkState
cs
   = [ RawIrcMsg
ircCapLs ]
  [RawIrcMsg] -> [RawIrcMsg] -> [RawIrcMsg]
forall a. [a] -> [a] -> [a]
++ [ Text -> RawIrcMsg
ircPass Text
pass | Just (SecretText Text
pass) <- [Getting (Maybe Secret) ServerSettings (Maybe Secret)
-> ServerSettings -> Maybe Secret
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Secret) ServerSettings (Maybe Secret)
Lens' ServerSettings (Maybe Secret)
ssPassword ServerSettings
ss]]
  [RawIrcMsg] -> [RawIrcMsg] -> [RawIrcMsg]
forall a. [a] -> [a] -> [a]
++ [ Text -> RawIrcMsg
ircNick (LensLike' (Const Text) ServerSettings (NonEmpty Text)
-> (NonEmpty Text -> Text) -> ServerSettings -> Text
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const Text) ServerSettings (NonEmpty Text)
Lens' ServerSettings (NonEmpty Text)
ssNicks NonEmpty Text -> Text
forall a. NonEmpty a -> a
NonEmpty.head ServerSettings
ss)
     , Text -> Text -> RawIrcMsg
ircUser (Getting Text ServerSettings Text -> ServerSettings -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text ServerSettings Text
Lens' ServerSettings Text
ssUser ServerSettings
ss) (Getting Text ServerSettings Text -> ServerSettings -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text ServerSettings Text
Lens' ServerSettings Text
ssReal ServerSettings
ss)
     ]
  where
    ss :: ServerSettings
ss = Getting ServerSettings NetworkState ServerSettings
-> NetworkState -> ServerSettings
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ServerSettings NetworkState ServerSettings
Lens' NetworkState ServerSettings
csSettings NetworkState
cs

loadNamesList :: Identifier -> NetworkState -> NetworkState
loadNamesList :: Identifier -> NetworkState -> NetworkState
loadNamesList Identifier
chan NetworkState
cs
  = ASetter NetworkState NetworkState Transaction Transaction
-> Transaction -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState Transaction Transaction
Lens' NetworkState Transaction
csTransaction Transaction
NoTransaction
  (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ (NetworkState -> [UserInfo] -> NetworkState)
-> [UserInfo] -> NetworkState -> NetworkState
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((NetworkState -> UserInfo -> NetworkState)
-> NetworkState -> [UserInfo] -> NetworkState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((UserInfo -> NetworkState -> NetworkState)
-> NetworkState -> UserInfo -> NetworkState
forall a b c. (a -> b -> c) -> b -> a -> c
flip UserInfo -> NetworkState -> NetworkState
learnUserInfo)) ((UserInfo, [Char]) -> UserInfo
forall a b. (a, b) -> a
fst ((UserInfo, [Char]) -> UserInfo)
-> [(UserInfo, [Char])] -> [UserInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UserInfo, [Char])]
entries)
  (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ ASetter
  NetworkState
  NetworkState
  (HashMap Identifier [Char])
  (HashMap Identifier [Char])
-> HashMap Identifier [Char] -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
setStrict (ASetter
  NetworkState
  NetworkState
  (HashMap Identifier ChannelState)
  (HashMap Identifier ChannelState)
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ASetter
  NetworkState
  NetworkState
  (HashMap Identifier ChannelState)
  (HashMap Identifier ChannelState)
-> ((HashMap Identifier [Char]
     -> Identity (HashMap Identifier [Char]))
    -> HashMap Identifier ChannelState
    -> Identity (HashMap Identifier ChannelState))
-> ASetter
     NetworkState
     NetworkState
     (HashMap Identifier [Char])
     (HashMap Identifier [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier ChannelState)
chan ((ChannelState -> Identity ChannelState)
 -> HashMap Identifier ChannelState
 -> Identity (HashMap Identifier ChannelState))
-> ((HashMap Identifier [Char]
     -> Identity (HashMap Identifier [Char]))
    -> ChannelState -> Identity ChannelState)
-> (HashMap Identifier [Char]
    -> Identity (HashMap Identifier [Char]))
-> HashMap Identifier ChannelState
-> Identity (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier [Char] -> Identity (HashMap Identifier [Char]))
-> ChannelState -> Identity ChannelState
Lens' ChannelState (HashMap Identifier [Char])
chanUsers) HashMap Identifier [Char]
newChanUsers
  (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ NetworkState
cs
  where
    newChanUsers :: HashMap Identifier [Char]
newChanUsers = [(Identifier, [Char])] -> HashMap Identifier [Char]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [ (Getting Identifier UserInfo Identifier -> UserInfo -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier UserInfo Identifier
forall (f :: * -> *).
Functor f =>
(Identifier -> f Identifier) -> UserInfo -> f UserInfo
uiNick UserInfo
ui, [Char]
modes) | (UserInfo
ui, [Char]
modes) <- [(UserInfo, [Char])]
entries ]

    -- userhost-in-names might or might not include the user and host
    -- if we find it we update the user information.
    learnUserInfo :: UserInfo -> NetworkState -> NetworkState
learnUserInfo (UserInfo Identifier
n Text
u Text
h)
      | Text -> Bool
Text.null Text
u Bool -> Bool -> Bool
|| Text -> Bool
Text.null Text
h = NetworkState -> NetworkState
forall a. a -> a
id
      | Bool
otherwise = Identifier -> Text -> Text -> NetworkState -> NetworkState
updateUserInfo Identifier
n Text
u Text
h

    sigils :: [Char]
sigils = Getting (Endo [Char]) NetworkState Char -> NetworkState -> [Char]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((ModeTypes -> Const (Endo [Char]) ModeTypes)
-> NetworkState -> Const (Endo [Char]) NetworkState
Lens' NetworkState ModeTypes
csModeTypes ((ModeTypes -> Const (Endo [Char]) ModeTypes)
 -> NetworkState -> Const (Endo [Char]) NetworkState)
-> ((Char -> Const (Endo [Char]) Char)
    -> ModeTypes -> Const (Endo [Char]) ModeTypes)
-> Getting (Endo [Char]) NetworkState Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Char, Char)] -> Const (Endo [Char]) [(Char, Char)])
-> ModeTypes -> Const (Endo [Char]) ModeTypes
forall (f :: * -> *).
Functor f =>
([(Char, Char)] -> f [(Char, Char)]) -> ModeTypes -> f ModeTypes
modesPrefixModes (([(Char, Char)] -> Const (Endo [Char]) [(Char, Char)])
 -> ModeTypes -> Const (Endo [Char]) ModeTypes)
-> ((Char -> Const (Endo [Char]) Char)
    -> [(Char, Char)] -> Const (Endo [Char]) [(Char, Char)])
-> (Char -> Const (Endo [Char]) Char)
-> ModeTypes
-> Const (Endo [Char]) ModeTypes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, Char) -> Const (Endo [Char]) (Char, Char))
-> [(Char, Char)] -> Const (Endo [Char]) [(Char, Char)]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded (((Char, Char) -> Const (Endo [Char]) (Char, Char))
 -> [(Char, Char)] -> Const (Endo [Char]) [(Char, Char)])
-> ((Char -> Const (Endo [Char]) Char)
    -> (Char, Char) -> Const (Endo [Char]) (Char, Char))
-> (Char -> Const (Endo [Char]) Char)
-> [(Char, Char)]
-> Const (Endo [Char]) [(Char, Char)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Const (Endo [Char]) Char)
-> (Char, Char) -> Const (Endo [Char]) (Char, Char)
forall s t a b. Field2 s t a b => Lens s t a b
_2) NetworkState
cs

    splitEntry :: [Char] -> Text -> (UserInfo, [Char])
splitEntry [Char]
modes Text
str
      | Text -> Char
Text.head Text
str Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
sigils = [Char] -> Text -> (UserInfo, [Char])
splitEntry (Text -> Char
Text.head Text
str Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
modes)
                                                 (Text -> Text
Text.tail Text
str)
      | Bool
otherwise = (Text -> UserInfo
parseUserInfo Text
str, ShowS
forall a. [a] -> [a]
reverse [Char]
modes)

    entries :: [(UserInfo, [Char])]
    entries :: [(UserInfo, [Char])]
entries = (Text -> (UserInfo, [Char])) -> [Text] -> [(UserInfo, [Char])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> Text -> (UserInfo, [Char])
splitEntry [Char]
"")
            ([Text] -> [(UserInfo, [Char])]) -> [Text] -> [(UserInfo, [Char])]
forall a b. (a -> b) -> a -> b
$ (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
Text.words
            ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Getting [Text] NetworkState [Text] -> NetworkState -> [Text]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Transaction -> Const [Text] Transaction)
-> NetworkState -> Const [Text] NetworkState
Lens' NetworkState Transaction
csTransaction ((Transaction -> Const [Text] Transaction)
 -> NetworkState -> Const [Text] NetworkState)
-> Getting [Text] Transaction [Text]
-> Getting [Text] NetworkState [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [Text] Transaction [Text]
Prism' Transaction [Text]
_NamesTransaction) NetworkState
cs


createOnJoin :: UserInfo -> Identifier -> NetworkState -> NetworkState
createOnJoin :: UserInfo -> Identifier -> NetworkState -> NetworkState
createOnJoin UserInfo
who Identifier
chan NetworkState
cs
  | UserInfo -> Identifier
userNick UserInfo
who Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Getting Identifier NetworkState Identifier
-> NetworkState -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier NetworkState Identifier
Lens' NetworkState Identifier
csNick NetworkState
cs =
        ((UserInfo -> Identity UserInfo)
 -> NetworkState -> Identity NetworkState)
-> UserInfo -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set (UserInfo -> Identity UserInfo)
-> NetworkState -> Identity NetworkState
Lens' NetworkState UserInfo
csUserInfo UserInfo
who -- great time to learn our userinfo
      (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ ASetter
  NetworkState NetworkState (Maybe ChannelState) (Maybe ChannelState)
-> Maybe ChannelState -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set (ASetter
  NetworkState
  NetworkState
  (HashMap Identifier ChannelState)
  (HashMap Identifier ChannelState)
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ASetter
  NetworkState
  NetworkState
  (HashMap Identifier ChannelState)
  (HashMap Identifier ChannelState)
-> ((Maybe ChannelState -> Identity (Maybe ChannelState))
    -> HashMap Identifier ChannelState
    -> Identity (HashMap Identifier ChannelState))
-> ASetter
     NetworkState NetworkState (Maybe ChannelState) (Maybe ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Lens'
     (HashMap Identifier ChannelState)
     (Maybe (IxValue (HashMap Identifier ChannelState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Identifier
Index (HashMap Identifier ChannelState)
chan) (ChannelState -> Maybe ChannelState
forall a. a -> Maybe a
Just ChannelState
newChannel) NetworkState
cs
  | Bool
otherwise = NetworkState
cs

updateMyNick :: Identifier -> Identifier -> NetworkState -> NetworkState
updateMyNick :: Identifier -> Identifier -> NetworkState -> NetworkState
updateMyNick Identifier
oldNick Identifier
newNick NetworkState
cs
  | Identifier
oldNick Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Getting Identifier NetworkState Identifier
-> NetworkState -> Identifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Identifier NetworkState Identifier
Lens' NetworkState Identifier
csNick NetworkState
cs = ASetter NetworkState NetworkState Identifier Identifier
-> Identifier -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState Identifier Identifier
Lens' NetworkState Identifier
csNick Identifier
newNick NetworkState
cs
  | Bool
otherwise = NetworkState
cs

myinfo ::
  [Text] ->
  NetworkState ->
  NetworkState
myinfo :: [Text] -> NetworkState -> NetworkState
myinfo (Text
_me : Text
_host : Text
_version : Text
umodes : [Text]
_) =
  -- special logic for s because I know it has arguments
  ASetter NetworkState NetworkState [Char] [Char]
-> [Char] -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ((ModeTypes -> Identity ModeTypes)
-> NetworkState -> Identity NetworkState
Lens' NetworkState ModeTypes
csUmodeTypes ((ModeTypes -> Identity ModeTypes)
 -> NetworkState -> Identity NetworkState)
-> (([Char] -> Identity [Char]) -> ModeTypes -> Identity ModeTypes)
-> ASetter NetworkState NetworkState [Char] [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Identity [Char]) -> ModeTypes -> Identity ModeTypes
forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesNeverArg) (Char -> ShowS
forall a. Eq a => a -> [a] -> [a]
delete Char
's' (Text -> [Char]
Text.unpack Text
umodes))
myinfo [Text]
_ = NetworkState -> NetworkState
forall a. a -> a
id

-- ISUPPORT is defined by
-- https://tools.ietf.org/html/draft-brocklesby-irc-isupport-03#section-3.14
isupport ::
  [Text] {- ^ ["key=value"] -} ->
  NetworkState ->
  NetworkState
isupport :: [Text] -> NetworkState -> NetworkState
isupport []     NetworkState
conn = NetworkState
conn
isupport [Text]
params NetworkState
conn = (NetworkState -> (Text, Text) -> NetworkState)
-> NetworkState -> [(Text, Text)] -> NetworkState
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((Text, Text) -> NetworkState -> NetworkState)
-> NetworkState -> (Text, Text) -> NetworkState
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text, Text) -> NetworkState -> NetworkState
forall a.
(Eq a, IsString a) =>
(a, Text) -> NetworkState -> NetworkState
isupport1) NetworkState
conn
                     ([(Text, Text)] -> NetworkState) -> [(Text, Text)] -> NetworkState
forall a b. (a -> b) -> a -> b
$ (Text -> (Text, Text)) -> [Text] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map Text -> (Text, Text)
parseISupport
                     ([Text] -> [(Text, Text)]) -> [Text] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
init [Text]
params
  where
    isupport1 :: (a, Text) -> NetworkState -> NetworkState
isupport1 (a
"CHANTYPES",Text
types) = ASetter NetworkState NetworkState [Char] [Char]
-> [Char] -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState [Char] [Char]
Lens' NetworkState [Char]
csChannelTypes (Text -> [Char]
Text.unpack Text
types)
    isupport1 (a
"CHANMODES",Text
modes) = Text -> NetworkState -> NetworkState
updateChanModes Text
modes
    isupport1 (a
"PREFIX"   ,Text
modes) = Text -> NetworkState -> NetworkState
updateChanPrefix Text
modes
    isupport1 (a
"STATUSMSG",Text
prefix) = ASetter NetworkState NetworkState [Char] [Char]
-> [Char] -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState [Char] [Char]
Lens' NetworkState [Char]
csStatusMsg (Text -> [Char]
Text.unpack Text
prefix)
    isupport1 (a
"MODES",Text
nstr) | Right (Int
n,Text
"") <- Reader Int
forall a. Integral a => Reader a
Text.decimal Text
nstr =
                        ASetter NetworkState NetworkState Int Int
-> Int -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState Int Int
Lens' NetworkState Int
csModeCount Int
n
    isupport1 (a, Text)
_                   = NetworkState -> NetworkState
forall a. a -> a
id

parseISupport :: Text -> (Text,Text)
parseISupport :: Text -> (Text, Text)
parseISupport Text
str =
  case (Char -> Bool) -> Text -> (Text, Text)
Text.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'=') Text
str of
    (Text
key,Text
val) -> (Text
key, Int -> Text -> Text
Text.drop Int
1 Text
val)

updateChanModes ::
  Text {- lists,always,set,never -} ->
  NetworkState ->
  NetworkState
updateChanModes :: Text -> NetworkState -> NetworkState
updateChanModes Text
modes
  = ((ModeTypes -> Identity ModeTypes)
 -> NetworkState -> Identity NetworkState)
-> (ModeTypes -> ModeTypes) -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (ModeTypes -> Identity ModeTypes)
-> NetworkState -> Identity NetworkState
Lens' NetworkState ModeTypes
csModeTypes
  ((ModeTypes -> ModeTypes) -> NetworkState -> NetworkState)
-> (ModeTypes -> ModeTypes) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ (([Char] -> Identity [Char]) -> ModeTypes -> Identity ModeTypes)
-> [Char] -> ModeTypes -> ModeTypes
forall s t a b. ASetter s t a b -> b -> s -> t
set ([Char] -> Identity [Char]) -> ModeTypes -> Identity ModeTypes
forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesLists [Char]
listModes
  (ModeTypes -> ModeTypes)
-> (ModeTypes -> ModeTypes) -> ModeTypes -> ModeTypes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char] -> Identity [Char]) -> ModeTypes -> Identity ModeTypes)
-> [Char] -> ModeTypes -> ModeTypes
forall s t a b. ASetter s t a b -> b -> s -> t
set ([Char] -> Identity [Char]) -> ModeTypes -> Identity ModeTypes
forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesAlwaysArg [Char]
alwaysModes
  (ModeTypes -> ModeTypes)
-> (ModeTypes -> ModeTypes) -> ModeTypes -> ModeTypes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char] -> Identity [Char]) -> ModeTypes -> Identity ModeTypes)
-> [Char] -> ModeTypes -> ModeTypes
forall s t a b. ASetter s t a b -> b -> s -> t
set ([Char] -> Identity [Char]) -> ModeTypes -> Identity ModeTypes
forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesSetArg [Char]
setModes
  (ModeTypes -> ModeTypes)
-> (ModeTypes -> ModeTypes) -> ModeTypes -> ModeTypes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char] -> Identity [Char]) -> ModeTypes -> Identity ModeTypes)
-> [Char] -> ModeTypes -> ModeTypes
forall s t a b. ASetter s t a b -> b -> s -> t
set ([Char] -> Identity [Char]) -> ModeTypes -> Identity ModeTypes
forall (f :: * -> *).
Functor f =>
([Char] -> f [Char]) -> ModeTypes -> f ModeTypes
modesNeverArg [Char]
neverModes
  -- Note: doesn't set modesPrefixModes
  where
  next :: [Char] -> ([Char], [Char])
next = ASetter ([Char], [Char]) ([Char], [Char]) [Char] [Char]
-> ShowS -> ([Char], [Char]) -> ([Char], [Char])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ([Char], [Char]) ([Char], [Char]) [Char] [Char]
forall s t a b. Field2 s t a b => Lens s t a b
_2 (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1) (([Char], [Char]) -> ([Char], [Char]))
-> ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',')
  ([Char]
listModes  ,[Char]
modes1) = [Char] -> ([Char], [Char])
next (Text -> [Char]
Text.unpack Text
modes)
  ([Char]
alwaysModes,[Char]
modes2) = [Char] -> ([Char], [Char])
next [Char]
modes1
  ([Char]
setModes   ,[Char]
modes3) = [Char] -> ([Char], [Char])
next [Char]
modes2
  ([Char]
neverModes ,[Char]
_)      = [Char] -> ([Char], [Char])
next [Char]
modes3

updateChanPrefix ::
  Text {- e.g. "(ov)@+" -} ->
  NetworkState ->
  NetworkState
updateChanPrefix :: Text -> NetworkState -> NetworkState
updateChanPrefix Text
txt =
  case Text -> Maybe [(Char, Char)]
parsePrefixes Text
txt of
    Just [(Char, Char)]
prefixes -> ASetter NetworkState NetworkState [(Char, Char)] [(Char, Char)]
-> [(Char, Char)] -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ((ModeTypes -> Identity ModeTypes)
-> NetworkState -> Identity NetworkState
Lens' NetworkState ModeTypes
csModeTypes ((ModeTypes -> Identity ModeTypes)
 -> NetworkState -> Identity NetworkState)
-> (([(Char, Char)] -> Identity [(Char, Char)])
    -> ModeTypes -> Identity ModeTypes)
-> ASetter NetworkState NetworkState [(Char, Char)] [(Char, Char)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Char, Char)] -> Identity [(Char, Char)])
-> ModeTypes -> Identity ModeTypes
forall (f :: * -> *).
Functor f =>
([(Char, Char)] -> f [(Char, Char)]) -> ModeTypes -> f ModeTypes
modesPrefixModes) [(Char, Char)]
prefixes
    Maybe [(Char, Char)]
Nothing       -> NetworkState -> NetworkState
forall a. a -> a
id

parsePrefixes :: Text -> Maybe [(Char,Char)]
parsePrefixes :: Text -> Maybe [(Char, Char)]
parsePrefixes Text
txt =
  case (Text -> Text -> [(Char, Char)]) -> (Text, Text) -> [(Char, Char)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> [(Char, Char)]
Text.zip ((Char -> Bool) -> Text -> (Text, Text)
Text.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
')') Text
txt) of
    (Char
'(',Char
')'):[(Char, Char)]
rest -> [(Char, Char)] -> Maybe [(Char, Char)]
forall a. a -> Maybe a
Just [(Char, Char)]
rest
    [(Char, Char)]
_              -> Maybe [(Char, Char)]
forall a. Maybe a
Nothing

isChannelIdentifier :: NetworkState -> Identifier -> Bool
isChannelIdentifier :: NetworkState -> Identifier -> Bool
isChannelIdentifier NetworkState
cs Identifier
ident =
  case Text -> Maybe (Char, Text)
Text.uncons (Identifier -> Text
idText Identifier
ident) of
    Just (Char
p, Text
_) -> Char
p Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Getting [Char] NetworkState [Char] -> NetworkState -> [Char]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Char] NetworkState [Char]
Lens' NetworkState [Char]
csChannelTypes NetworkState
cs
    Maybe (Char, Text)
_           -> Bool
False

------------------------------------------------------------------------
-- Helpers for managing the user list
------------------------------------------------------------------------

csUser :: Functor f => Identifier -> LensLike' f NetworkState (Maybe UserAndHost)
csUser :: Identifier -> LensLike' f NetworkState (Maybe UserAndHost)
csUser Identifier
i = (HashMap Identifier UserAndHost
 -> f (HashMap Identifier UserAndHost))
-> NetworkState -> f NetworkState
Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers ((HashMap Identifier UserAndHost
  -> f (HashMap Identifier UserAndHost))
 -> NetworkState -> f NetworkState)
-> ((Maybe UserAndHost -> f (Maybe UserAndHost))
    -> HashMap Identifier UserAndHost
    -> f (HashMap Identifier UserAndHost))
-> LensLike' f NetworkState (Maybe UserAndHost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier UserAndHost)
-> Lens'
     (HashMap Identifier UserAndHost)
     (Maybe (IxValue (HashMap Identifier UserAndHost)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Identifier
Index (HashMap Identifier UserAndHost)
i

recordUser :: UserInfo -> Text -> NetworkState -> NetworkState
recordUser :: UserInfo -> Text -> NetworkState -> NetworkState
recordUser (UserInfo Identifier
nick Text
user Text
host) Text
acct
  | Text -> Bool
Text.null Text
user Bool -> Bool -> Bool
|| Text -> Bool
Text.null Text
host = NetworkState -> NetworkState
forall a. a -> a
id
  | Bool
otherwise = ASetter
  NetworkState NetworkState (Maybe UserAndHost) (Maybe UserAndHost)
-> Maybe UserAndHost -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set (ASetter
  NetworkState
  NetworkState
  (HashMap Identifier UserAndHost)
  (HashMap Identifier UserAndHost)
Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers ASetter
  NetworkState
  NetworkState
  (HashMap Identifier UserAndHost)
  (HashMap Identifier UserAndHost)
-> ((Maybe UserAndHost -> Identity (Maybe UserAndHost))
    -> HashMap Identifier UserAndHost
    -> Identity (HashMap Identifier UserAndHost))
-> ASetter
     NetworkState NetworkState (Maybe UserAndHost) (Maybe UserAndHost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier UserAndHost)
-> Lens'
     (HashMap Identifier UserAndHost)
     (Maybe (IxValue (HashMap Identifier UserAndHost)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Identifier
Index (HashMap Identifier UserAndHost)
nick)
                    (UserAndHost -> Maybe UserAndHost
forall a. a -> Maybe a
Just (UserAndHost -> Maybe UserAndHost)
-> UserAndHost -> Maybe UserAndHost
forall a b. (a -> b) -> a -> b
$! Text -> Text -> Text -> UserAndHost
UserAndHost Text
user Text
host Text
acct)

-- | Process a CHGHOST command, updating a users information
updateUserInfo ::
  Identifier {- ^ nickname     -} ->
  Text       {- ^ new username -} ->
  Text       {- ^ new hostname -} ->
  NetworkState -> NetworkState
updateUserInfo :: Identifier -> Text -> Text -> NetworkState -> NetworkState
updateUserInfo Identifier
nick Text
user Text
host =
  ASetter
  NetworkState NetworkState (Maybe UserAndHost) (Maybe UserAndHost)
-> (Maybe UserAndHost -> Maybe UserAndHost)
-> NetworkState
-> NetworkState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (ASetter
  NetworkState
  NetworkState
  (HashMap Identifier UserAndHost)
  (HashMap Identifier UserAndHost)
Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers ASetter
  NetworkState
  NetworkState
  (HashMap Identifier UserAndHost)
  (HashMap Identifier UserAndHost)
-> ((Maybe UserAndHost -> Identity (Maybe UserAndHost))
    -> HashMap Identifier UserAndHost
    -> Identity (HashMap Identifier UserAndHost))
-> ASetter
     NetworkState NetworkState (Maybe UserAndHost) (Maybe UserAndHost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier UserAndHost)
-> Lens'
     (HashMap Identifier UserAndHost)
     (Maybe (IxValue (HashMap Identifier UserAndHost)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Identifier
Index (HashMap Identifier UserAndHost)
nick) ((Maybe UserAndHost -> Maybe UserAndHost)
 -> NetworkState -> NetworkState)
-> (Maybe UserAndHost -> Maybe UserAndHost)
-> NetworkState
-> NetworkState
forall a b. (a -> b) -> a -> b
$ \Maybe UserAndHost
old ->
    UserAndHost -> Maybe UserAndHost
forall a. a -> Maybe a
Just (UserAndHost -> Maybe UserAndHost)
-> UserAndHost -> Maybe UserAndHost
forall a b. (a -> b) -> a -> b
$! Text -> Text -> Text -> UserAndHost
UserAndHost Text
user Text
host (Text -> (UserAndHost -> Text) -> Maybe UserAndHost -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" UserAndHost -> Text
_uhAccount Maybe UserAndHost
old)

forgetUser :: Identifier -> NetworkState -> NetworkState
forgetUser :: Identifier -> NetworkState -> NetworkState
forgetUser = ASetter
  NetworkState
  NetworkState
  (HashMap Identifier UserAndHost)
  (HashMap Identifier UserAndHost)
-> (HashMap Identifier UserAndHost
    -> HashMap Identifier UserAndHost)
-> NetworkState
-> NetworkState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  NetworkState
  NetworkState
  (HashMap Identifier UserAndHost)
  (HashMap Identifier UserAndHost)
Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers ((HashMap Identifier UserAndHost -> HashMap Identifier UserAndHost)
 -> NetworkState -> NetworkState)
-> (Identifier
    -> HashMap Identifier UserAndHost
    -> HashMap Identifier UserAndHost)
-> Identifier
-> NetworkState
-> NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier
-> HashMap Identifier UserAndHost -> HashMap Identifier UserAndHost
forall m. At m => Index m -> m -> m
sans

renameUser :: Identifier -> Identifier -> NetworkState -> NetworkState
renameUser :: Identifier -> Identifier -> NetworkState -> NetworkState
renameUser Identifier
old Identifier
new NetworkState
cs = ASetter
  NetworkState NetworkState (Maybe UserAndHost) (Maybe UserAndHost)
-> Maybe UserAndHost -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set (ASetter
  NetworkState
  NetworkState
  (HashMap Identifier UserAndHost)
  (HashMap Identifier UserAndHost)
Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers ASetter
  NetworkState
  NetworkState
  (HashMap Identifier UserAndHost)
  (HashMap Identifier UserAndHost)
-> ((Maybe UserAndHost -> Identity (Maybe UserAndHost))
    -> HashMap Identifier UserAndHost
    -> Identity (HashMap Identifier UserAndHost))
-> ASetter
     NetworkState NetworkState (Maybe UserAndHost) (Maybe UserAndHost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier UserAndHost)
-> Lens'
     (HashMap Identifier UserAndHost)
     (Maybe (IxValue (HashMap Identifier UserAndHost)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Identifier
Index (HashMap Identifier UserAndHost)
new) Maybe UserAndHost
entry NetworkState
cs'
  where
    (Maybe UserAndHost
entry,NetworkState
cs') = NetworkState
cs NetworkState
-> (NetworkState -> (Maybe UserAndHost, NetworkState))
-> (Maybe UserAndHost, NetworkState)
forall a b. a -> (a -> b) -> b
& (HashMap Identifier UserAndHost
 -> (Maybe UserAndHost, HashMap Identifier UserAndHost))
-> NetworkState -> (Maybe UserAndHost, NetworkState)
Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers ((HashMap Identifier UserAndHost
  -> (Maybe UserAndHost, HashMap Identifier UserAndHost))
 -> NetworkState -> (Maybe UserAndHost, NetworkState))
-> ((Maybe UserAndHost -> (Maybe UserAndHost, Maybe UserAndHost))
    -> HashMap Identifier UserAndHost
    -> (Maybe UserAndHost, HashMap Identifier UserAndHost))
-> (Maybe UserAndHost -> (Maybe UserAndHost, Maybe UserAndHost))
-> NetworkState
-> (Maybe UserAndHost, NetworkState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier UserAndHost)
-> Lens'
     (HashMap Identifier UserAndHost)
     (Maybe (IxValue (HashMap Identifier UserAndHost)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Identifier
Index (HashMap Identifier UserAndHost)
old ((Maybe UserAndHost -> (Maybe UserAndHost, Maybe UserAndHost))
 -> NetworkState -> (Maybe UserAndHost, NetworkState))
-> Maybe UserAndHost
-> NetworkState
-> (Maybe UserAndHost, NetworkState)
forall a s t b. LensLike ((,) a) s t a b -> b -> s -> (a, t)
<<.~ Maybe UserAndHost
forall a. Maybe a
Nothing

forgetUser' :: Identifier -> NetworkState -> NetworkState
forgetUser' :: Identifier -> NetworkState -> NetworkState
forgetUser' Identifier
nick NetworkState
cs
  | Bool
keep      = NetworkState
cs
  | Bool
otherwise = Identifier -> NetworkState -> NetworkState
forgetUser Identifier
nick NetworkState
cs
  where
    keep :: Bool
keep = Getting Any NetworkState [Char] -> NetworkState -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((HashMap Identifier ChannelState
 -> Const Any (HashMap Identifier ChannelState))
-> NetworkState -> Const Any NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const Any (HashMap Identifier ChannelState))
 -> NetworkState -> Const Any NetworkState)
-> (([Char] -> Const Any [Char])
    -> HashMap Identifier ChannelState
    -> Const Any (HashMap Identifier ChannelState))
-> Getting Any NetworkState [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChannelState -> Const Any ChannelState)
-> HashMap Identifier ChannelState
-> Const Any (HashMap Identifier ChannelState)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded ((ChannelState -> Const Any ChannelState)
 -> HashMap Identifier ChannelState
 -> Const Any (HashMap Identifier ChannelState))
-> (([Char] -> Const Any [Char])
    -> ChannelState -> Const Any ChannelState)
-> ([Char] -> Const Any [Char])
-> HashMap Identifier ChannelState
-> Const Any (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier [Char]
 -> Const Any (HashMap Identifier [Char]))
-> ChannelState -> Const Any ChannelState
Lens' ChannelState (HashMap Identifier [Char])
chanUsers ((HashMap Identifier [Char]
  -> Const Any (HashMap Identifier [Char]))
 -> ChannelState -> Const Any ChannelState)
-> (([Char] -> Const Any [Char])
    -> HashMap Identifier [Char]
    -> Const Any (HashMap Identifier [Char]))
-> ([Char] -> Const Any [Char])
-> ChannelState
-> Const Any ChannelState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier [Char])
-> Traversal'
     (HashMap Identifier [Char]) (IxValue (HashMap Identifier [Char]))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier [Char])
nick) NetworkState
cs

-- | Process a list of WHO replies
massRegistration :: NetworkState -> NetworkState
massRegistration :: NetworkState -> NetworkState
massRegistration NetworkState
cs
  = ASetter NetworkState NetworkState Transaction Transaction
-> Transaction -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState Transaction Transaction
Lens' NetworkState Transaction
csTransaction Transaction
NoTransaction
  (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ ASetter
  NetworkState
  NetworkState
  (HashMap Identifier UserAndHost)
  (HashMap Identifier UserAndHost)
-> (HashMap Identifier UserAndHost
    -> HashMap Identifier UserAndHost)
-> NetworkState
-> NetworkState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  NetworkState
  NetworkState
  (HashMap Identifier UserAndHost)
  (HashMap Identifier UserAndHost)
Lens' NetworkState (HashMap Identifier UserAndHost)
csUsers HashMap Identifier UserAndHost -> HashMap Identifier UserAndHost
updateUsers NetworkState
cs
  where
    infos :: [UserInfo]
infos = Getting [UserInfo] NetworkState [UserInfo]
-> NetworkState -> [UserInfo]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Transaction -> Const [UserInfo] Transaction)
-> NetworkState -> Const [UserInfo] NetworkState
Lens' NetworkState Transaction
csTransaction ((Transaction -> Const [UserInfo] Transaction)
 -> NetworkState -> Const [UserInfo] NetworkState)
-> Getting [UserInfo] Transaction [UserInfo]
-> Getting [UserInfo] NetworkState [UserInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [UserInfo] Transaction [UserInfo]
Prism' Transaction [UserInfo]
_WhoTransaction) NetworkState
cs

    channelUsers :: HashSet Identifier
channelUsers =
      [Identifier] -> HashSet Identifier
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList (LensLike'
  (Const [Identifier]) NetworkState (HashMap Identifier [Char])
-> (HashMap Identifier [Char] -> [Identifier])
-> NetworkState
-> [Identifier]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((HashMap Identifier ChannelState
 -> Const [Identifier] (HashMap Identifier ChannelState))
-> NetworkState -> Const [Identifier] NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const [Identifier] (HashMap Identifier ChannelState))
 -> NetworkState -> Const [Identifier] NetworkState)
-> ((HashMap Identifier [Char]
     -> Const [Identifier] (HashMap Identifier [Char]))
    -> HashMap Identifier ChannelState
    -> Const [Identifier] (HashMap Identifier ChannelState))
-> LensLike'
     (Const [Identifier]) NetworkState (HashMap Identifier [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChannelState -> Const [Identifier] ChannelState)
-> HashMap Identifier ChannelState
-> Const [Identifier] (HashMap Identifier ChannelState)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded ((ChannelState -> Const [Identifier] ChannelState)
 -> HashMap Identifier ChannelState
 -> Const [Identifier] (HashMap Identifier ChannelState))
-> ((HashMap Identifier [Char]
     -> Const [Identifier] (HashMap Identifier [Char]))
    -> ChannelState -> Const [Identifier] ChannelState)
-> (HashMap Identifier [Char]
    -> Const [Identifier] (HashMap Identifier [Char]))
-> HashMap Identifier ChannelState
-> Const [Identifier] (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier [Char]
 -> Const [Identifier] (HashMap Identifier [Char]))
-> ChannelState -> Const [Identifier] ChannelState
Lens' ChannelState (HashMap Identifier [Char])
chanUsers) HashMap Identifier [Char] -> [Identifier]
forall k v. HashMap k v -> [k]
HashMap.keys NetworkState
cs)

    updateUsers :: HashMap Identifier UserAndHost -> HashMap Identifier UserAndHost
updateUsers HashMap Identifier UserAndHost
users = (HashMap Identifier UserAndHost
 -> UserInfo -> HashMap Identifier UserAndHost)
-> HashMap Identifier UserAndHost
-> [UserInfo]
-> HashMap Identifier UserAndHost
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' HashMap Identifier UserAndHost
-> UserInfo -> HashMap Identifier UserAndHost
updateUser HashMap Identifier UserAndHost
users [UserInfo]
infos

    updateUser :: HashMap Identifier UserAndHost
-> UserInfo -> HashMap Identifier UserAndHost
updateUser HashMap Identifier UserAndHost
users (UserInfo Identifier
nick Text
user Text
host)
      | Bool -> Bool
not (Text -> Bool
Text.null Text
user)
      , Bool -> Bool
not (Text -> Bool
Text.null Text
host)
      , Identifier -> HashSet Identifier -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Identifier
nick HashSet Identifier
channelUsers =
            (Maybe UserAndHost -> Maybe UserAndHost)
-> Identifier
-> HashMap Identifier UserAndHost
-> HashMap Identifier UserAndHost
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HashMap.alter
                (\Maybe UserAndHost
mb -> case Maybe UserAndHost
mb of
                          Maybe UserAndHost
Nothing                     -> UserAndHost -> Maybe UserAndHost
forall a. a -> Maybe a
Just (UserAndHost -> Maybe UserAndHost)
-> UserAndHost -> Maybe UserAndHost
forall a b. (a -> b) -> a -> b
$! Text -> Text -> Text -> UserAndHost
UserAndHost Text
user Text
host Text
""
                          Just (UserAndHost Text
_ Text
_ Text
acct) -> UserAndHost -> Maybe UserAndHost
forall a. a -> Maybe a
Just (UserAndHost -> Maybe UserAndHost)
-> UserAndHost -> Maybe UserAndHost
forall a b. (a -> b) -> a -> b
$! Text -> Text -> Text -> UserAndHost
UserAndHost Text
user Text
host Text
acct
                ) Identifier
nick HashMap Identifier UserAndHost
users
      | Bool
otherwise = HashMap Identifier UserAndHost
users

-- | Compute the earliest timed action for a connection, if any
nextTimedAction :: NetworkState -> Maybe (UTCTime, TimedAction)
nextTimedAction :: NetworkState -> Maybe (UTCTime, TimedAction)
nextTimedAction NetworkState
ns = Getting
  (Endo (Endo (Maybe (UTCTime, TimedAction))))
  [Maybe (UTCTime, TimedAction)]
  (UTCTime, TimedAction)
-> [Maybe (UTCTime, TimedAction)] -> Maybe (UTCTime, TimedAction)
forall a s.
Ord a =>
Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a
minimumOf ((Maybe (UTCTime, TimedAction)
 -> Const
      (Endo (Endo (Maybe (UTCTime, TimedAction))))
      (Maybe (UTCTime, TimedAction)))
-> [Maybe (UTCTime, TimedAction)]
-> Const
     (Endo (Endo (Maybe (UTCTime, TimedAction))))
     [Maybe (UTCTime, TimedAction)]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded((Maybe (UTCTime, TimedAction)
  -> Const
       (Endo (Endo (Maybe (UTCTime, TimedAction))))
       (Maybe (UTCTime, TimedAction)))
 -> [Maybe (UTCTime, TimedAction)]
 -> Const
      (Endo (Endo (Maybe (UTCTime, TimedAction))))
      [Maybe (UTCTime, TimedAction)])
-> (((UTCTime, TimedAction)
     -> Const
          (Endo (Endo (Maybe (UTCTime, TimedAction))))
          (UTCTime, TimedAction))
    -> Maybe (UTCTime, TimedAction)
    -> Const
         (Endo (Endo (Maybe (UTCTime, TimedAction))))
         (Maybe (UTCTime, TimedAction)))
-> Getting
     (Endo (Endo (Maybe (UTCTime, TimedAction))))
     [Maybe (UTCTime, TimedAction)]
     (UTCTime, TimedAction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((UTCTime, TimedAction)
 -> Const
      (Endo (Endo (Maybe (UTCTime, TimedAction))))
      (UTCTime, TimedAction))
-> Maybe (UTCTime, TimedAction)
-> Const
     (Endo (Endo (Maybe (UTCTime, TimedAction))))
     (Maybe (UTCTime, TimedAction))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded) [Maybe (UTCTime, TimedAction)]
actions
  where
    actions :: [Maybe (UTCTime, TimedAction)]
actions = [NetworkState -> Maybe (UTCTime, TimedAction)
nextPingAction NetworkState
ns, NetworkState -> Maybe (UTCTime, TimedAction)
nextForgetAction NetworkState
ns]

-- | Compute the timed action for forgetting the ping latency.
-- The client will wait for a multiple of the current latency
-- for the next pong response in order to reduce jitter in
-- the rendered latency when everything is fine.
nextForgetAction :: NetworkState -> Maybe (UTCTime, TimedAction)
nextForgetAction :: NetworkState -> Maybe (UTCTime, TimedAction)
nextForgetAction NetworkState
ns =
  do UTCTime
sentAt  <- Getting (First UTCTime) NetworkState UTCTime
-> NetworkState -> Maybe UTCTime
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((PingStatus -> Const (First UTCTime) PingStatus)
-> NetworkState -> Const (First UTCTime) NetworkState
Lens' NetworkState PingStatus
csPingStatus ((PingStatus -> Const (First UTCTime) PingStatus)
 -> NetworkState -> Const (First UTCTime) NetworkState)
-> ((UTCTime -> Const (First UTCTime) UTCTime)
    -> PingStatus -> Const (First UTCTime) PingStatus)
-> Getting (First UTCTime) NetworkState UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime -> Const (First UTCTime) UTCTime)
-> PingStatus -> Const (First UTCTime) PingStatus
Prism' PingStatus UTCTime
_PingSent) NetworkState
ns
     NominalDiffTime
latency <- Getting
  (Maybe NominalDiffTime) NetworkState (Maybe NominalDiffTime)
-> NetworkState -> Maybe NominalDiffTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe NominalDiffTime) NetworkState (Maybe NominalDiffTime)
Lens' NetworkState (Maybe NominalDiffTime)
csLatency NetworkState
ns
     let delay :: NominalDiffTime
delay = NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
max NominalDiffTime
0.1 (NominalDiffTime
3 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
latency) -- wait at least 0.1s (ensure positive waits)
         eventAt :: UTCTime
eventAt = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
delay UTCTime
sentAt
     (UTCTime, TimedAction) -> Maybe (UTCTime, TimedAction)
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime
eventAt, TimedAction
TimedForgetLatency)

-- | Compute the next action needed for the client ping logic.
nextPingAction :: NetworkState -> Maybe (UTCTime, TimedAction)
nextPingAction :: NetworkState -> Maybe (UTCTime, TimedAction)
nextPingAction NetworkState
cs =
  do UTCTime
runAt <- Getting (Maybe UTCTime) NetworkState (Maybe UTCTime)
-> NetworkState -> Maybe UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe UTCTime) NetworkState (Maybe UTCTime)
Lens' NetworkState (Maybe UTCTime)
csNextPingTime NetworkState
cs
     (UTCTime, TimedAction) -> Maybe (UTCTime, TimedAction)
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime
runAt, TimedAction
action)
  where
    action :: TimedAction
action =
      case Getting PingStatus NetworkState PingStatus
-> NetworkState -> PingStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PingStatus NetworkState PingStatus
Lens' NetworkState PingStatus
csPingStatus NetworkState
cs of
        PingSent UTCTime
sentAt
          | UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
sentAt Maybe UTCTime -> Maybe UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< Getting (Maybe UTCTime) NetworkState (Maybe UTCTime)
-> NetworkState -> Maybe UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe UTCTime) NetworkState (Maybe UTCTime)
Lens' NetworkState (Maybe UTCTime)
csLastReceived NetworkState
cs -> TimedAction
TimedSendPing
          | Bool
otherwise -> TimedAction
TimedDisconnect
        PingStatus
PingNone         -> TimedAction
TimedSendPing
        PingConnecting{} -> TimedAction
TimedSendPing

doPong :: ZonedTime -> NetworkState -> NetworkState
doPong :: ZonedTime -> NetworkState -> NetworkState
doPong ZonedTime
when NetworkState
cs = ASetter NetworkState NetworkState PingStatus PingStatus
-> PingStatus -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState PingStatus PingStatus
Lens' NetworkState PingStatus
csPingStatus PingStatus
PingNone
               (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ ASetter
  NetworkState
  NetworkState
  (Maybe NominalDiffTime)
  (Maybe NominalDiffTime)
-> Maybe NominalDiffTime -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState
  NetworkState
  (Maybe NominalDiffTime)
  (Maybe NominalDiffTime)
Lens' NetworkState (Maybe NominalDiffTime)
csLatency (NominalDiffTime -> Maybe NominalDiffTime
forall a. a -> Maybe a
Just NominalDiffTime
delta) NetworkState
cs
  where
    delta :: NominalDiffTime
delta =
      case Getting PingStatus NetworkState PingStatus
-> NetworkState -> PingStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PingStatus NetworkState PingStatus
Lens' NetworkState PingStatus
csPingStatus NetworkState
cs of
        PingSent UTCTime
sent -> UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime (ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
when) UTCTime
sent
        PingStatus
_             -> NominalDiffTime
0

-- | Apply the given 'TimedAction' to a connection state.
applyTimedAction :: TimedAction -> NetworkState -> IO NetworkState
applyTimedAction :: TimedAction -> NetworkState -> IO NetworkState
applyTimedAction TimedAction
action NetworkState
cs =

  case TimedAction
action of
    TimedAction
TimedForgetLatency ->
      do NetworkState -> IO NetworkState
forall (m :: * -> *) a. Monad m => a -> m a
return (NetworkState -> IO NetworkState)
-> NetworkState -> IO NetworkState
forall a b. (a -> b) -> a -> b
$! ASetter
  NetworkState
  NetworkState
  (Maybe NominalDiffTime)
  (Maybe NominalDiffTime)
-> Maybe NominalDiffTime -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  NetworkState
  NetworkState
  (Maybe NominalDiffTime)
  (Maybe NominalDiffTime)
Lens' NetworkState (Maybe NominalDiffTime)
csLatency Maybe NominalDiffTime
forall a. Maybe a
Nothing NetworkState
cs

    TimedAction
TimedDisconnect ->
      do TerminationReason -> NetworkConnection -> IO ()
abortConnection TerminationReason
PingTimeout (Getting NetworkConnection NetworkState NetworkConnection
-> NetworkState -> NetworkConnection
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NetworkConnection NetworkState NetworkConnection
Lens' NetworkState NetworkConnection
csSocket NetworkState
cs)
         NetworkState -> IO NetworkState
forall (m :: * -> *) a. Monad m => a -> m a
return (NetworkState -> IO NetworkState)
-> NetworkState -> IO NetworkState
forall a b. (a -> b) -> a -> b
$! ASetter NetworkState NetworkState (Maybe UTCTime) (Maybe UTCTime)
-> Maybe UTCTime -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState (Maybe UTCTime) (Maybe UTCTime)
Lens' NetworkState (Maybe UTCTime)
csNextPingTime Maybe UTCTime
forall a. Maybe a
Nothing NetworkState
cs

    TimedAction
TimedSendPing ->
      do UTCTime
now <- IO UTCTime
getCurrentTime
         NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs ([Text] -> RawIrcMsg
ircPing [Text
"ping"])
         NetworkState -> IO NetworkState
forall (m :: * -> *) a. Monad m => a -> m a
return (NetworkState -> IO NetworkState)
-> NetworkState -> IO NetworkState
forall a b. (a -> b) -> a -> b
$! ASetter NetworkState NetworkState (Maybe UTCTime) (Maybe UTCTime)
-> Maybe UTCTime -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState (Maybe UTCTime) (Maybe UTCTime)
Lens' NetworkState (Maybe UTCTime)
csNextPingTime (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$! NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
60 UTCTime
now)
                (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$  ASetter NetworkState NetworkState PingStatus PingStatus
-> PingStatus -> NetworkState -> NetworkState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter NetworkState NetworkState PingStatus PingStatus
Lens' NetworkState PingStatus
csPingStatus   (UTCTime -> PingStatus
PingSent UTCTime
now) NetworkState
cs

------------------------------------------------------------------------
-- Moderation
------------------------------------------------------------------------

-- | Used to send commands that require ops to perform.
-- If this channel is one that the user has chanserv access and ops are needed
-- then ops are requested and the commands are queued, otherwise send them
-- directly.
sendModeration ::
  Identifier      {- ^ channel       -} ->
  [RawIrcMsg]     {- ^ commands      -} ->
  NetworkState    {- ^ network state -} ->
  IO NetworkState
sendModeration :: Identifier -> [RawIrcMsg] -> NetworkState -> IO NetworkState
sendModeration Identifier
channel [RawIrcMsg]
cmds NetworkState
cs
  | Identifier -> NetworkState -> Bool
useChanServ Identifier
channel NetworkState
cs =
      do let cmd :: RawIrcMsg
cmd = Text -> Text -> RawIrcMsg
ircPrivmsg Text
"ChanServ" ([Text] -> Text
Text.unwords [Text
"OP", Identifier -> Text
idText Identifier
channel])
         NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs RawIrcMsg
cmd
         NetworkState -> IO NetworkState
forall (m :: * -> *) a. Monad m => a -> m a
return (NetworkState -> IO NetworkState)
-> NetworkState -> IO NetworkState
forall a b. (a -> b) -> a -> b
$ ASetter
  NetworkState
  NetworkState
  (HashMap Identifier ChannelState)
  (HashMap Identifier ChannelState)
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ASetter
  NetworkState
  NetworkState
  (HashMap Identifier ChannelState)
  (HashMap Identifier ChannelState)
-> (([RawIrcMsg] -> Identity [RawIrcMsg])
    -> HashMap Identifier ChannelState
    -> Identity (HashMap Identifier ChannelState))
-> ([RawIrcMsg] -> Identity [RawIrcMsg])
-> NetworkState
-> Identity NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier ChannelState)
channel ((ChannelState -> Identity ChannelState)
 -> HashMap Identifier ChannelState
 -> Identity (HashMap Identifier ChannelState))
-> (([RawIrcMsg] -> Identity [RawIrcMsg])
    -> ChannelState -> Identity ChannelState)
-> ([RawIrcMsg] -> Identity [RawIrcMsg])
-> HashMap Identifier ChannelState
-> Identity (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RawIrcMsg] -> Identity [RawIrcMsg])
-> ChannelState -> Identity ChannelState
Lens' ChannelState [RawIrcMsg]
chanQueuedModeration (([RawIrcMsg] -> Identity [RawIrcMsg])
 -> NetworkState -> Identity NetworkState)
-> [RawIrcMsg] -> NetworkState -> NetworkState
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ [RawIrcMsg]
cmds (NetworkState -> NetworkState) -> NetworkState -> NetworkState
forall a b. (a -> b) -> a -> b
$ NetworkState
cs
  | Bool
otherwise = NetworkState
cs NetworkState -> IO () -> IO NetworkState
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (RawIrcMsg -> IO ()) -> [RawIrcMsg] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs) [RawIrcMsg]
cmds

useChanServ ::
  Identifier   {- ^ channel            -} ->
  NetworkState {- ^ network state      -} ->
  Bool         {- ^ chanserv available -}
useChanServ :: Identifier -> NetworkState -> Bool
useChanServ Identifier
channel NetworkState
cs =
  Identifier
channel Identifier -> [Identifier] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Getting [Identifier] NetworkState [Identifier]
-> NetworkState -> [Identifier]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ServerSettings -> Const [Identifier] ServerSettings)
-> NetworkState -> Const [Identifier] NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const [Identifier] ServerSettings)
 -> NetworkState -> Const [Identifier] NetworkState)
-> (([Identifier] -> Const [Identifier] [Identifier])
    -> ServerSettings -> Const [Identifier] ServerSettings)
-> Getting [Identifier] NetworkState [Identifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Identifier] -> Const [Identifier] [Identifier])
-> ServerSettings -> Const [Identifier] ServerSettings
Lens' ServerSettings [Identifier]
ssChanservChannels) NetworkState
cs Bool -> Bool -> Bool
&&
  Bool -> Bool
not (Identifier -> NetworkState -> Bool
iHaveOp Identifier
channel NetworkState
cs)

sendTopic ::
  Identifier   {- ^ channel       -} ->
  Text         {- ^ topic         -} ->
  NetworkState {- ^ network state -} ->
  IO ()
sendTopic :: Identifier -> Text -> NetworkState -> IO ()
sendTopic Identifier
channelId Text
topic NetworkState
cs = NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs RawIrcMsg
cmd
  where
    chanservTopicCmd :: RawIrcMsg
chanservTopicCmd =
      Text -> Text -> RawIrcMsg
ircPrivmsg
        Text
"ChanServ"
        ([Text] -> Text
Text.unwords [Text
"TOPIC", Identifier -> Text
idText Identifier
channelId, Text
topic])

    cmd :: RawIrcMsg
cmd
      | Text -> Bool
Text.null Text
topic          = Identifier -> Text -> RawIrcMsg
ircTopic Identifier
channelId Text
""
      | Identifier -> NetworkState -> Bool
useChanServ Identifier
channelId NetworkState
cs = RawIrcMsg
chanservTopicCmd
      | Bool
otherwise                = Identifier -> Text -> RawIrcMsg
ircTopic Identifier
channelId Text
topic