{-# LANGUAGE TemplateHaskell #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Galley.Options
  ( Settings,
    httpPoolSize,
    maxTeamSize,
    maxFanoutSize,
    exposeInvitationURLsTeamAllowlist,
    maxConvSize,
    intraListing,
    disabledAPIVersions,
    conversationCodeURI,
    multiIngress,
    concurrentDeletionEvents,
    deleteConvThrottleMillis,
    federationDomain,
    mlsPrivateKeyPaths,
    featureFlags,
    defConcurrentDeletionEvents,
    JournalOpts (JournalOpts),
    queueName,
    endpoint,
    Opts,
    galley,
    cassandra,
    brig,
    gundeck,
    spar,
    federator,
    rabbitmq,
    discoUrl,
    settings,
    journal,
    logLevel,
    logNetStrings,
    logFormat,
    guestLinkTTLSeconds,
    defGuestLinkTTLSeconds,
    GuestLinkTTLSeconds (..),
  )
where

import Control.Lens hiding (Level, (.=))
import Data.Aeson (FromJSON (..))
import Data.Aeson.TH (deriveFromJSON)
import Data.Domain (Domain)
import Data.Id (TeamId)
import Data.Misc
import Data.Range
import Galley.Keys
import Galley.Types.Teams
import Imports
import Network.AMQP.Extended
import System.Logger.Extended (Level, LogFormat)
import Util.Options hiding (endpoint)
import Util.Options.Common
import Wire.API.Routes.Version
import Wire.API.Team.Member

newtype GuestLinkTTLSeconds = GuestLinkTTLSeconds
  { GuestLinkTTLSeconds -> Int
unGuestLinkTTLSeconds :: Int
  }
  deriving (Int -> GuestLinkTTLSeconds -> ShowS
[GuestLinkTTLSeconds] -> ShowS
GuestLinkTTLSeconds -> String
(Int -> GuestLinkTTLSeconds -> ShowS)
-> (GuestLinkTTLSeconds -> String)
-> ([GuestLinkTTLSeconds] -> ShowS)
-> Show GuestLinkTTLSeconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GuestLinkTTLSeconds -> ShowS
showsPrec :: Int -> GuestLinkTTLSeconds -> ShowS
$cshow :: GuestLinkTTLSeconds -> String
show :: GuestLinkTTLSeconds -> String
$cshowList :: [GuestLinkTTLSeconds] -> ShowS
showList :: [GuestLinkTTLSeconds] -> ShowS
Show, (forall x. GuestLinkTTLSeconds -> Rep GuestLinkTTLSeconds x)
-> (forall x. Rep GuestLinkTTLSeconds x -> GuestLinkTTLSeconds)
-> Generic GuestLinkTTLSeconds
forall x. Rep GuestLinkTTLSeconds x -> GuestLinkTTLSeconds
forall x. GuestLinkTTLSeconds -> Rep GuestLinkTTLSeconds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GuestLinkTTLSeconds -> Rep GuestLinkTTLSeconds x
from :: forall x. GuestLinkTTLSeconds -> Rep GuestLinkTTLSeconds x
$cto :: forall x. Rep GuestLinkTTLSeconds x -> GuestLinkTTLSeconds
to :: forall x. Rep GuestLinkTTLSeconds x -> GuestLinkTTLSeconds
Generic)

instance FromJSON GuestLinkTTLSeconds where
  parseJSON :: Value -> Parser GuestLinkTTLSeconds
parseJSON Value
x = do
    Int
n <- Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
31536000
      then GuestLinkTTLSeconds -> Parser GuestLinkTTLSeconds
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GuestLinkTTLSeconds -> Parser GuestLinkTTLSeconds)
-> GuestLinkTTLSeconds -> Parser GuestLinkTTLSeconds
forall a b. (a -> b) -> a -> b
$ Int -> GuestLinkTTLSeconds
GuestLinkTTLSeconds Int
n
      else String -> Parser GuestLinkTTLSeconds
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"GuestLinkTTLSeconds must be in (0, 31536000]"

data Settings = Settings
  { -- | Number of connections for the HTTP client pool
    Settings -> Int
_httpPoolSize :: !Int,
    -- | Max number of members in a team. NOTE: This must be in sync with Brig
    Settings -> Word32
_maxTeamSize :: !Word32,
    -- | Max number of team members users to fanout events to. For teams larger than
    --   this value, team events and user updates will no longer be sent to team users.
    --   This defaults to setMaxTeamSize and cannot be > HardTruncationLimit. Useful
    --   to tune mainly for testing purposes.
    Settings -> Maybe (Range 1 HardTruncationLimit Int32)
_maxFanoutSize :: !(Maybe (Range 1 HardTruncationLimit Int32)),
    -- | List of teams for which the invitation URL can be added to the list of all
    -- invitations retrievable by team admins.  See also:
    -- 'ExposeInvitationURLsToTeamAdminConfig'.
    Settings -> Maybe [TeamId]
_exposeInvitationURLsTeamAllowlist :: !(Maybe [TeamId]),
    -- | Max number of members in a conversation. NOTE: This must be in sync with Brig
    Settings -> Word16
_maxConvSize :: !Word16,
    -- | Whether to call Brig for device listing
    Settings -> Bool
_intraListing :: !Bool,
    -- | URI prefix for conversations with access mode @code@
    Settings -> Maybe HttpsUrl
_conversationCodeURI :: !(Maybe HttpsUrl),
    -- | Map from @Z-Host@ header to URI prefix for conversations with access mode @code@
    --
    -- If setMultiIngress is set then the URI prefix for guest links is looked
    -- up in this config setting using the @Z-Host@ header value as a key. If
    -- the lookup fails then no guest link can be created via the API.
    --
    -- This option is only useful in the context of multi-ingress setups where
    -- one backend / deployment is is reachable under several domains.
    --
    -- multiIngress and conversationCodeURI are mutually exclusive. One of
    -- both options need to be configured.
    Settings -> Maybe (Map Text HttpsUrl)
_multiIngress :: Maybe (Map Text HttpsUrl),
    -- | Throttling: limits to concurrent deletion events
    Settings -> Maybe Int
_concurrentDeletionEvents :: !(Maybe Int),
    -- | Throttling: delay between sending events upon team deletion
    Settings -> Maybe Int
_deleteConvThrottleMillis :: !(Maybe Int),
    -- | FederationDomain is required, even when not wanting to federate with other backends
    -- (in that case the 'allowedDomains' can be set to empty in Federator)
    -- Federation domain is used to qualify local IDs and handles,
    -- e.g. 0c4d8944-70fa-480e-a8b7-9d929862d18c@wire.com and somehandle@wire.com.
    -- It should also match the SRV DNS records under which other wire-server installations can find this backend:
    --    _wire-server-federator._tcp.<federationDomain>
    -- Once set, DO NOT change it: if you do, existing users may have a broken experience and/or stop working
    -- Remember to keep it the same in all services.
    -- Example:
    --   allowedDomains:
    --     - wire.com
    --     - example.com
    Settings -> Domain
_federationDomain :: !Domain,
    Settings -> Maybe MLSPrivateKeyPaths
_mlsPrivateKeyPaths :: !(Maybe MLSPrivateKeyPaths),
    -- | FUTUREWORK: 'setFeatureFlags' should be renamed to 'setFeatureConfigs' in all types.
    Settings -> FeatureFlags
_featureFlags :: !FeatureFlags,
    Settings -> Set VersionExp
_disabledAPIVersions :: !(Set VersionExp),
    -- | The lifetime of a conversation guest link in seconds with the maximum of 1 year (31536000 seconds).
    -- If not set use the default `defGuestLinkTTLSeconds`
    Settings -> Maybe GuestLinkTTLSeconds
_guestLinkTTLSeconds :: !(Maybe GuestLinkTTLSeconds)
  }
  deriving (Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
(Int -> Settings -> ShowS)
-> (Settings -> String) -> ([Settings] -> ShowS) -> Show Settings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Settings -> ShowS
showsPrec :: Int -> Settings -> ShowS
$cshow :: Settings -> String
show :: Settings -> String
$cshowList :: [Settings] -> ShowS
showList :: [Settings] -> ShowS
Show, (forall x. Settings -> Rep Settings x)
-> (forall x. Rep Settings x -> Settings) -> Generic Settings
forall x. Rep Settings x -> Settings
forall x. Settings -> Rep Settings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Settings -> Rep Settings x
from :: forall x. Settings -> Rep Settings x
$cto :: forall x. Rep Settings x -> Settings
to :: forall x. Rep Settings x -> Settings
Generic)

deriveFromJSON toOptionFieldName ''Settings

makeLenses ''Settings

defConcurrentDeletionEvents :: Int
defConcurrentDeletionEvents :: Int
defConcurrentDeletionEvents = Int
128

-- | Default guest link TTL in days. 365 days if not set.
defGuestLinkTTLSeconds :: GuestLinkTTLSeconds
defGuestLinkTTLSeconds :: GuestLinkTTLSeconds
defGuestLinkTTLSeconds = Int -> GuestLinkTTLSeconds
GuestLinkTTLSeconds (Int -> GuestLinkTTLSeconds) -> Int -> GuestLinkTTLSeconds
forall a b. (a -> b) -> a -> b
$ Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
365 -- 1 year

data JournalOpts = JournalOpts
  { -- | SQS queue name to send team events
    JournalOpts -> Text
_queueName :: !Text,
    -- | AWS endpoint
    JournalOpts -> AWSEndpoint
_endpoint :: !AWSEndpoint
  }
  deriving (Int -> JournalOpts -> ShowS
[JournalOpts] -> ShowS
JournalOpts -> String
(Int -> JournalOpts -> ShowS)
-> (JournalOpts -> String)
-> ([JournalOpts] -> ShowS)
-> Show JournalOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JournalOpts -> ShowS
showsPrec :: Int -> JournalOpts -> ShowS
$cshow :: JournalOpts -> String
show :: JournalOpts -> String
$cshowList :: [JournalOpts] -> ShowS
showList :: [JournalOpts] -> ShowS
Show, (forall x. JournalOpts -> Rep JournalOpts x)
-> (forall x. Rep JournalOpts x -> JournalOpts)
-> Generic JournalOpts
forall x. Rep JournalOpts x -> JournalOpts
forall x. JournalOpts -> Rep JournalOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JournalOpts -> Rep JournalOpts x
from :: forall x. JournalOpts -> Rep JournalOpts x
$cto :: forall x. Rep JournalOpts x -> JournalOpts
to :: forall x. Rep JournalOpts x -> JournalOpts
Generic)

deriveFromJSON toOptionFieldName ''JournalOpts

makeLenses ''JournalOpts

data Opts = Opts
  { -- | Host and port to bind to
    Opts -> Endpoint
_galley :: !Endpoint,
    -- | Cassandra settings
    Opts -> CassandraOpts
_cassandra :: !CassandraOpts,
    -- | Brig endpoint
    Opts -> Endpoint
_brig :: !Endpoint,
    -- | Gundeck endpoint
    Opts -> Endpoint
_gundeck :: !Endpoint,
    -- | Spar endpoint
    Opts -> Endpoint
_spar :: !Endpoint,
    -- | Federator endpoint
    Opts -> Maybe Endpoint
_federator :: !(Maybe Endpoint),
    -- | RabbitMQ settings, required when federation is enabled.
    Opts -> Maybe AmqpEndpoint
_rabbitmq :: !(Maybe AmqpEndpoint),
    -- | Disco URL
    Opts -> Maybe Text
_discoUrl :: !(Maybe Text),
    -- | Other settings
    Opts -> Settings
_settings :: !Settings,
    -- | Journaling options ('Nothing'
    --   disables journaling)
    -- Logging
    Opts -> Maybe JournalOpts
_journal :: !(Maybe JournalOpts),
    -- | Log level (Debug, Info, etc)
    Opts -> Level
_logLevel :: !Level,
    -- | Use netstrings encoding
    --  <http://cr.yp.to/proto/netstrings.txt>
    Opts -> Maybe (Last Bool)
_logNetStrings :: !(Maybe (Last Bool)),
    -- | What log format to use
    Opts -> Maybe (Last LogFormat)
_logFormat :: !(Maybe (Last LogFormat))
  }

deriveFromJSON toOptionFieldName ''Opts

makeLenses ''Opts