{-# Language OverloadedStrings #-}
module Client.Commands.Connection (connectionCommands) where
import Client.Commands.Arguments.Spec
import Client.Commands.TabCompletion
import Client.Commands.Types
import Client.Commands.WordCompletion
import Client.Configuration
import Client.State
import Client.State.Focus
import Client.State.Network
import Control.Lens
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as Text
import Irc.Commands (ircMode, ircQuit)
connectionCommands :: CommandSection
connectionCommands :: CommandSection
connectionCommands = Text -> [Command] -> CommandSection
CommandSection Text
"Connection commands"
[ NonEmpty Text
-> Args ClientState String -> Text -> CommandImpl String -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"connect")
(String -> Args ClientState String
forall r. String -> Args r String
simpleToken String
"network")
Text
"Connect to \^Bnetwork\^B by name.\n\
\\n\
\If no name is configured the hostname is the 'name'.\n"
(CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand String
-> (Bool -> ClientCommand String) -> CommandImpl String
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdConnect Bool -> ClientCommand String
tabConnect
, NonEmpty Text
-> Args ClientState () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"reconnect")
(() -> Args ClientState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
Text
"Reconnect to the current network.\n"
(CommandImpl () -> Command) -> CommandImpl () -> Command
forall a b. (a -> b) -> a -> b
$ ClientCommand ()
-> (Bool -> ClientCommand String) -> CommandImpl ()
forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand ()
cmdReconnect Bool -> ClientCommand String
noClientTab
, NonEmpty Text
-> Args ClientState () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"disconnect")
(() -> Args ClientState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
Text
"Immediately terminate the current network connection.\n\
\\n\
\See also: /quit /exit\n"
(CommandImpl () -> Command) -> CommandImpl () -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand ()
-> (Bool -> NetworkCommand String) -> CommandImpl ()
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand ()
cmdDisconnect Bool -> NetworkCommand String
noNetworkTab
, NonEmpty Text
-> Args ClientState String -> Text -> CommandImpl String -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"quit")
(String -> Args ClientState String
forall r. String -> Args r String
remainingArg String
"reason")
Text
"Gracefully disconnect the current network connection.\n\
\\n\
\\^Breason\^B: optional quit reason\n\
\\n\
\See also: /disconnect /exit\n"
(CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand String
-> (Bool -> NetworkCommand String) -> CommandImpl String
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdQuit Bool -> NetworkCommand String
simpleNetworkTab
, NonEmpty Text
-> Args ClientState () -> Text -> CommandImpl () -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"cert")
(() -> Args ClientState ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
Text
"Show the TLS certificate for the current connection.\n"
(CommandImpl () -> Command) -> CommandImpl () -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand ()
-> (Bool -> NetworkCommand String) -> CommandImpl ()
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand ()
cmdCert Bool -> NetworkCommand String
noNetworkTab
, NonEmpty Text
-> Args ClientState String -> Text -> CommandImpl String -> Command
forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
(Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"umode")
(String -> Args ClientState String
forall r. String -> Args r String
remainingArg String
"modes")
Text
"Apply a user-mode change.\n"
(CommandImpl String -> Command) -> CommandImpl String -> Command
forall a b. (a -> b) -> a -> b
$ NetworkCommand String
-> (Bool -> NetworkCommand String) -> CommandImpl String
forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdUmode Bool -> NetworkCommand String
noNetworkTab
]
cmdUmode :: NetworkCommand String
cmdUmode :: NetworkCommand String
cmdUmode NetworkState
cs ClientState
st String
rest =
do let args :: [Text]
args = Text -> [Text]
Text.words (String -> Text
Text.pack String
rest)
NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Identifier -> [Text] -> RawIrcMsg
ircMode (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) [Text]
args)
ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st
cmdConnect :: ClientCommand String
cmdConnect :: ClientCommand String
cmdConnect ClientState
st String
networkStr =
do
let network :: Text
network = String -> Text
Text.pack String
networkStr
ClientState
st' <- Int
-> Maybe UTCTime
-> Maybe Int
-> Text
-> ClientState
-> IO ClientState
addConnection Int
0 Maybe UTCTime
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Text
network (ClientState -> IO ClientState) -> IO ClientState -> IO ClientState
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> ClientState -> IO ClientState
abortNetwork Text
network ClientState
st
ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
(ClientState -> IO CommandResult)
-> ClientState -> IO CommandResult
forall a b. (a -> b) -> a -> b
$ Focus -> ClientState -> ClientState
changeFocus (Text -> Focus
NetworkFocus Text
network) ClientState
st'
cmdQuit :: NetworkCommand String
cmdQuit :: NetworkCommand String
cmdQuit NetworkState
cs ClientState
st String
rest =
do let msg :: Text
msg = String -> Text
Text.pack String
rest
NetworkState -> RawIrcMsg -> IO ()
sendMsg NetworkState
cs (Text -> RawIrcMsg
ircQuit Text
msg)
ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st
cmdDisconnect :: NetworkCommand ()
cmdDisconnect :: NetworkCommand ()
cmdDisconnect NetworkState
cs ClientState
st ()
_ =
do ClientState
st' <- Text -> ClientState -> IO ClientState
abortNetwork (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 -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess ClientState
st'
cmdReconnect :: ClientCommand ()
cmdReconnect :: ClientCommand ()
cmdReconnect ClientState
st ()
_
| Just Text
network <- LensLike' (Const (Maybe Text)) ClientState Focus
-> (Focus -> Maybe Text) -> ClientState -> Maybe Text
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const (Maybe Text)) ClientState Focus
Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st =
do let tm :: Maybe UTCTime
tm = Getting (First UTCTime) ClientState UTCTime
-> ClientState -> Maybe UTCTime
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> LensLike' (Const (First UTCTime)) ClientState NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network LensLike' (Const (First UTCTime)) ClientState NetworkState
-> ((UTCTime -> Const (First UTCTime) UTCTime)
-> NetworkState -> Const (First UTCTime) NetworkState)
-> Getting (First UTCTime) ClientState UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe UTCTime -> Const (First UTCTime) (Maybe UTCTime))
-> NetworkState -> Const (First UTCTime) NetworkState
Lens' NetworkState (Maybe UTCTime)
csLastReceived ((Maybe UTCTime -> Const (First UTCTime) (Maybe UTCTime))
-> NetworkState -> Const (First UTCTime) NetworkState)
-> ((UTCTime -> Const (First UTCTime) UTCTime)
-> Maybe UTCTime -> Const (First UTCTime) (Maybe UTCTime))
-> (UTCTime -> Const (First UTCTime) UTCTime)
-> NetworkState
-> Const (First UTCTime) NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime -> Const (First UTCTime) UTCTime)
-> Maybe UTCTime -> Const (First UTCTime) (Maybe UTCTime)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded) ClientState
st
ClientState
st' <- Int
-> Maybe UTCTime
-> Maybe Int
-> Text
-> ClientState
-> IO ClientState
addConnection Int
0 Maybe UTCTime
tm Maybe Int
forall a. Maybe a
Nothing Text
network (ClientState -> IO ClientState) -> IO ClientState -> IO ClientState
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> ClientState -> IO ClientState
abortNetwork Text
network ClientState
st
ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
(ClientState -> IO CommandResult)
-> ClientState -> IO CommandResult
forall a b. (a -> b) -> a -> b
$ Focus -> ClientState -> ClientState
changeFocus (Text -> Focus
NetworkFocus Text
network) ClientState
st'
| Bool
otherwise = Text -> ClientState -> IO CommandResult
commandFailureMsg Text
"command requires focused network" ClientState
st
tabConnect :: Bool -> ClientCommand String
tabConnect :: Bool -> ClientCommand String
tabConnect Bool
isReversed ClientState
st String
_ =
WordCompletionMode
-> [Text] -> [Text] -> Bool -> ClientState -> IO CommandResult
forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [] [Text]
networks Bool
isReversed ClientState
st
where
networks :: [Text]
networks = LensLike' (Const [Text]) ClientState (HashMap Text NetworkState)
-> (HashMap Text NetworkState -> [Text]) -> ClientState -> [Text]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const [Text]) ClientState (HashMap Text NetworkState)
Lens' ClientState (HashMap Text NetworkState)
clientConnections HashMap Text NetworkState -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys ClientState
st
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ LensLike' (Const [Text]) ClientState (HashMap Text ServerSettings)
-> (HashMap Text ServerSettings -> [Text]) -> ClientState -> [Text]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((Configuration -> Const [Text] Configuration)
-> ClientState -> Const [Text] ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const [Text] Configuration)
-> ClientState -> Const [Text] ClientState)
-> ((HashMap Text ServerSettings
-> Const [Text] (HashMap Text ServerSettings))
-> Configuration -> Const [Text] Configuration)
-> LensLike'
(Const [Text]) ClientState (HashMap Text ServerSettings)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Text ServerSettings
-> Const [Text] (HashMap Text ServerSettings))
-> Configuration -> Const [Text] Configuration
Lens' Configuration (HashMap Text ServerSettings)
configServers) HashMap Text ServerSettings -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys ClientState
st
cmdCert :: NetworkCommand ()
cmdCert :: NetworkCommand ()
cmdCert NetworkState
_ ClientState
st ()
_ = ClientState -> IO CommandResult
forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusCert ClientState
st)