{-# Language BlockArguments, TemplateHaskell, OverloadedStrings, BangPatterns #-}
module Client.State.Network
(
NetworkState(..)
, AuthenticateState(..)
, ConnectRestriction(..)
, newNetworkState
, csNick
, csChannels
, csSocket
, csModeTypes
, csChannelTypes
, csTransaction
, csModes
, csSnomask
, csStatusMsg
, csSettings
, csUserInfo
, csUsers
, csUser
, csModeCount
, csNetwork
, csNextPingTime
, csPingStatus
, csLatency
, csLastReceived
, csCertificate
, csMessageHooks
, csAuthenticationState
, csSeed
, csAway
, Transaction(..)
, isChannelIdentifier
, iHaveOp
, sendMsg
, initialMessages
, squelchIrcMsg
, Apply(..)
, applyMessage
, hideMessage
, PingStatus(..)
, _PingConnecting
, TimedAction(..)
, nextTimedAction
, applyTimedAction
, 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
data NetworkState = NetworkState
{ NetworkState -> HashMap Identifier ChannelState
_csChannels :: !(HashMap Identifier ChannelState)
, NetworkState -> NetworkConnection
_csSocket :: !NetworkConnection
, NetworkState -> ModeTypes
_csModeTypes :: !ModeTypes
, NetworkState -> ModeTypes
_csUmodeTypes :: !ModeTypes
, NetworkState -> [Char]
_csChannelTypes :: ![Char]
, NetworkState -> Transaction
_csTransaction :: !Transaction
, NetworkState -> [Char]
_csModes :: ![Char]
, NetworkState -> [Char]
_csSnomask :: ![Char]
, NetworkState -> [Char]
_csStatusMsg :: ![Char]
, NetworkState -> ServerSettings
_csSettings :: !ServerSettings
, NetworkState -> UserInfo
_csUserInfo :: !UserInfo
, NetworkState -> HashMap Identifier UserAndHost
_csUsers :: !(HashMap Identifier UserAndHost)
, NetworkState -> Int
_csModeCount :: !Int
, NetworkState -> Text
_csNetwork :: !Text
, NetworkState -> [MessageHook]
_csMessageHooks :: ![MessageHook]
, NetworkState -> AuthenticateState
_csAuthenticationState :: !AuthenticateState
, NetworkState -> Bool
_csAway :: !Bool
, NetworkState -> Maybe UTCTime
_csNextPingTime :: !(Maybe UTCTime)
, NetworkState -> Maybe NominalDiffTime
_csLatency :: !(Maybe NominalDiffTime)
, NetworkState -> PingStatus
_csPingStatus :: !PingStatus
, NetworkState -> Maybe UTCTime
_csLastReceived :: !(Maybe UTCTime)
, NetworkState -> [Text]
_csCertificate :: ![Text]
, NetworkState -> StdGen
_csSeed :: Random.StdGen
}
data AuthenticateState
= AS_None
| AS_PlainStarted
| AS_EcdsaStarted
| AS_EcdsaWaitChallenge
| AS_ExternalStarted
| AS_ScramStarted
| AS_Scram1 Scram.Phase1
| AS_Scram2 Scram.Phase2
| AS_EcdhStarted
| AS_EcdhWaitChallenge Ecdh.Phase1
data PingStatus
= PingSent !UTCTime
| PingNone
| PingConnecting !Int !(Maybe UTCTime) !ConnectRestriction
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
| StartTLSRestriction
| WaitTLSRestriction
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
data TimedAction
= TimedDisconnect
| TimedSendPing
| TimedForgetLatency
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
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"
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]
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]
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]
| 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..]
[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'
newNetworkState ::
Text ->
ServerSettings ->
NetworkConnection ->
PingStatus ->
Random.StdGen ->
NetworkState
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
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)
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
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
doWelcome ::
ZonedTime ->
Identifier ->
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
doBadNick ::
Text ->
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
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
range :: (Int, Int)
range = (Int
0, Int
99999::Int)
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
[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
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
recordListEntry ::
Text ->
Text ->
Text ->
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)
saveList ::
Char ->
Text ->
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)
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
squelchIrcMsg :: IrcMsg -> Bool
squelchIrcMsg :: IrcMsg -> Bool
squelchIrcMsg (Reply Text
_ ReplyCode
rpl [Text]
_) = ReplyCode -> Bool
squelchReply ReplyCode
rpl
squelchIrcMsg IrcMsg
_ = Bool
False
doMode ::
ZonedTime ->
UserInfo ->
Identifier ->
Text ->
[Text] ->
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
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 ->
[(Text, Maybe Text)] ->
[Text]
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" ]
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
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
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 ]
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
(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]
_) =
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 ::
[Text] ->
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 ->
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
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 ->
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
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)
updateUserInfo ::
Identifier ->
Text ->
Text ->
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
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
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]
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)
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)
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
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
sendModeration ::
Identifier ->
[RawIrcMsg] ->
NetworkState ->
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 ->
NetworkState ->
Bool
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 ->
Text ->
NetworkState ->
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