simplex-chat/apps/simplex-directory-service/src/Directory/Options.hs

{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Directory.Options
  ( DirectoryOpts (..),
    MigrateLog (..),
    getDirectoryOpts,
    directoryOpts,
    mkChatOpts,
  )
where

import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Options.Applicative
import Simplex.Chat.Bot.KnownContacts
import Simplex.Chat.Controller (updateStr, versionNumber, versionString)
import Simplex.Chat.Options (ChatCmdLog (..), ChatOpts (..), CoreChatOpts, CreateBotOpts (..), coreChatOptsP)
import Simplex.Messaging.Parsers (parseAll)

data DirectoryOpts = DirectoryOpts
  { coreOptions :: CoreChatOpts,
    adminUsers :: [KnownContact],
    superUsers :: [KnownContact],
    ownersGroup :: Maybe KnownGroup,
    noAddress :: Bool, -- skip creating address
    blockedWordsFile :: Maybe FilePath,
    blockedFragmentsFile :: Maybe FilePath,
    blockedExtensionRules :: Maybe FilePath,
    nameSpellingFile :: Maybe FilePath,
    profileNameLimit :: Int,
    captchaGenerator :: Maybe FilePath,
    voiceCaptchaGenerator :: Maybe FilePath,
    directoryLog :: Maybe FilePath,
    migrateDirectoryLog :: Maybe MigrateLog,
    serviceName :: T.Text,
    clientService :: Bool,
    runCLI :: Bool,
    searchResults :: Int,
    webFolder :: Maybe FilePath,
    linkCheckInterval :: Int,
    prohibitedToObserver :: Bool,
    alwaysCaptcha :: Bool,
    knocking :: Bool,
    testing :: Bool
  }

data MigrateLog = MLCheck | MLImport | MLExport | MLListing

directoryOpts :: FilePath -> FilePath -> Parser DirectoryOpts
directoryOpts appDir defaultDbName = do
  coreOptions <- coreChatOptsP appDir defaultDbName
  adminUsers <-
    option
      parseKnownContacts
      ( long "admin-users"
          <> metavar "ADMIN_USERS"
          <> value []
          <> help "Comma-separated list of admin-users in the format CONTACT_ID:DISPLAY_NAME who will be allowed to manage the directory"
      )
  superUsers <-
    option
      parseKnownContacts
      ( long "super-users"
          <> metavar "SUPER_USERS"
          <> help "Comma-separated list of super-users in the format CONTACT_ID:DISPLAY_NAME who will be allowed to manage the directory"
      )
  ownersGroup <-
    optional $
      option
        parseKnownGroup
        ( long "owners-group"
            <> metavar "OWNERS_GROUP"
            <> help "The group of group owners in the format GROUP_ID:DISPLAY_NAME - owners of listed groups will be invited automatically"
        )
  noAddress <-
    switch
      ( long "no-address"
          <> help "skip checking and creating service address"
      )
  blockedWordsFile <-
    optional $
      strOption
        ( long "blocked-words-file"
            <> metavar "BLOCKED_WORDS_FILE"
            <> help "File with the basic forms of words not allowed in profiles"
        )
  blockedFragmentsFile <-
    optional $
      strOption
        ( long "blocked-fragments-file"
            <> metavar "BLOCKED_WORDS_FILE"
            <> help "File with the basic forms of word fragments not allowed in profiles"
        )
  blockedExtensionRules <-
    optional $
      strOption
        ( long "blocked-extenstion-rules"
            <> metavar "BLOCKED_EXTENSION_RULES"
            <> help "Substitions to extend the list of blocked words"
        )
  nameSpellingFile <-
    optional $
      strOption
        ( long "name-spelling-file"
            <> metavar "NAME_SPELLING_FILE"
            <> help "File with the character substitions to match in profile names"
        )
  profileNameLimit <-
    option
      auto
      ( long "profile-name-limit"
          <> metavar "PROFILE_NAME_LIMIT"
          <> help "Max length of profile name that will be allowed to connect and to join groups"
          <> value maxBound
      )
  captchaGenerator <-
    optional $
      strOption
        ( long "captcha-generator"
            <> metavar "CAPTCHA_GENERATOR"
            <> help "Executable to generate captcha files, must accept text as parameter and save file to stdout as base64 up to 12500 bytes"
        )
  voiceCaptchaGenerator <-
    optional $
      strOption
        ( long "voice-captcha-generator"
            <> metavar "VOICE_CAPTCHA_GENERATOR"
            <> help "Executable to generate voice captcha, accepts text as parameter, writes audio file, outputs file_path and duration_seconds to stdout"
        )
  directoryLog <-
    optional $
      strOption
        ( long "directory-file"
            <> metavar "DIRECTORY_FILE"
            <> help "Append only log for directory state"
        )
  migrateDirectoryLog <-
    optional $
      option
        parseMigrateLog
        ( long "migrate-directory-file"
            <> metavar "MIGRATE_COMMAND"
            <> help "Command to import/export directory log file"
        )
  serviceName <-
    strOption
      ( long "service-name"
          <> metavar "SERVICE_NAME"
          <> help "The display name of the directory service bot, without *'s and spaces (SimpleX Directory)"
          <> value "SimpleX Directory"
      )
  clientService <-
    switch
      ( long "client-service"
          <> help "Use client service certificate"
      )
  runCLI <-
    switch
      ( long "run-cli"
          <> help "Run directory service as CLI"
      )
  webFolder <-
    optional $
      strOption
        ( long "web-folder"
            <> metavar "WEB_FOLDER"
            <> help "Folder to store static web assets"
        )
  linkCheckInterval <-
    option
      auto
      ( long "link-check-interval"
          <> metavar "SECONDS"
          <> help "Interval in seconds to check public group link data (default: 1800)"
          <> value 1800
      )
  prohibitedToObserver <-
    switch
      ( long "prohibited-to-observer"
          <> help "Set a member to observer (and delete the message) when they post content prohibited by the group's settings"
      )
  alwaysCaptcha <-
    switch
      ( long "always-captcha"
          <> help "Require a captcha from joining members in all groups, regardless of per-group filter settings"
      )
  knocking <-
    switch
      ( long "knocking"
          <> help "Require admin review (knocking) before joining members are admitted in all groups, regardless of group preference"
      )
  pure
    DirectoryOpts
      { coreOptions,
        adminUsers,
        superUsers,
        ownersGroup,
        noAddress,
        blockedWordsFile,
        blockedFragmentsFile,
        blockedExtensionRules,
        nameSpellingFile,
        profileNameLimit,
        captchaGenerator,
        voiceCaptchaGenerator,
        directoryLog,
        migrateDirectoryLog,
        serviceName = T.pack serviceName,
        clientService,
        runCLI,
        searchResults = 10,
        webFolder,
        linkCheckInterval,
        prohibitedToObserver,
        alwaysCaptcha,
        knocking,
        testing = False
      }

getDirectoryOpts :: FilePath -> FilePath -> IO DirectoryOpts
getDirectoryOpts appDir defaultDbName =
  execParser $
    info
      (helper <*> versionOption <*> directoryOpts appDir defaultDbName)
      (header versionStr <> fullDesc <> progDesc "Start SimpleX Directory Service with DB_FILE, DIRECTORY_FILE and SUPER_USERS options")
  where
    versionStr = versionString versionNumber
    versionOption = infoOption versionAndUpdate (long "version" <> short 'v' <> help "Show version")
    versionAndUpdate = versionStr <> "\n" <> updateStr

mkChatOpts :: DirectoryOpts -> ChatOpts
mkChatOpts DirectoryOpts {coreOptions, serviceName, clientService} =
  ChatOpts
    { coreOptions,
      chatCmd = "",
      chatCmdDelay = 3,
      chatCmdLog = CCLNone,
      chatServerPort = Nothing,
      optFilesFolder = Nothing,
      optTempDirectory = Nothing,
      showReactions = False,
      allowInstantFiles = True,
      autoAcceptFileSize = 0,
      muteNotifications = True,
      markRead = False,
      createBot = Just CreateBotOpts {botDisplayName = serviceName, allowFiles = False, clientService}
    }

parseMigrateLog :: ReadM MigrateLog
parseMigrateLog = eitherReader $ parseAll mlP . encodeUtf8 . T.pack
  where
    mlP =
      A.takeTill (== ' ') >>= \case
        "check" -> pure MLCheck
        "import" -> pure MLImport
        "export" -> pure MLExport
        "listing" -> pure MLListing
        _ -> fail "bad MigrateLog"