module Network.AMQP.Utils.Options where

import Data.Default.Class
import qualified Data.Map as M
import Data.Maybe
import Data.Text (Text, pack)
import Data.Version (showVersion)
import Network.AMQP
import Network.AMQP.Types
import Paths_amqp_utils (version)
import System.Console.GetOpt

-- | A data type for our options
data Args = Args
  { server :: String
  , port :: Int
  , tls :: Bool
  , vHost :: String
  , currentExchange :: String
  , bindings :: [(String, String)]
  , rKey :: String
  , anRiss :: Maybe Int
  , fileProcess :: Maybe String
  , qName :: Maybe String
  , cert :: Maybe String
  , key :: Maybe String
  , user :: String
  , pass :: String
  , preFetch :: Int
  , heartBeat :: Maybe Int
  , tempDir :: Maybe String
  , additionalArgs :: [String]
  , connectionName :: Maybe String
  , tmpQName :: String
  , inputFile :: String
  , outputFile :: String
  , lineMode :: Bool
  , confirm :: Bool
  , msgid :: Maybe Text
  , msgtype :: Maybe Text
  , userid :: Maybe Text
  , appid :: Maybe Text
  , clusterid :: Maybe Text
  , contenttype :: Maybe Text
  , contentencoding :: Maybe Text
  , replyto :: Maybe Text
  , prio :: Maybe Octet
  , corrid :: Maybe Text
  , msgexp :: Maybe Text
  , msgheader :: Maybe FieldTable
  , fnheader :: [String]
  , suffix :: [String]
  , magic :: Bool
  , persistent :: Maybe DeliveryMode
  , ack :: Bool
  , requeuenack :: Bool
  , rpc_timeout :: Double
  , connect_timeout :: Int
  }

instance Default Args where
  def =
    Args
      "localhost"
      5672
      False
      "/"
      ""
      []
      ""
      Nothing
      Nothing
      Nothing
      Nothing
      Nothing
      "guest"
      "guest"
      1
      Nothing
      Nothing
      []
      Nothing
      ""
      "/dev/stdin"
      "/dev/stdout"
      False
      False
      Nothing
      Nothing
      Nothing
      Nothing
      Nothing
      Nothing
      Nothing
      Nothing
      Nothing
      Nothing
      Nothing
      Nothing
      []
      []
      False
      Nothing
      True
      True
      5
      60

-- | all options
allOptions :: [(String, OptDescr (Args -> Args))]
allOptions =
  [ ( "k"
    , Option
        ['r']
        ["bindingkey"]
        (ReqArg
           (\s o -> o {bindings = (currentExchange o, s) : (bindings o)})
           "BINDINGKEY")
        ("AMQP binding key (default: #)"))
  , ( "kr"
    , Option
        ['X']
        ["execute"]
        (OptArg
           (\s o ->
              o
                { fileProcess = Just (fromMaybe callback s)
                , tempDir = Just (fromMaybe "/tmp" (tempDir o))
                })
           "EXE")
        ("Callback Script File (implies -t) (-X without arg: " ++
         callback ++ ")"))
  , ( "kr"
    , Option
        ['a']
        ["args"]
        (ReqArg (\s o -> o {additionalArgs = s : (additionalArgs o)}) "ARG")
        "additional argument for -X callback")
  , ( "kr"
    , Option
        ['t']
        ["tempdir", "target"]
        (OptArg (\s o -> o {tempDir = Just (fromMaybe "/tmp" s)}) "DIR")
        "tempdir (default: no file creation, -t without arg: /tmp)")
  , ( "k"
    , Option
        ['f']
        ["prefetch"]
        (ReqArg (\s o -> o {preFetch = read s}) "INT")
        ("Prefetch count. (0=unlimited, 1=off, default: " ++
         show (preFetch def) ++ ")"))
  , ( "kr"
    , Option
        ['A']
        ["ack"]
        (NoArg (\o -> o {ack = not (ack o)}))
        ("Toggle ack messages (default: " ++ show (ack def) ++ ")"))
  , ( "kr"
    , Option
        ['R']
        ["requeuenack"]
        (NoArg (\o -> o {requeuenack = not (requeuenack o)}))
        ("Toggle requeue when rejected (default: " ++
         show (requeuenack def) ++ ")"))
  , ( "a"
    , Option
        ['r']
        ["routingkey"]
        (ReqArg (\s o -> o {rKey = s}) "ROUTINGKEY")
        "AMQP routing key")
  , ( "ap"
    , Option
        ['f']
        ["inputfile"]
        (ReqArg (\s o -> o {inputFile = s}) "INPUTFILE")
        ("Message input file (default: " ++ (inputFile def) ++ ")"))
  , ( "p"
    , Option
        ['O']
        ["outputfile"]
        (ReqArg (\s o -> o {outputFile = s}) "OUTPUTFILE")
        ("Message output file (default: " ++ (outputFile def) ++ ")"))
  , ( "a"
    , Option
        ['l']
        ["linemode"]
        (NoArg (\o -> o {lineMode = not (lineMode o)}))
        ("Toggle line-by-line mode (default: " ++ show (lineMode def) ++ ")"))
  , ( "a"
    , Option
        ['C']
        ["confirm"]
        (NoArg (\o -> o {confirm = not (confirm o)}))
        ("Toggle confirms (default: " ++ show (confirm def) ++ ")"))
  , ( "a"
    , Option
        []
        ["msgid"]
        (ReqArg (\s o -> o {msgid = Just $ pack s}) "ID")
        "Message ID")
  , ( "a"
    , Option
        []
        ["type"]
        (ReqArg (\s o -> o {msgtype = Just $ pack s}) "TYPE")
        "Message Type")
  , ( "a"
    , Option
        []
        ["userid"]
        (ReqArg (\s o -> o {userid = Just $ pack s}) "USERID")
        "Message User-ID")
  , ( "a"
    , Option
        []
        ["appid"]
        (ReqArg (\s o -> o {appid = Just $ pack s}) "APPID")
        "Message App-ID")
  , ( "a"
    , Option
        []
        ["clusterid"]
        (ReqArg (\s o -> o {clusterid = Just $ pack s}) "CLUSTERID")
        "Message Cluster-ID")
  , ( "a"
    , Option
        []
        ["contenttype"]
        (ReqArg (\s o -> o {contenttype = Just $ pack s}) "CONTENTTYPE")
        "Message Content-Type")
  , ( "a"
    , Option
        []
        ["contentencoding"]
        (ReqArg (\s o -> o {contentencoding = Just $ pack s}) "CONTENTENCODING")
        "Message Content-Encoding")
  , ( "a"
    , Option
        []
        ["replyto"]
        (ReqArg (\s o -> o {replyto = Just $ pack s}) "REPLYTO")
        "Message Reply-To")
  , ( "p"
    , Option
        ['t']
        ["rpc_timeout"]
        (ReqArg (\s o -> o {rpc_timeout = read s}) "SECONDS")
        ("How long to wait for reply (default: " ++ show (rpc_timeout def) ++ ")"))
  , ( "a"
    , Option
        []
        ["prio"]
        (ReqArg (\s o -> o {prio = Just $ read s}) "PRIO")
        "Message Priority")
  , ( "ap"
    , Option
        []
        ["corrid"]
        (ReqArg (\s o -> o {corrid = Just $ pack s}) "CORRID")
        "Message CorrelationID")
  , ( "ap"
    , Option
        []
        ["exp"]
        (ReqArg (\s o -> o {msgexp = Just $ pack s}) "EXP")
        "Message Expiration")
  , ( "ap"
    , Option
        ['h']
        ["header"]
        (ReqArg
           (\s o -> o {msgheader = addheader (msgheader o) s})
           "HEADER=VALUE")
        "Message Headers")
  , ( "a"
    , Option
        ['F']
        ["fnheader"]
        (ReqArg (\s o -> o {fnheader = s : (fnheader o)}) "HEADERNAME")
        "Put filename into this header")
  , ( "a"
    , Option
        ['S']
        ["suffix"]
        (ReqArg (\s o -> o {suffix = s : (suffix o)}) "SUFFIX")
        "Allowed file suffixes in hotfolder mode")
  , ( "a"
    , Option
        ['m']
        ["magic"]
        (NoArg (\o -> o {magic = not (magic o)}))
        ("Toggle setting content-type and -encoding from file contents (default: " ++
         show (magic def) ++ ")"))
  , ( "a"
    , Option
        ['e']
        ["persistent"]
        (NoArg (\o -> o {persistent = Just Persistent}))
        "Set persistent delivery")
  , ( "a"
    , Option
        ['E']
        ["nonpersistent"]
        (NoArg (\o -> o {persistent = Just NonPersistent}))
        "Set nonpersistent delivery")
  , ( "krp"
    , Option
        ['l']
        ["charlimit"]
        (ReqArg (\s o -> o {anRiss = Just (read s :: Int)}) "INT")
        "limit number of shown body chars (default: unlimited)")
  , ( "kr"
    , Option
        ['q']
        ["queue"]
        (ReqArg (\s o -> o {qName = Just s}) "QUEUENAME")
        "Ignore Exchange and bind to existing Queue")
  , ( "krp"
    , Option
        ['Q']
        ["qname"]
        (ReqArg (\s o -> o {tmpQName = s}) "TEMPQNAME")
        "Name for temporary exclusive Queue")
  , ( "akp"
    , Option
        ['x']
        ["exchange"]
        (ReqArg (\s o -> o {currentExchange = s}) "EXCHANGE")
        ("AMQP Exchange (default: \"\")"))
  , ( "akrp"
    , Option
        ['o']
        ["server"]
        (ReqArg (\s o -> o {server = s}) "SERVER")
        ("AMQP Server (default: " ++ server def ++ ")"))
  , ( "akrp"
    , Option
        ['y']
        ["vhost"]
        (ReqArg (\s o -> o {vHost = s}) "VHOST")
        ("AMQP Virtual Host (default: " ++ vHost def ++ ")"))
  , ( "akrp"
    , Option
        ['p']
        ["port"]
        (ReqArg (\s o -> o {port = read s}) "PORT")
        ("Server Port Number (default: " ++ show (port def) ++ ")"))
  , ( "akrp"
    , Option
        ['T']
        ["tls"]
        (NoArg (\o -> o {tls = not (tls o)}))
        ("Toggle TLS (default: " ++ show (tls def) ++ ")"))
  , ( "akrp"
    , Option
        ['c']
        ["cert"]
        (ReqArg (\s o -> o {cert = Just s}) "CERTFILE")
        ("TLS Client Certificate File"))
  , ( "akrp"
    , Option
        ['k']
        ["key"]
        (ReqArg (\s o -> o {key = Just s}) "KEYFILE")
        ("TLS Client Private Key File"))
  , ( "akrp"
    , Option
        ['U']
        ["user"]
        (ReqArg (\s o -> o {user = s}) "USERNAME")
        ("Username for Auth"))
  , ( "akrp"
    , Option
        ['P']
        ["pass"]
        (ReqArg (\s o -> o {pass = s}) "PASSWORD")
        ("Password for Auth"))
  , ( "akrp"
    , Option
        ['s']
        ["heartbeats"]
        (ReqArg (\s o -> o {heartBeat = (Just (read s))}) "INT")
        "heartbeat interval (0=disable, default: set by server)")
  , ( "akrp"
    , Option
        ['n']
        ["name"]
        (ReqArg (\s o -> o {connectionName = Just s}) "NAME")
        "connection name, will be shown in RabbitMQ web interface")
  , ( "akrp"
    , Option
        ['w']
        ["connect_timeout"]
        (ReqArg (\s o -> o {connect_timeout = read s}) "SECONDS")
        ("timeout for establishing initial connection (default: " ++ show (connect_timeout def) ++ ")"))
  ]

-- | Options for the executables
options :: Char -> [OptDescr (Args -> Args)]
options exename = map snd $ filter ((elem exename) . fst) allOptions

-- | Add a header with a String value
addheader :: Maybe FieldTable -> String -> Maybe FieldTable
addheader Nothing string = Just $ FieldTable $ M.singleton (getkey string) (getval string)
addheader (Just (FieldTable oldheader)) string =
  Just $ FieldTable $ M.insert (getkey string) (getval string) oldheader

getkey :: String -> Text
getkey s = pack $ takeWhile (/= '=') s

getval :: String -> FieldValue
getval s = FVString $ pack $ tail $ dropWhile (/= '=') s

-- | 'parseargs' exename argstring
-- applies options onto argstring
parseargs :: Char -> [String] -> IO Args
parseargs exename argstring =
  case getOpt Permute opt argstring of
    (o, [], []) -> return $ foldl (flip id) def o
    (_, _, errs) ->
      ioError $ userError $ concat errs ++ usageInfo (usage exename) opt
  where
    opt = options exename

-- | the default callback for the -X option
callback :: String
callback = "/usr/lib/haskell-amqp-utils/callback"

usage :: Char -> String
usage exename =
  "\n\
  \amqp-utils " ++
  (showVersion version) ++
  "\n\n\
  \Usage:\n" ++
  (longname exename) ++
  " [options]\n\n\
  \Options:"

longname :: Char -> String
longname 'a' = "agitprop"
longname 'k' = "konsum"
longname 'r' = "arbeite"
longname 'p' = "plane"
longname _ = "command"