{-# Language OverloadedStrings, TemplateHaskell #-}
{-|
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 ( remainingArg, simpleToken )
import Client.Commands.Docs (netDocs, cmdDoc)
import Client.Commands.TabCompletion
import Client.Commands.Types
import Client.Commands.WordCompletion ( plainWordCompleteMode )
import Client.Configuration ( configServers )
import Client.State
import Client.State.Focus (focusNetwork, Focus(NetworkFocus), Subfocus(FocusCert))
import Client.State.Network (csLastReceived, csNetwork, csNick, sendMsg)
import Control.Lens (view, folded, preview, views)
import Data.HashMap.Strict qualified as HashMap
import Data.Text qualified as Text
import Irc.Commands (ircMode, ircQuit)

connectionCommands :: CommandSection
connectionCommands :: CommandSection
connectionCommands = Text -> [Command] -> CommandSection
CommandSection Text
"Connection commands"

  [ forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"connect")
      (forall r. String -> Args r String
simpleToken String
"network")
      $(netDocs `cmdDoc` "connect")
    forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand String
cmdConnect Bool -> ClientCommand String
tabConnect

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"reconnect")
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(netDocs `cmdDoc` "reconnect")
    forall a b. (a -> b) -> a -> b
$ forall a.
ClientCommand a -> (Bool -> ClientCommand String) -> CommandImpl a
ClientCommand ClientCommand ()
cmdReconnect Bool -> ClientCommand String
noClientTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"disconnect")
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(netDocs `cmdDoc` "disconnect")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand ()
cmdDisconnect Bool -> NetworkCommand String
noNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"quit")
      (forall r. String -> Args r String
remainingArg String
"reason")
      $(netDocs `cmdDoc` "quit")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand String
cmdQuit Bool -> NetworkCommand String
simpleNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"cert")
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      $(netDocs `cmdDoc` "cert")
    forall a b. (a -> b) -> a -> b
$ forall a.
NetworkCommand a
-> (Bool -> NetworkCommand String) -> CommandImpl a
NetworkCommand NetworkCommand ()
cmdCert Bool -> NetworkCommand String
noNetworkTab

  , forall a.
NonEmpty Text
-> Args ClientState a -> Text -> CommandImpl a -> Command
Command
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"umode")
      (forall r. String -> Args r String
remainingArg String
"modes")
      $(netDocs `cmdDoc` "umode")
    forall a b. (a -> b) -> a -> b
$ 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 (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Identifier
csNick NetworkState
cs) [Text]
args)
     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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing Text
network forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> ClientState -> IO ClientState
abortNetwork Text
network ClientState
st
     forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
       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)
     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 (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' NetworkState Text
csNetwork NetworkState
cs) ClientState
st
     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 <- forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState Focus
clientFocus Focus -> Maybe Text
focusNetwork ClientState
st =

      do let tm :: Maybe UTCTime
tm = forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState (Maybe UTCTime)
csLastReceived forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Maybe a
Nothing Text
network forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> ClientState -> IO ClientState
abortNetwork Text
network ClientState
st
         forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess
           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
_ =
  forall a.
Prefix a =>
WordCompletionMode
-> [a] -> [a] -> Bool -> ClientState -> IO CommandResult
simpleTabCompletion WordCompletionMode
plainWordCompleteMode [] [Text]
networks Bool
isReversed ClientState
st
  where
    networks :: [Text]
networks = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' ClientState (HashMap Text NetworkState)
clientConnections              forall k v. HashMap k v -> [k]
HashMap.keys ClientState
st
            forall a. [a] -> [a] -> [a]
++ forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views (Lens' ClientState Configuration
clientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Configuration (HashMap Text ServerSettings)
configServers) forall k v. HashMap k v -> [k]
HashMap.keys ClientState
st

cmdCert :: NetworkCommand ()
cmdCert :: NetworkCommand ()
cmdCert NetworkState
_ ClientState
st ()
_ = forall (m :: * -> *). Monad m => ClientState -> m CommandResult
commandSuccess (Subfocus -> ClientState -> ClientState
changeSubfocus Subfocus
FocusCert ClientState
st)