{-# Language OverloadedStrings, PatternSynonyms #-}
{-|
Module      : Client.EventLoop.Network
Description : Event handlers for network messages affecting the client state
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

While most network messages only affect the model of that network connection,
some messages will affect the mutable state of the client itself.
-}
module Client.EventLoop.Network
  ( clientResponse
  ) where

import Client.Authentication.Ecdsa qualified as Ecdsa
import Client.Commands (CommandResult(CommandQuit, CommandFailure, CommandSuccess), commandExpansion, executeUserCommand)
import Client.Commands.Interpolation (resolveMacroExpansions, ExpansionChunk)
import Client.Configuration.ServerSettings
import Client.Configuration.Sts (savePolicyFile, StsPolicy(StsPolicy, _stsPort, _stsExpiration))
import Client.Network.Async (abortConnection, TerminationReason(StsUpgrade))
import Client.Network.Connect (ircPort)
import Client.State
import Client.State.Focus (Focus(ChannelFocus, NetworkFocus))
import Client.State.Network
import Control.Lens (view, (&), folded, previews, views, (?~), set, At(at))
import Control.Monad (join, foldM, forM)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Read qualified as Text
import Data.Time (ZonedTime, addUTCTime, getCurrentTime, formatTime, defaultTimeLocale, utcToLocalZonedTime)
import Irc.Codes (pattern ERR_LINKCHANNEL, pattern RPL_WELCOME)
import Irc.Commands (ircAuthenticate, ircCapEnd)
import Irc.Identifier (mkId)
import Irc.Message (IrcMsg(Error, Reply, Authenticate, Cap), CapCmd(CapNew, CapLs))
import Text.Regex.TDFA.Text qualified as Regex

-- | Client-level responses to specific IRC messages.
-- This is in contrast to the connection state tracking logic in
-- "Client.NetworkState"
clientResponse :: ZonedTime -> IrcMsg -> NetworkState -> ClientState -> IO ClientState
clientResponse :: ZonedTime
-> IrcMsg -> NetworkState -> ClientState -> IO ClientState
clientResponse ZonedTime
now IrcMsg
irc NetworkState
cs ClientState
st =
  case IrcMsg
irc of
    Reply Text
_ ReplyCode
RPL_WELCOME [Text]
_ ->
      -- run connection commands with the network focused and restore it afterward
      do let focus :: Focus
focus = Text -> Focus
NetworkFocus (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs)
         ClientState
st' <- (ClientState -> [ExpansionChunk] -> IO ClientState)
-> ClientState -> [[ExpansionChunk]] -> IO ClientState
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (ZonedTime
-> NetworkState
-> ClientState
-> [ExpansionChunk]
-> IO ClientState
processConnectCmd ZonedTime
now NetworkState
cs)
                      (ASetter ClientState ClientState Focus Focus
-> Focus -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Focus Focus
Lens' ClientState Focus
clientFocus Focus
focus ClientState
st)
                      (Getting [[ExpansionChunk]] NetworkState [[ExpansionChunk]]
-> NetworkState -> [[ExpansionChunk]]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ServerSettings -> Const [[ExpansionChunk]] ServerSettings)
-> NetworkState -> Const [[ExpansionChunk]] NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const [[ExpansionChunk]] ServerSettings)
 -> NetworkState -> Const [[ExpansionChunk]] NetworkState)
-> (([[ExpansionChunk]]
     -> Const [[ExpansionChunk]] [[ExpansionChunk]])
    -> ServerSettings -> Const [[ExpansionChunk]] ServerSettings)
-> Getting [[ExpansionChunk]] NetworkState [[ExpansionChunk]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[ExpansionChunk]] -> Const [[ExpansionChunk]] [[ExpansionChunk]])
-> ServerSettings -> Const [[ExpansionChunk]] ServerSettings
Lens' ServerSettings [[ExpansionChunk]]
ssConnectCmds) NetworkState
cs)
         ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$! ASetter ClientState ClientState Focus Focus
-> Focus -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Focus Focus
Lens' ClientState Focus
clientFocus (Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st) ClientState
st'

    -- Change focus when we get a message that we're being forwarded to another channel
    Reply Text
_ ReplyCode
ERR_LINKCHANNEL (Text
_ : Text
src : Text
dst : [Text]
_)
      | let network :: Text
network = Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs
      , Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st Focus -> Focus -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Identifier -> Focus
ChannelFocus Text
network (Text -> Identifier
mkId Text
src) ->
         ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$! ASetter ClientState ClientState Focus Focus
-> Focus -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState Focus Focus
Lens' ClientState Focus
clientFocus (Text -> Identifier -> Focus
ChannelFocus Text
network (Text -> Identifier
mkId Text
dst)) ClientState
st

    Authenticate Text
challenge
      | AuthenticateState
AS_EcdsaWaitChallenge <- 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 ->
         ZonedTime -> Text -> NetworkState -> ClientState -> IO ClientState
processSaslEcdsa ZonedTime
now Text
challenge NetworkState
cs ClientState
st

    Cap (CapLs CapMore
_ [(Text, Maybe Text)]
caps)
      | Just Text
stsVal <- Maybe (Maybe Text) -> Maybe Text
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Text -> [(Text, Maybe Text)] -> Maybe (Maybe Text)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"sts" [(Text, Maybe Text)]
caps) -> Text -> NetworkState -> ClientState -> IO ClientState
processSts Text
stsVal NetworkState
cs ClientState
st

    Cap (CapNew [(Text, Maybe Text)]
caps)
      | Just Text
stsVal <- Maybe (Maybe Text) -> Maybe Text
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Text -> [(Text, Maybe Text)] -> Maybe (Maybe Text)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"sts" [(Text, Maybe Text)]
caps) -> Text -> NetworkState -> ClientState -> IO ClientState
processSts Text
stsVal NetworkState
cs ClientState
st

    Error Text
msg
      | Just Regex
rx <- Getting (First Regex) NetworkState KnownRegex
-> (KnownRegex -> Regex) -> NetworkState -> Maybe Regex
forall s (m :: * -> *) r a.
MonadReader s m =>
Getting (First r) s a -> (a -> r) -> m (Maybe r)
previews ((ServerSettings -> Const (First Regex) ServerSettings)
-> NetworkState -> Const (First Regex) NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const (First Regex) ServerSettings)
 -> NetworkState -> Const (First Regex) NetworkState)
-> ((KnownRegex -> Const (First Regex) KnownRegex)
    -> ServerSettings -> Const (First Regex) ServerSettings)
-> Getting (First Regex) NetworkState KnownRegex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe KnownRegex -> Const (First Regex) (Maybe KnownRegex))
-> ServerSettings -> Const (First Regex) ServerSettings
Lens' ServerSettings (Maybe KnownRegex)
ssReconnectError ((Maybe KnownRegex -> Const (First Regex) (Maybe KnownRegex))
 -> ServerSettings -> Const (First Regex) ServerSettings)
-> ((KnownRegex -> Const (First Regex) KnownRegex)
    -> Maybe KnownRegex -> Const (First Regex) (Maybe KnownRegex))
-> (KnownRegex -> Const (First Regex) KnownRegex)
-> ServerSettings
-> Const (First Regex) ServerSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KnownRegex -> Const (First Regex) KnownRegex)
-> Maybe KnownRegex -> Const (First Regex) (Maybe KnownRegex)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int (Maybe KnownRegex) KnownRegex
folded) KnownRegex -> Regex
getRegex NetworkState
cs
      , Right{} <- Regex -> Text -> Either String (Maybe MatchArray)
Regex.execute Regex
rx Text
msg
      , let discoTime :: Maybe UTCTime
discoTime = 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 ->
         Int
-> Maybe UTCTime
-> Maybe Int
-> Text
-> ClientState
-> IO ClientState
addConnection Int
1 Maybe UTCTime
discoTime Maybe Int
forall a. Maybe a
Nothing (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs) ClientState
st

    IrcMsg
_ -> ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st

processSts ::
  Text         {- ^ STS parameter string -} ->
  NetworkState {- ^ network state        -} ->
  ClientState  {- ^ client state         -} ->
  IO ClientState
processSts :: Text -> NetworkState -> ClientState -> IO ClientState
processSts Text
txt NetworkState
cs ClientState
st =
  case Getting TlsMode NetworkState TlsMode -> NetworkState -> TlsMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ServerSettings -> Const TlsMode ServerSettings)
-> NetworkState -> Const TlsMode NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const TlsMode ServerSettings)
 -> NetworkState -> Const TlsMode NetworkState)
-> ((TlsMode -> Const TlsMode TlsMode)
    -> ServerSettings -> Const TlsMode ServerSettings)
-> Getting TlsMode NetworkState TlsMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TlsMode -> Const TlsMode TlsMode)
-> ServerSettings -> Const TlsMode ServerSettings
Lens' ServerSettings TlsMode
ssTls) NetworkState
cs of
    TlsMode
_      | LensLike' (Const Bool) NetworkState Bool
-> (Bool -> Bool) -> NetworkState -> Bool
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((ServerSettings -> Const Bool ServerSettings)
-> NetworkState -> Const Bool NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const Bool ServerSettings)
 -> NetworkState -> Const Bool NetworkState)
-> ((Bool -> Const Bool Bool)
    -> ServerSettings -> Const Bool ServerSettings)
-> LensLike' (Const Bool) NetworkState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> ServerSettings -> Const Bool ServerSettings
Lens' ServerSettings Bool
ssSts) Bool -> Bool
not NetworkState
cs -> ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st -- sts disabled
    TlsMode
TlsNo  | Just Int
port     <- Maybe Int
mbPort           -> Int -> IO ClientState
upgradeConnection Int
port
    TlsMode
TlsYes | Just Int
duration <- Maybe Int
mbDuration       -> Int -> IO ClientState
forall {p}. Integral p => p -> IO ClientState
setStsPolicy Int
duration
    TlsMode
_                                          -> ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st

  where
    entries :: [(Text, Text)]
entries    = Text -> (Text, Text)
splitEntry (Text -> (Text, Text)) -> [Text] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
"," Text
txt
    mbPort :: Maybe Int
mbPort     = Text -> Maybe Int
readInt (Text -> Maybe Int) -> Maybe Text -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"port"     [(Text, Text)]
entries
    mbDuration :: Maybe Int
mbDuration = Text -> Maybe Int
readInt (Text -> Maybe Int) -> Maybe Text -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"duration" [(Text, Text)]
entries

    splitEntry :: Text -> (Text, Text)
splitEntry Text
e =
      case (Char -> Bool) -> Text -> (Text, Text)
Text.break (Char
'=' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
e of
        (Text
a, Text
b) -> (Text
a, Int -> Text -> Text
Text.drop Int
1 Text
b)

    upgradeConnection :: Int -> IO ClientState
upgradeConnection Int
port =
      do TerminationReason -> NetworkConnection -> IO ()
abortConnection TerminationReason
StsUpgrade (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)
         Int
-> Maybe UTCTime
-> Maybe Int
-> Text
-> ClientState
-> IO ClientState
addConnection Int
0 (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) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
port) (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs) ClientState
st

    setStsPolicy :: p -> IO ClientState
setStsPolicy p
duration =
      do UTCTime
now <- IO UTCTime
getCurrentTime
         let host :: Text
host = String -> Text
Text.pack (Getting String NetworkState String -> NetworkState -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ServerSettings -> Const String ServerSettings)
-> NetworkState -> Const String NetworkState
Lens' NetworkState ServerSettings
csSettings ((ServerSettings -> Const String ServerSettings)
 -> NetworkState -> Const String NetworkState)
-> ((String -> Const String String)
    -> ServerSettings -> Const String ServerSettings)
-> Getting String NetworkState String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const String String)
-> ServerSettings -> Const String ServerSettings
Lens' ServerSettings String
ssHostName) NetworkState
cs)
             port :: Int
port = PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ServerSettings -> PortNumber
ircPort (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))
             policy :: StsPolicy
policy = StsPolicy
                        { _stsExpiration :: UTCTime
_stsExpiration = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (p -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
duration) UTCTime
now
                        , _stsPort :: Int
_stsPort       = Int
port }
             st' :: ClientState
st' = ClientState
st ClientState -> (ClientState -> ClientState) -> ClientState
forall a b. a -> (a -> b) -> b
& (HashMap Text StsPolicy -> Identity (HashMap Text StsPolicy))
-> ClientState -> Identity ClientState
Lens' ClientState (HashMap Text StsPolicy)
clientStsPolicy ((HashMap Text StsPolicy -> Identity (HashMap Text StsPolicy))
 -> ClientState -> Identity ClientState)
-> ((Maybe StsPolicy -> Identity (Maybe StsPolicy))
    -> HashMap Text StsPolicy -> Identity (HashMap Text StsPolicy))
-> (Maybe StsPolicy -> Identity (Maybe StsPolicy))
-> ClientState
-> Identity ClientState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text StsPolicy)
-> Lens'
     (HashMap Text StsPolicy) (Maybe (IxValue (HashMap Text StsPolicy)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (HashMap Text StsPolicy)
host ((Maybe StsPolicy -> Identity (Maybe StsPolicy))
 -> ClientState -> Identity ClientState)
-> StsPolicy -> ClientState -> ClientState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ StsPolicy
policy
         HashMap Text StsPolicy -> IO ()
savePolicyFile (Getting
  (HashMap Text StsPolicy) ClientState (HashMap Text StsPolicy)
-> ClientState -> HashMap Text StsPolicy
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (HashMap Text StsPolicy) ClientState (HashMap Text StsPolicy)
Lens' ClientState (HashMap Text StsPolicy)
clientStsPolicy ClientState
st')
         ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientState
st'


readInt :: Text -> Maybe Int
readInt :: Text -> Maybe Int
readInt Text
x =
  case Reader Int
forall a. Integral a => Reader a
Text.decimal Text
x of
    Right (Int
n, Text
t) | Text -> Bool
Text.null Text
t -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
    Either String (Int, Text)
_                          -> Maybe Int
forall a. Maybe a
Nothing

processSaslEcdsa ::
  ZonedTime    {- ^ message time  -} ->
  Text         {- ^ challenge     -} ->
  NetworkState {- ^ network state -} ->
  ClientState  {- ^ client state  -} ->
  IO ClientState
processSaslEcdsa :: ZonedTime -> Text -> NetworkState -> ClientState -> IO ClientState
processSaslEcdsa ZonedTime
now Text
challenge NetworkState
cs ClientState
st =
  case 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 of
    Just (SaslEcdsa Maybe Text
_ Text
_ String
path) ->
      do Either String Text
res <- String -> Text -> IO (Either String Text)
Ecdsa.computeResponse String
path Text
challenge
         case Either String Text
res of
           Left String
e ->
             do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs RawIrcMsg
ircCapEnd
                ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$! ZonedTime -> Text -> Text -> ClientState -> ClientState
recordError ZonedTime
now (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs) (String -> Text
Text.pack String
e) ClientState
st
           Right Text
resp ->
             do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> RawIrcMsg
ircAuthenticate Text
resp)
                ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$! ASetter ClientState ClientState AuthenticateState AuthenticateState
-> AuthenticateState -> ClientState -> ClientState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ClientState ClientState AuthenticateState AuthenticateState
asLens AuthenticateState
AS_None ClientState
st

    Maybe SaslMechanism
_ ->
      do NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs RawIrcMsg
ircCapEnd
         ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$! ZonedTime -> Text -> Text -> ClientState -> ClientState
recordError ZonedTime
now (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs) Text
"panic: ecdsa mechanism not configured" ClientState
st
  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
    asLens :: ASetter ClientState ClientState AuthenticateState AuthenticateState
asLens = Text -> LensLike' Identity ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs) LensLike' Identity ClientState NetworkState
-> ((AuthenticateState -> Identity AuthenticateState)
    -> NetworkState -> Identity NetworkState)
-> ASetter
     ClientState ClientState AuthenticateState AuthenticateState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AuthenticateState -> Identity AuthenticateState)
-> NetworkState -> Identity NetworkState
Lens' NetworkState AuthenticateState
csAuthenticationState

processConnectCmd ::
  ZonedTime       {- ^ now             -} ->
  NetworkState    {- ^ current network -} ->
  ClientState     {- ^ client state    -} ->
  [ExpansionChunk]{- ^ command         -} ->
  IO ClientState
processConnectCmd :: ZonedTime
-> NetworkState
-> ClientState
-> [ExpansionChunk]
-> IO ClientState
processConnectCmd ZonedTime
now NetworkState
cs ClientState
st0 [ExpansionChunk]
cmdTxt =
  do Maybe Text
dc <- Maybe UTCTime -> (UTCTime -> IO Text) -> IO (Maybe Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe UTCTime
disco ((UTCTime -> IO Text) -> IO (Maybe Text))
-> (UTCTime -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \UTCTime
t ->
             String -> Text
Text.pack (String -> Text) -> (ZonedTime -> String) -> ZonedTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%H:%M:%S"
               (ZonedTime -> Text) -> IO ZonedTime -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime -> IO ZonedTime
utcToLocalZonedTime UTCTime
t
     let failureCase :: Text -> ClientState -> ClientState
failureCase Text
e = ZonedTime -> Text -> Text -> ClientState -> ClientState
recordError ZonedTime
now (Getting Text NetworkState Text -> NetworkState -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text NetworkState Text
Lens' NetworkState Text
csNetwork NetworkState
cs) (Text
"Bad connect-cmd: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e)
     case (Text -> Maybe Text)
-> (Integer -> Maybe Text) -> [ExpansionChunk] -> Maybe Text
forall (f :: * -> *).
Alternative f =>
(Text -> f Text)
-> (Integer -> f Text) -> [ExpansionChunk] -> f Text
resolveMacroExpansions (Maybe Focus -> Maybe Text -> ClientState -> Text -> Maybe Text
commandExpansion Maybe Focus
forall a. Maybe a
Nothing Maybe Text
dc ClientState
st0) (Maybe Text -> Integer -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) [ExpansionChunk]
cmdTxt of
       Maybe Text
Nothing -> ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$! Text -> ClientState -> ClientState
failureCase Text
"Unable to expand connect command" ClientState
st0
       Just Text
cmdTxt' ->
         do CommandResult
res <- Maybe Text -> String -> ClientState -> IO CommandResult
executeUserCommand Maybe Text
dc (Text -> String
Text.unpack Text
cmdTxt') ClientState
st0
            ClientState -> IO ClientState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientState -> IO ClientState) -> ClientState -> IO ClientState
forall a b. (a -> b) -> a -> b
$! case CommandResult
res of
              CommandFailure ClientState
st -> Text -> ClientState -> ClientState
failureCase Text
cmdTxt' ClientState
st
              CommandSuccess ClientState
st -> ClientState
st
              CommandQuit    ClientState
st -> ClientState
st -- not supported
 where
 disco :: Maybe UTCTime
disco =
   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
     PingConnecting Int
_ Maybe UTCTime
tm ConnectRestriction
_ -> Maybe UTCTime
tm
     PingStatus
_                     -> Maybe UTCTime
forall a. Maybe a
Nothing