Config.hs

   1 -- This file is part of htalkat
   2 -- Copyright (C) 2021 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 module Config where
  12
  13 import           Safe             (readMay)
  14 import           System.Directory (doesFileExist)
  15 import           System.Exit      (exitFailure)
  16 import           System.FilePath  ((</>))
  17
  18 import           Opts
  19 import           Util
  20
  21 #if !(MIN_VERSION_base(4,11,0))
  22 import           Data.Semigroup
  23 #endif
  24
  25 data Config = Config
  26     { listen_host        :: String
  27     , listen_port        :: Int
  28     , accept_unnamed     :: Bool
  29     , curses_local_top   :: Bool
  30     , curses_log         :: Bool
  31     , use_dumb_client    :: Bool
  32     , interactive_client :: [String]
  33     } deriving (Read)
  34
  35 confFilePath :: FilePath -> FilePath
  36 confFilePath = (</> "htalkat.conf")
  37
  38 defaultConfigFile :: String
  39 defaultConfigFile = unlines
  40     [ "Config"
  41     , "    { listen_host = \"\"  # Empty means bind all available hosts"
  42     , "    , listen_port = 5518"
  43     , "    , accept_unnamed = True  # Accept connections even from unnamed users"
  44     , ""
  45     , "    , curses_local_top = True  # Display you above remote in curses client"
  46     , "    , curses_log = False  # Log conversations to files in ~/.htalkat/logs/"
  47     , ""
  48     , "    , use_dumb_client = False  # Prefer dumb line-based client to curses client"
  49     , ""
  50     , "    # interactive_client: if non-empty, run in place of built-in client."
  51     , "    # First string is the command to run, and subsequent strings are arguments."
  52     , "    # It will be executed with two further arguments:"
  53     , "    # the path to a unix domain socket to interact with,"
  54     , "    # and the name of the remote user."
  55     , "    # Minimal example:"
  56     , "    #, interactive_client = [\"sh\", \"-c\","
  57     , "    #    \"socat unix-connect:\\\"$1\\\" stdio\", \"talkatc\"]"
  58     , "    , interactive_client = []"
  59     , "    }"
  60     ]
  61
  62 applyOptToConf :: Opt -> Config -> Config
  63 applyOptToConf (Host h) conf = conf { listen_host = h }
  64 applyOptToConf (Port pStr) conf | Just p <- readMay pStr = conf { listen_port = p }
  65 applyOptToConf AcceptUnnamed conf = conf { accept_unnamed = True }
  66 applyOptToConf BlockUnnamed conf = conf { accept_unnamed = False }
  67 applyOptToConf DumbClient conf = conf { use_dumb_client = True }
  68 applyOptToConf CursesClient conf = conf { use_dumb_client = False }
  69 applyOptToConf LocalTop conf = conf { curses_local_top = True }
  70 applyOptToConf LocalBottom conf = conf { curses_local_top = False }
  71 applyOptToConf Log conf = conf { curses_log = True }
  72 applyOptToConf NoLog conf = conf { curses_log = False }
  73 applyOptToConf _ conf = conf
  74
  75 createConfigFileIfNecessary :: FilePath -> IO ()
  76 createConfigFileIfNecessary ddir =
  77     let cpath = confFilePath ddir
  78     in doesFileExist cpath >>! writeFile cpath defaultConfigFile
  79
  80 loadConfig :: FilePath -> IO Config
  81 loadConfig ddir = do
  82     createConfigFileIfNecessary ddir
  83     s <- readFile (confFilePath ddir)
  84     case readReadConfig (confFilePath ddir) s of
  85         Left err   -> putStrLn err >> exitFailure >> undefined
  86         Right conf -> pure conf
  87
  88 readReadConfig :: FilePath -> String -> Either String Config
  89 readReadConfig path s =
  90     -- Based on https://hackage.haskell.org/package/tce-conf by Dino Morelli
  91     case reads $ removeComments s of
  92         [(c, _)    ] -> Right c
  93         ((_, x) : _) -> Left $ "ERROR parsing config file: " <> x <> hint
  94         [          ] -> Left $ "ERROR parsing config file" <> hint
  95     where
  96     hint = "; to recreate, remove " <> path <> " and try again."
  97     removeComments :: String -> String
  98     removeComments = unlines . map removeComment . lines
  99     removeComment = takeWhile (/= '#')