{-# Language OverloadedStrings #-}
{-|
Module      : Client.Commands.Connection
Description : Connection command implementations
Copyright   : (c) Eric Mertens, 2016-2020
License     : ISC
Maintainer  : emertens@gmail.com
-}

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 -- abort any existing connection before connecting
     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'

-- | Reconnect to the currently focused network. It's possible
-- that we're not currently connected to a network, so
-- this is implemented as a client command.
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

-- | @/connect@ tab completes known server names
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)