content: {-# Language BlockArguments, OverloadedStrings, TemplateHaskell #-}
  {-|
  Module      : Client.Commands.Operator
  Description : Operator command implementations
  Copyright   : (c) Eric Mertens, 2016-2020
  License     : ISC
  Maintainer  : emertens@gmail.com
  -}
  
  module Client.Commands.Operator (operatorCommands) where
  
  import Client.Commands.Arguments.Spec (Args, optionalArg, remainingArg, simpleToken, extensionArg)
  import Client.Commands.Docs (operDocs, cmdDoc)
  import Client.Commands.TabCompletion (noNetworkTab, simpleNetworkTab)
  import Client.Commands.Types
  import Client.State.Network (sendMsg)
  import Control.Applicative (liftA2, liftA3)
  import Data.Maybe (fromMaybe, maybeToList)
  import Data.Text (Text)
  import Data.Text qualified as Text
  import Irc.Commands
  import Irc.RawIrcMsg (rawIrcMsg)
  
  operatorCommands :: CommandSection
  operatorCommands = CommandSection "Network operator commands"
  
    [ Command
        (pure "oper")
        (liftA2 (,) (simpleToken "user") (simpleToken "password"))
        $(operDocs `cmdDoc` "oper")
      $ NetworkCommand cmdOper noNetworkTab
  
    , Command
        (pure "kill")
        (liftA2 (,) (simpleToken "client") (remainingArg "reason"))
        $(operDocs `cmdDoc` "kill")
      $ NetworkCommand cmdKill simpleNetworkTab
  
    , Command
        (pure "kline")
        (liftA3 (,,) (extensionArg "minutes|on" banLineArgs) (simpleToken "user@host") (remainingArg "reason"))
        $(operDocs `cmdDoc` "kline")
      $ NetworkCommand (cmdBanLine "KLINE") simpleNetworkTab -- Don't use ircKline because it doesn't do remotes.
  
    , Command
        (pure "dline")
        (liftA3 (,,) (extensionArg "minutes|on" banLineArgs) (simpleToken "ip") (remainingArg "reason"))
        $(operDocs `cmdDoc` "dline")
      $ NetworkCommand (cmdBanLine "DLINE") noNetworkTab
  
    , Command
        (pure "xline")
        (liftA3 (,,) (extensionArg "minutes|on" banLineArgs) (simpleToken "gecos") (remainingArg "reason"))
        $(operDocs `cmdDoc` "xline")
      $ NetworkCommand (cmdBanLine "XLINE") noNetworkTab
  
    , Command
        (pure "resv")
        (liftA3 (,,) (extensionArg "minutes|on" banLineArgs) (simpleToken "nick|channel") (remainingArg "reason"))
        $(operDocs `cmdDoc` "resv")
      $ NetworkCommand (cmdBanLine "RESV") noNetworkTab
  
    , Command
        (pure "unkline")
        (liftA2 (,) (simpleToken "[user@]host") (optionalArg (simpleToken "[servername]")))
        $(operDocs `cmdDoc` "unkline")
      $ NetworkCommand cmdUnkline simpleNetworkTab
  
    , Command
        (pure "undline")
        (liftA2 (,) (simpleToken "host") (optionalArg (simpleToken "[servername]")))
        $(operDocs `cmdDoc` "undline")
      $ NetworkCommand cmdUndline simpleNetworkTab
  
    , Command
        (pure "unxline")
        (liftA2 (,) (simpleToken "gecos") (optionalArg (simpleToken "[servername]")))
        $(operDocs `cmdDoc` "unxline")
      $ NetworkCommand cmdUnxline simpleNetworkTab
  
    , Command
        (pure "unresv")
        (liftA2 (,) (simpleToken "channel|nick") (optionalArg (simpleToken "[servername]")))
        $(operDocs `cmdDoc` "unresv")
      $ NetworkCommand cmdUnresv simpleNetworkTab
  
    , Command
        (pure "testline")
        (simpleToken "[[nick!]user@]host")
        $(operDocs `cmdDoc` "testline")
      $ NetworkCommand cmdTestline simpleNetworkTab
  
    , Command
        (pure "testkline")
        (simpleToken "[user@]host")
        $(operDocs `cmdDoc` "testkline")
      $ NetworkCommand cmdTestkline simpleNetworkTab
  
    , Command
        (pure "testgecos")
        (simpleToken "gecos")
        $(operDocs `cmdDoc` "testgecos")
      $ NetworkCommand cmdTestGecos simpleNetworkTab
  
    , Command
        (pure "testmask")
        (liftA2 (,) (simpleToken "[nick!]user@host") (remainingArg "[gecos]"))
        $(operDocs `cmdDoc` "testmask")
      $ NetworkCommand cmdTestmask simpleNetworkTab
  
    , Command
        (pure "masktrace")
        (liftA2 (,) (simpleToken "[nick!]user@host") (remainingArg "[gecos]"))
        $(operDocs `cmdDoc` "masktrace")
      $ NetworkCommand cmdMasktrace simpleNetworkTab
  
    , Command
        (pure "chantrace")
        (simpleToken "channel")
        $(operDocs `cmdDoc` "chantrace")
      $ NetworkCommand cmdChantrace simpleNetworkTab
  
    , Command
        (pure "trace")
        (optionalArg (liftA2 (,) (simpleToken "[server|nick]") (optionalArg (simpleToken "[location]"))))
        $(operDocs `cmdDoc` "trace")
      $ NetworkCommand cmdTrace simpleNetworkTab
  
    , Command
        (pure "etrace")
        (optionalArg (simpleToken "[-full|-v4|-v6|nick]"))
        $(operDocs `cmdDoc` "etrace")
      $ NetworkCommand cmdEtrace simpleNetworkTab
  
    , Command
        (pure "map")
        (pure ())
        $(operDocs `cmdDoc` "map")
      $ NetworkCommand cmdMap simpleNetworkTab
  
    , Command
        (pure "sconnect")
        (liftA2 (,) (simpleToken "connect_to") (optionalArg (liftA2 (,) (simpleToken "[port]") (optionalArg (simpleToken "[remote]")))))
        $(operDocs `cmdDoc` "sconnect")
      $ NetworkCommand cmdSconnect simpleNetworkTab
  
    , Command
        (pure "squit")
        (liftA2 (,) (simpleToken "server") (remainingArg "[reason]"))
        $(operDocs `cmdDoc` "squit")
      $ NetworkCommand cmdSquit simpleNetworkTab
  
    , Command
        (pure "modload")
        (liftA2 (,) (simpleToken "[path/]module") (optionalArg (simpleToken "[remote]")))
        $(operDocs `cmdDoc` "modload")
      $ NetworkCommand cmdModload simpleNetworkTab
  
    , Command
        (pure "modunload")
        (liftA2 (,) (simpleToken "module") (optionalArg (simpleToken "[remote]")))
        $(operDocs `cmdDoc` "modunload")
      $ NetworkCommand cmdModunload simpleNetworkTab
  
    , Command
        (pure "modlist")
        (optionalArg (liftA2 (,) (simpleToken "pattern") (optionalArg (simpleToken "[remote]"))))
        $(operDocs `cmdDoc` "modlist")
      $ NetworkCommand cmdModlist simpleNetworkTab
  
    , Command
        (pure "modrestart")
        (optionalArg (simpleToken "[server]"))
        $(operDocs `cmdDoc` "modrestart")
      $ NetworkCommand cmdModrestart simpleNetworkTab
  
    , Command
        (pure "modreload")
        (liftA2 (,) (simpleToken "module") (optionalArg (simpleToken "[remote]")))
        $(operDocs `cmdDoc` "modreload")
      $ NetworkCommand cmdModreload simpleNetworkTab
  
    , Command
        (pure "grant")
        (liftA2 (,) (simpleToken "target") (simpleToken "privset"))
        $(operDocs `cmdDoc` "grant")
      $ NetworkCommand cmdGrant simpleNetworkTab
  
    , Command
        (pure "privs")
        (optionalArg (simpleToken "[target]"))
        $(operDocs `cmdDoc` "privs")
      $ NetworkCommand cmdPrivs simpleNetworkTab
  
    ]
  
  cmdGrant :: NetworkCommand (String, String)
  cmdGrant cs st (target, privset) =
    do sendMsg cs (rawIrcMsg "GRANT" (Text.pack <$> [target, privset]))
       commandSuccess st
  
  cmdPrivs :: NetworkCommand (Maybe String)
  cmdPrivs cs st mbTarget =
    do sendMsg cs (rawIrcMsg "PRIVS" (Text.pack <$> maybeToList mbTarget))
       commandSuccess st
  
  cmdModlist :: NetworkCommand (Maybe (String, Maybe String))
  cmdModlist cs st args =
    do let argList = case args of
                       Nothing -> []
                       Just (x, xs) -> x : maybeToList xs
       sendMsg cs (rawIrcMsg "MODLIST" (Text.pack <$> argList))
       commandSuccess st
  
  cmdModrestart :: NetworkCommand (Maybe String)
  cmdModrestart cs st args =
    do sendMsg cs (rawIrcMsg "MODRESTART" (Text.pack <$> maybeToList args))
       commandSuccess st
  
  cmdModload :: NetworkCommand (String, Maybe String)
  cmdModload cs st (mod_, remote) =
    do sendMsg cs (rawIrcMsg "MODLOAD" (Text.pack <$> (mod_ : maybeToList remote)))
       commandSuccess st
  
  cmdModunload :: NetworkCommand (String, Maybe String)
  cmdModunload cs st (mod_, remote) =
    do sendMsg cs (rawIrcMsg "MODUNLOAD" (Text.pack <$> (mod_ : maybeToList remote)))
       commandSuccess st
  
  cmdModreload :: NetworkCommand (String, Maybe String)
  cmdModreload cs st (mod_, remote) =
    do sendMsg cs (rawIrcMsg "MODRELOAD" (Text.pack <$> (mod_ : maybeToList remote)))
       commandSuccess st
  
  cmdSquit :: NetworkCommand (String, String)
  cmdSquit cs st (server, reason) =
    do sendMsg cs (rawIrcMsg "SQUIT" (Text.pack <$> [server, reason]))
       commandSuccess st
  
  cmdSconnect :: NetworkCommand (String, Maybe (String, Maybe String))
  cmdSconnect cs st (server, rest) =
    do let args = case rest of
                    Nothing -> [server]
                    Just (x, xs) -> server : x : maybeToList xs
       sendMsg cs (rawIrcMsg "CONNECT" (Text.pack <$> args))
       commandSuccess st
  
  cmdKill :: NetworkCommand (String, String)
  cmdKill cs st (client,rest) =
    do sendMsg cs (ircKill (Text.pack client) (Text.pack rest))
       commandSuccess st
  
  cmdBanLine :: Text -> NetworkCommand ((Maybe String, String), String, String)
  cmdBanLine lineName cs st ((server, duration), target, reason) = do
    let
      remote = case server of
        Just server' -> ["ON", Text.pack server']
        Nothing      -> []
      args = [Text.pack duration, Text.pack target] ++ remote ++ [Text.pack reason]
    sendMsg cs (rawIrcMsg lineName args)
    commandSuccess st
  
  banLineArgs :: ArgsContext -> String -> Maybe (Args ArgsContext (Maybe String, String))
  banLineArgs _ "on" = Just (liftA2 (,) (Just <$> simpleToken "servername") (simpleToken "minutes"))
  banLineArgs _ mins = Just (liftA2 (,) (pure Nothing) (pure mins))
  
  cmdUnkline :: NetworkCommand (String, Maybe String)
  cmdUnkline cs st (mask, server) =
    do sendMsg cs (ircUnkline (Text.pack mask) (Text.pack <$> server))
       commandSuccess st
  
  cmdUndline :: NetworkCommand (String, Maybe String)
  cmdUndline cs st (mask, server) =
    do sendMsg cs (ircUndline (Text.pack mask) (Text.pack <$> server))
       commandSuccess st
  
  cmdUnxline :: NetworkCommand (String, Maybe String)
  cmdUnxline cs st (mask, server) =
    do sendMsg cs (ircUnxline (Text.pack mask) (Text.pack <$> server))
       commandSuccess st
  
  cmdUnresv :: NetworkCommand (String, Maybe String)
  cmdUnresv cs st (mask, server) =
    do sendMsg cs (ircUnresv (Text.pack mask) (Text.pack <$> server))
       commandSuccess st
  
  cmdTestline :: NetworkCommand String
  cmdTestline cs st mask =
    do sendMsg cs (ircTestline (Text.pack mask))
       commandSuccess st
  
  cmdTestkline :: NetworkCommand String
  cmdTestkline cs st mask =
    do sendMsg cs (rawIrcMsg "TESTKLINE" [Text.pack mask])
       commandSuccess st
  
  cmdTestGecos :: NetworkCommand String
  cmdTestGecos cs st mask =
    do sendMsg cs (rawIrcMsg "TESTGECOS" [Text.pack mask])
       commandSuccess st
  
  cmdTestmask :: NetworkCommand (String, String)
  cmdTestmask cs st (mask, gecos) =
    do sendMsg cs (ircTestmask (Text.pack mask) (Text.pack gecos))
       commandSuccess st
  
  cmdMasktrace :: NetworkCommand (String, String)
  cmdMasktrace cs st (mask, gecos) =
    do sendMsg cs (ircMasktrace (Text.pack mask) (Text.pack gecos))
       commandSuccess st
  
  cmdChantrace :: NetworkCommand String
  cmdChantrace cs st chan =
    do sendMsg cs (ircChantrace (Text.pack chan))
       commandSuccess st
  
  cmdEtrace :: NetworkCommand (Maybe String)
  cmdEtrace cs st arg =
    do sendMsg cs (ircEtrace (Text.pack (fromMaybe "" arg)))
       commandSuccess st
  
  cmdTrace :: NetworkCommand (Maybe (String, Maybe String))
  cmdTrace cs st args =
    do let argsList =
             case args of
              Nothing           -> []
              Just (x, Nothing) -> [x]
              Just (x, Just y)  -> [x, y]
       sendMsg cs (ircTrace (map Text.pack argsList))
       commandSuccess st
  
  cmdMap :: NetworkCommand ()
  cmdMap cs st _ =
    do sendMsg cs ircMap
       commandSuccess st
  
  cmdOper :: NetworkCommand (String, String)
  cmdOper cs st (user, pass) =
    do sendMsg cs (ircOper (Text.pack user) (Text.pack pass))
       commandSuccess st
  