{-# LANGUAGE LambdaCase, ApplicativeDo, TemplateHaskell, OverloadedStrings, RecordWildCards, BlockArguments #-}

{-|
Module      : Client.Configuration.ServerSettings
Description : Settings for an individual IRC connection
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module defines the settings used for an individual IRC connection.
These are static settings that are not expected change over the lifetime
of a connection.
-}

module Client.Configuration.ServerSettings
  (
  -- * Server settings type
    ServerSettings(..)
  , HookConfig(..)
  , serverSpec
  , identifierSpec

  -- * Lenses
  , ssNicks
  , ssUser
  , ssReal
  , ssPassword
  , ssSaslMechanism
  , ssHostName
  , ssPort
  , ssTls
  , ssTlsVerify
  , ssTlsClientCert
  , ssTlsClientKey
  , ssTlsClientKeyPassword
  , ssTlsServerCert
  , ssTlsCiphers
  , ssTls13Ciphers
  , ssConnectCmds
  , ssSocksHost
  , ssSocksPort
  , ssSocksUsername
  , ssSocksPassword
  , ssChanservChannels
  , ssFloodPenalty
  , ssFloodThreshold
  , ssMessageHooks
  , ssName
  , ssReconnectAttempts
  , ssReconnectError
  , ssAutoconnect
  , ssNickCompletion
  , ssLogDir
  , ssBindHostName
  , ssSts
  , ssTlsPubkeyFingerprint
  , ssTlsCertFingerprint
  , ssShowAccounts
  , ssCapabilities
  , ssWindowHints
  , ssPalette

  -- * SASL Mechanisms
  , SaslMechanism(..)
  , _SaslExternal
  , _SaslEcdsa
  , _SaslPlain
  , _SaslScram

  -- * Secrets
  , Secret(..)
  , SecretException(..)
  , loadSecrets

  -- * Window Hints
  , WindowHint(..)

  -- * Defaults
  , defaultServerSettings

  -- * TLS settings
  , UseTls(..)
  , Fingerprint(..)
  , TlsMode(..)

  -- * Regex wrapper
  , KnownRegex(..)
  , getRegex
  ) where

import Client.Authentication.Scram (ScramDigest(..))
import Client.Commands.Interpolation (ExpansionChunk)
import Client.Commands.WordCompletion
import Client.Configuration.Colors (attrSpec)
import Client.Configuration.Macros (macroCommandSpec)
import Client.Image.Palette (NetworkPalette (..), defaultNetworkPalette)
import Client.State.Focus ( Focus (NetworkFocus, ChannelFocus) )
import Client.State.Window (ActivityFilter (..))
import Config.Schema.Spec
import Control.Exception (Exception, displayException, throwIO, try)
import Control.Lens
import Control.Monad ((>=>))
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Lazy qualified as L
import Data.Char (isLetter)
import qualified Data.HashMap.Strict as HashMap
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.List.NonEmpty qualified as NonEmpty
import Data.List.Split (chunksOf, splitOn)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.Monoid (Endo(Endo))
import Data.Semigroup.Foldable (asum1)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Hookup (TlsVerify(..))
import Irc.Identifier (Identifier, mkId)
import Network.Socket (HostName, PortNumber)
import Numeric (readHex)
import System.Exit qualified as Exit
import System.Process.Typed qualified as Process
import Text.Regex.TDFA (Regex, RegexOptions(defaultCompOpt), ExecOption(ExecOption, captureGroups))
import Text.Regex.TDFA.Text (compile)

-- | Static server-level settings
data ServerSettings = ServerSettings
  { ServerSettings -> NonEmpty Text
_ssNicks            :: !(NonEmpty Text) -- ^ connection nicknames
  , ServerSettings -> Text
_ssUser             :: !Text -- ^ connection username
  , ServerSettings -> Text
_ssReal             :: !Text -- ^ connection realname / GECOS
  , ServerSettings -> Maybe Secret
_ssPassword         :: !(Maybe Secret) -- ^ server password
  , ServerSettings -> Maybe SaslMechanism
_ssSaslMechanism    :: !(Maybe SaslMechanism) -- ^ SASL mechanism
  , ServerSettings -> String
_ssHostName         :: !HostName -- ^ server hostname
  , ServerSettings -> Maybe PortNumber
_ssPort             :: !(Maybe PortNumber) -- ^ server port
  , ServerSettings -> TlsMode
_ssTls              :: !TlsMode -- ^ use TLS to connect
  , ServerSettings -> TlsVerify
_ssTlsVerify        :: !TlsVerify -- ^ verify TLS hostname
  , ServerSettings -> Maybe String
_ssTlsClientCert    :: !(Maybe FilePath) -- ^ path to client TLS certificate
  , ServerSettings -> Maybe String
_ssTlsClientKey     :: !(Maybe FilePath) -- ^ path to client TLS key
  , ServerSettings -> Maybe Secret
_ssTlsClientKeyPassword :: !(Maybe Secret) -- ^ client key PEM password
  , ServerSettings -> Maybe String
_ssTlsServerCert    :: !(Maybe FilePath) -- ^ additional CA certificates for validating server
  , ServerSettings -> String
_ssTlsCiphers       :: String            -- ^ OpenSSL cipher suite
  , ServerSettings -> Maybe String
_ssTls13Ciphers     :: Maybe String      -- ^ OpenSSL TLS 1.3 cipher suite
  , ServerSettings -> Maybe Fingerprint
_ssTlsPubkeyFingerprint :: !(Maybe Fingerprint) -- ^ optional acceptable public key fingerprint
  , ServerSettings -> Maybe Fingerprint
_ssTlsCertFingerprint   :: !(Maybe Fingerprint) -- ^ optional acceptable certificate fingerprint
  , ServerSettings -> Bool
_ssSts              :: !Bool -- ^ Honor STS policies when true
  , ServerSettings -> [[ExpansionChunk]]
_ssConnectCmds      :: ![[ExpansionChunk]] -- ^ commands to execute upon successful connection
  , ServerSettings -> Maybe String
_ssSocksHost        :: !(Maybe HostName) -- ^ hostname of SOCKS proxy
  , ServerSettings -> PortNumber
_ssSocksPort        :: !PortNumber -- ^ port of SOCKS proxy
  , ServerSettings -> Maybe Text
_ssSocksUsername    :: !(Maybe Text)
  , ServerSettings -> Maybe Secret
_ssSocksPassword    :: !(Maybe Secret)
  , ServerSettings -> [Identifier]
_ssChanservChannels :: ![Identifier] -- ^ Channels with chanserv permissions
  , ServerSettings -> Rational
_ssFloodPenalty     :: !Rational -- ^ Flood limiter penalty (seconds)
  , ServerSettings -> Rational
_ssFloodThreshold   :: !Rational -- ^ Flood limited threshold (seconds)
  , ServerSettings -> [HookConfig]
_ssMessageHooks     :: ![HookConfig] -- ^ Initial message hooks
  , ServerSettings -> Maybe Text
_ssName             :: !(Maybe Text) -- ^ The name referencing the server in commands
  , ServerSettings -> Int
_ssReconnectAttempts:: !Int -- ^ The number of reconnect attempts to make on error
  , ServerSettings -> Maybe KnownRegex
_ssReconnectError   :: !(Maybe KnownRegex) -- ^ Regular expression for ERROR messages that trigger reconnect
  , ServerSettings -> Bool
_ssAutoconnect      :: !Bool -- ^ Connect to this network on server startup
  , ServerSettings -> WordCompletionMode
_ssNickCompletion   :: WordCompletionMode -- ^ Nick completion mode for this server
  , ServerSettings -> Maybe String
_ssLogDir           :: Maybe FilePath -- ^ Directory to save logs of chat
  , ServerSettings -> Maybe String
_ssBindHostName     :: Maybe HostName -- ^ Local bind host
  , ServerSettings -> Bool
_ssShowAccounts     :: !Bool -- ^ Render account names
  , ServerSettings -> [Text]
_ssCapabilities     :: ![Text] -- ^ Extra capabilities to unconditionally request
  , ServerSettings -> Map Focus WindowHint
_ssWindowHints      :: Map Focus WindowHint
  , ServerSettings -> NetworkPalette
_ssPalette          :: NetworkPalette
  }
  deriving Int -> ServerSettings -> ShowS
[ServerSettings] -> ShowS
ServerSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerSettings] -> ShowS
$cshowList :: [ServerSettings] -> ShowS
show :: ServerSettings -> String
$cshow :: ServerSettings -> String
showsPrec :: Int -> ServerSettings -> ShowS
$cshowsPrec :: Int -> ServerSettings -> ShowS
Show

data TlsMode = TlsYes | TlsNo | TlsStart
  deriving Int -> TlsMode -> ShowS
[TlsMode] -> ShowS
TlsMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TlsMode] -> ShowS
$cshowList :: [TlsMode] -> ShowS
show :: TlsMode -> String
$cshow :: TlsMode -> String
showsPrec :: Int -> TlsMode -> ShowS
$cshowsPrec :: Int -> TlsMode -> ShowS
Show

data Secret
  = SecretText Text    -- ^ Constant text
  | SecretCommand (NonEmpty Text) -- ^ Command to generate text
  deriving Int -> Secret -> ShowS
[Secret] -> ShowS
Secret -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Secret] -> ShowS
$cshowList :: [Secret] -> ShowS
show :: Secret -> String
$cshow :: Secret -> String
showsPrec :: Int -> Secret -> ShowS
$cshowsPrec :: Int -> Secret -> ShowS
Show

-- | SASL mechanisms and configuration data.
data SaslMechanism
  = SaslPlain    (Maybe Text) Text Secret -- ^ SASL PLAIN RFC4616 - authzid authcid password
  | SaslEcdsa    (Maybe Text) Text FilePath -- ^ SASL NIST - https://github.com/kaniini/ecdsatool - authzid keypath
  | SaslExternal (Maybe Text)      -- ^ SASL EXTERNAL RFC4422 - authzid
  | SaslScram    ScramDigest (Maybe Text) Text Secret -- ^ SASL SCRAM-SHA-256 RFC7677 - authzid authcid password
  | SaslEcdh     (Maybe Text) Text Secret -- ^ SASL ECDH-X25519-CHALLENGE - authzid authcid private-key
  deriving Int -> SaslMechanism -> ShowS
[SaslMechanism] -> ShowS
SaslMechanism -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SaslMechanism] -> ShowS
$cshowList :: [SaslMechanism] -> ShowS
show :: SaslMechanism -> String
$cshow :: SaslMechanism -> String
showsPrec :: Int -> SaslMechanism -> ShowS
$cshowsPrec :: Int -> SaslMechanism -> ShowS
Show

data WindowHint = WindowHint
  { WindowHint -> Maybe Char
windowHintName     :: Maybe Char
  , WindowHint -> Maybe Bool
windowHintHideMeta :: Maybe Bool
  , WindowHint -> Maybe Bool
windowHintHidden   :: Maybe Bool
  , WindowHint -> Maybe ActivityFilter
windowHintActivity :: Maybe ActivityFilter
  } deriving Int -> WindowHint -> ShowS
[WindowHint] -> ShowS
WindowHint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowHint] -> ShowS
$cshowList :: [WindowHint] -> ShowS
show :: WindowHint -> String
$cshow :: WindowHint -> String
showsPrec :: Int -> WindowHint -> ShowS
$cshowsPrec :: Int -> WindowHint -> ShowS
Show

-- | Regular expression matched with original source to help with debugging.
data KnownRegex = KnownRegex Text Regex

getRegex :: KnownRegex -> Regex
getRegex :: KnownRegex -> Regex
getRegex (KnownRegex Text
_ Regex
r) = Regex
r

instance Show KnownRegex where show :: KnownRegex -> String
show (KnownRegex Text
x Regex
_) = forall a. Show a => a -> String
show Text
x

-- | Hook name and configuration arguments
data HookConfig = HookConfig Text [Text]
  deriving Int -> HookConfig -> ShowS
[HookConfig] -> ShowS
HookConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HookConfig] -> ShowS
$cshowList :: [HookConfig] -> ShowS
show :: HookConfig -> String
$cshow :: HookConfig -> String
showsPrec :: Int -> HookConfig -> ShowS
$cshowsPrec :: Int -> HookConfig -> ShowS
Show

-- | Security setting for network connection
data UseTls
  = UseTls         -- ^ TLS connection
  | UseInsecureTls -- ^ TLS connection without certificate checking
  | UseInsecure    -- ^ Plain connection
  deriving Int -> UseTls -> ShowS
[UseTls] -> ShowS
UseTls -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UseTls] -> ShowS
$cshowList :: [UseTls] -> ShowS
show :: UseTls -> String
$cshow :: UseTls -> String
showsPrec :: Int -> UseTls -> ShowS
$cshowsPrec :: Int -> UseTls -> ShowS
Show

-- | Fingerprint used to validate server certificates.
data Fingerprint
  = FingerprintSha1   ByteString -- ^ SHA-1 fingerprint
  | FingerprintSha256 ByteString -- ^ SHA-2 256-bit fingerprint
  | FingerprintSha512 ByteString -- ^ SHA-2 512-bit fingerprint
  deriving Int -> Fingerprint -> ShowS
[Fingerprint] -> ShowS
Fingerprint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fingerprint] -> ShowS
$cshowList :: [Fingerprint] -> ShowS
show :: Fingerprint -> String
$cshow :: Fingerprint -> String
showsPrec :: Int -> Fingerprint -> ShowS
$cshowsPrec :: Int -> Fingerprint -> ShowS
Show

makeLenses ''ServerSettings
makePrisms ''SaslMechanism

-- | The defaults for server settings.
defaultServerSettings :: ServerSettings
defaultServerSettings :: ServerSettings
defaultServerSettings =
  ServerSettings
       { _ssNicks :: NonEmpty Text
_ssNicks         = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"guest"
       , _ssUser :: Text
_ssUser          = Text
"username"
       , _ssReal :: Text
_ssReal          = Text
"realname"
       , _ssPassword :: Maybe Secret
_ssPassword      = forall a. Maybe a
Nothing
       , _ssSaslMechanism :: Maybe SaslMechanism
_ssSaslMechanism = forall a. Maybe a
Nothing
       , _ssHostName :: String
_ssHostName      = String
""
       , _ssPort :: Maybe PortNumber
_ssPort          = forall a. Maybe a
Nothing
       , _ssTls :: TlsMode
_ssTls           = TlsMode
TlsNo
       , _ssTlsVerify :: TlsVerify
_ssTlsVerify     = TlsVerify
VerifyDefault
       , _ssTlsClientCert :: Maybe String
_ssTlsClientCert = forall a. Maybe a
Nothing
       , _ssTlsClientKey :: Maybe String
_ssTlsClientKey  = forall a. Maybe a
Nothing
       , _ssTlsClientKeyPassword :: Maybe Secret
_ssTlsClientKeyPassword = forall a. Maybe a
Nothing
       , _ssTlsServerCert :: Maybe String
_ssTlsServerCert = forall a. Maybe a
Nothing
       , _ssTlsCiphers :: String
_ssTlsCiphers    = String
"HIGH"
       , _ssTls13Ciphers :: Maybe String
_ssTls13Ciphers  = forall a. Maybe a
Nothing
       , _ssTlsPubkeyFingerprint :: Maybe Fingerprint
_ssTlsPubkeyFingerprint = forall a. Maybe a
Nothing
       , _ssTlsCertFingerprint :: Maybe Fingerprint
_ssTlsCertFingerprint   = forall a. Maybe a
Nothing
       , _ssSts :: Bool
_ssSts              = Bool
True
       , _ssConnectCmds :: [[ExpansionChunk]]
_ssConnectCmds   = []
       , _ssSocksHost :: Maybe String
_ssSocksHost     = forall a. Maybe a
Nothing
       , _ssSocksPort :: PortNumber
_ssSocksPort     = PortNumber
1080
       , _ssSocksUsername :: Maybe Text
_ssSocksUsername = forall a. Maybe a
Nothing
       , _ssSocksPassword :: Maybe Secret
_ssSocksPassword = forall a. Maybe a
Nothing
       , _ssChanservChannels :: [Identifier]
_ssChanservChannels = []
       , _ssFloodPenalty :: Rational
_ssFloodPenalty     = Rational
2 -- RFC 1459 defaults
       , _ssFloodThreshold :: Rational
_ssFloodThreshold   = Rational
10
       , _ssMessageHooks :: [HookConfig]
_ssMessageHooks     = []
       , _ssName :: Maybe Text
_ssName             = forall a. Maybe a
Nothing
       , _ssReconnectAttempts :: Int
_ssReconnectAttempts= Int
6 -- six feels great
       , _ssReconnectError :: Maybe KnownRegex
_ssReconnectError   = forall a. Maybe a
Nothing
       , _ssAutoconnect :: Bool
_ssAutoconnect      = Bool
False
       , _ssNickCompletion :: WordCompletionMode
_ssNickCompletion   = WordCompletionMode
defaultNickWordCompleteMode
       , _ssLogDir :: Maybe String
_ssLogDir           = forall a. Maybe a
Nothing
       , _ssBindHostName :: Maybe String
_ssBindHostName     = forall a. Maybe a
Nothing
       , _ssShowAccounts :: Bool
_ssShowAccounts     = Bool
False
       , _ssCapabilities :: [Text]
_ssCapabilities     = []
       , _ssWindowHints :: Map Focus WindowHint
_ssWindowHints      = forall k a. Map k a
Map.empty
       , _ssPalette :: NetworkPalette
_ssPalette          = NetworkPalette
defaultNetworkPalette
       }

serverSpec :: ValueSpec (Maybe Text, ServerSettings -> ServerSettings)
serverSpec :: ValueSpec (Maybe Text, ServerSettings -> ServerSettings)
serverSpec = forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"server-settings" forall a b. (a -> b) -> a -> b
$
  do Maybe Text
mbExt <- forall a. HasSpec a => Text -> Text -> SectionsSpec (Maybe a)
optSection Text
"extends" Text
"name of a server to use for defaults"
     ServerSettings -> ServerSettings
upd <- forall a. [Maybe (a -> a)] -> a -> a
composeMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [SectionsSpec (Maybe (ServerSettings -> ServerSettings))]
settings
     pure (Maybe Text
mbExt, ServerSettings -> ServerSettings
upd)
  where

    composeMaybe :: [Maybe (a -> a)] -> a -> a
    composeMaybe :: forall a. [Maybe (a -> a)] -> a -> a
composeMaybe = forall (f :: * -> *) s t.
(Functor f, Rewrapping s t) =>
(Unwrapped s -> s)
-> ((Unwrapped t -> t) -> f s) -> f (Unwrapped s)
ala forall a. (a -> a) -> Endo a
Endo (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap)

    req :: Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
name ASetter s t a a
l ValueSpec a
s Text
info
      = forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
name forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? Text
info
      forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s t a a
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec a
s

    opt :: Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
name ASetter s t a (Maybe a)
l ValueSpec a
s Text
info
      = forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
name forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? Text
info
      forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s t a (Maybe a)
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec a
s forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
        forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s t a (Maybe a)
l forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"clear"

    settings :: [SectionsSpec (Maybe (ServerSettings -> ServerSettings))]
    settings :: [SectionsSpec (Maybe (ServerSettings -> ServerSettings))]
settings =
      [ forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"name" Lens' ServerSettings (Maybe Text)
ssName forall a. HasSpec a => ValueSpec a
anySpec
        Text
"The name used to identify this server in the client"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"hostname" Lens' ServerSettings String
ssHostName ValueSpec String
stringSpec
        Text
"Hostname of server"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"port" Lens' ServerSettings (Maybe PortNumber)
ssPort forall a. Num a => ValueSpec a
numSpec
        Text
"Port number of server. Default 6667 without TLS or 6697 with TLS"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"nick" Lens' ServerSettings (NonEmpty Text)
ssNicks ValueSpec (NonEmpty Text)
nicksSpec
        Text
"Nicknames to connect with in order"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"password" Lens' ServerSettings (Maybe Secret)
ssPassword forall a. HasSpec a => ValueSpec a
anySpec
        Text
"Server password"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"username" Lens' ServerSettings Text
ssUser forall a. HasSpec a => ValueSpec a
anySpec
        Text
"Second component of _!_@_ usermask"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"realname" Lens' ServerSettings Text
ssReal forall a. HasSpec a => ValueSpec a
anySpec
        Text
"\"GECOS\" name sent to server visible in /whois"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"sasl" Lens' ServerSettings (Maybe SaslMechanism)
ssSaslMechanism ValueSpec SaslMechanism
saslMechanismSpec
        Text
"SASL settings"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"tls" Lens' ServerSettings TlsMode
ssTls ValueSpec TlsMode
tlsModeSpec
        Text
"Use TLS to connect (default no)"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"tls-verify" Lens' ServerSettings TlsVerify
ssTlsVerify ValueSpec TlsVerify
tlsVerifySpec
        Text
"Enable server certificate hostname verification (default yes, string to override hostname)"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"tls-client-cert" Lens' ServerSettings (Maybe String)
ssTlsClientCert ValueSpec String
filepathSpec
        Text
"Path to TLS client certificate"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"tls-client-key" Lens' ServerSettings (Maybe String)
ssTlsClientKey ValueSpec String
filepathSpec
        Text
"Path to TLS client key"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"tls-client-key-password" Lens' ServerSettings (Maybe Secret)
ssTlsClientKeyPassword forall a. HasSpec a => ValueSpec a
anySpec
        Text
"Password for decrypting TLS client key PEM file"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"tls-server-cert" Lens' ServerSettings (Maybe String)
ssTlsServerCert ValueSpec String
filepathSpec
        Text
"Path to CA certificate bundle"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"tls-ciphers" Lens' ServerSettings String
ssTlsCiphers ValueSpec String
stringSpec
        Text
"OpenSSL cipher specification. Default to \"HIGH\""

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"tls-1.3-ciphers" Lens' ServerSettings (Maybe String)
ssTls13Ciphers ValueSpec String
stringSpec
        Text
"OpenSSL TLS 1.3 cipher specification."

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"socks-host" Lens' ServerSettings (Maybe String)
ssSocksHost ValueSpec String
stringSpec
        Text
"Hostname of SOCKS5 proxy server"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"socks-port" Lens' ServerSettings PortNumber
ssSocksPort forall a. Num a => ValueSpec a
numSpec
        Text
"Port number of SOCKS5 proxy server"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"socks-username" Lens' ServerSettings (Maybe Text)
ssSocksUsername ValueSpec Text
textSpec
        Text
"Username of SOCKS5 proxy server"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"socks-password" Lens' ServerSettings (Maybe Secret)
ssSocksPassword forall a. HasSpec a => ValueSpec a
anySpec
        Text
"Password of SOCKS5 proxy server"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"connect-cmds" Lens' ServerSettings [[ExpansionChunk]]
ssConnectCmds (forall a. ValueSpec a -> ValueSpec [a]
listSpec ValueSpec [ExpansionChunk]
macroCommandSpec)
        Text
"Command to be run upon successful connection to server"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"chanserv-channels" Lens' ServerSettings [Identifier]
ssChanservChannels (forall a. ValueSpec a -> ValueSpec [a]
listSpec ValueSpec Identifier
identifierSpec)
        Text
"Channels with ChanServ permissions available"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"flood-penalty" Lens' ServerSettings Rational
ssFloodPenalty forall a. HasSpec a => ValueSpec a
anySpec
        Text
"RFC 1459 rate limiting, seconds of penalty per message (default 2)"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"flood-threshold" Lens' ServerSettings Rational
ssFloodThreshold forall a. HasSpec a => ValueSpec a
anySpec
        Text
"RFC 1459 rate limiting, seconds of allowed penalty accumulation (default 10)"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"message-hooks" Lens' ServerSettings [HookConfig]
ssMessageHooks (forall a. ValueSpec a -> ValueSpec [a]
listSpec ValueSpec HookConfig
hookSpec)
        Text
"Special message hooks to enable: \"buffextras\" available"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"reconnect-attempts" Lens' ServerSettings Int
ssReconnectAttempts forall a. HasSpec a => ValueSpec a
anySpec
        Text
"Number of reconnection attempts on lost connection"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"reconnect-error" Lens' ServerSettings (Maybe KnownRegex)
ssReconnectError ValueSpec KnownRegex
regexSpec
        Text
"Regular expression for disconnect messages that trigger reconnect."

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"autoconnect" Lens' ServerSettings Bool
ssAutoconnect ValueSpec Bool
yesOrNoSpec
        Text
"Set to `yes` to automatically connect at client startup"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"nick-completion" Lens' ServerSettings WordCompletionMode
ssNickCompletion ValueSpec WordCompletionMode
nickCompletionSpec
        Text
"Behavior for nickname completion with TAB"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"log-dir" Lens' ServerSettings (Maybe String)
ssLogDir ValueSpec String
filepathSpec
        Text
"Path to log file directory for this server"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"bind-hostname" Lens' ServerSettings (Maybe String)
ssBindHostName ValueSpec String
stringSpec
        Text
"Source address to bind to before connecting"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"sts" Lens' ServerSettings Bool
ssSts ValueSpec Bool
yesOrNoSpec
        Text
"Honor server STS policies forcing TLS connections"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"tls-cert-fingerprint" Lens' ServerSettings (Maybe Fingerprint)
ssTlsCertFingerprint ValueSpec Fingerprint
fingerprintSpec
        Text
"Check SHA1, SHA256, or SHA512 certificate fingerprint"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"tls-pubkey-fingerprint" Lens' ServerSettings (Maybe Fingerprint)
ssTlsPubkeyFingerprint ValueSpec Fingerprint
fingerprintSpec
        Text
"Check SHA1, SHA256, or SHA512 public key fingerprint"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"show-accounts" Lens' ServerSettings Bool
ssShowAccounts ValueSpec Bool
yesOrNoSpec
        Text
"Render account names alongside chat messages"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"capabilities" Lens' ServerSettings [Text]
ssCapabilities forall a. HasSpec a => ValueSpec a
anySpec
        Text
"Extra capabilities to unconditionally request from the server"

      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"window-hints" Lens' ServerSettings (Map Focus WindowHint)
ssWindowHints ValueSpec (Map Focus WindowHint)
windowHintsSpec
        Text
"Persistent settings for windows"
      
      , forall {s} {t} {a} {a}.
Text
-> ASetter s t a a
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"palette" Lens' ServerSettings NetworkPalette
ssPalette ValueSpec NetworkPalette
netPaletteSpec
        Text
"Network-specific palette overrides"
      ]

windowHintsSpec :: ValueSpec (Map Focus WindowHint)
windowHintsSpec :: ValueSpec (Map Focus WindowHint)
windowHintsSpec = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ValueSpec a -> ValueSpec [a]
listSpec ValueSpec (Focus, WindowHint)
entrySpec
  where
    entrySpec :: ValueSpec (Focus, WindowHint)
entrySpec =
      forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"window-hint"
        do Focus
focus              <- forall a. Text -> ValueSpec a -> Text -> SectionsSpec a
reqSection' Text
"window"    ValueSpec Focus
focusSpec   Text
"channel name or network"
           Maybe Char
windowHintName     <- forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"hotkey"    ValueSpec Char
hotkeySpec  Text
"reserved hotkey"
           Maybe Bool
windowHintHidden   <- forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"hidden"    ValueSpec Bool
yesOrNoSpec Text
"hide from statusbar"
           Maybe Bool
windowHintHideMeta <- forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"hide-meta" ValueSpec Bool
yesOrNoSpec Text
"hide metadata by default"
           Maybe ActivityFilter
windowHintActivity <- forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"activity"  ValueSpec ActivityFilter
activitySpec Text
"activity indicators"
           pure (Focus
focus, WindowHint{Maybe Bool
Maybe Char
Maybe ActivityFilter
windowHintActivity :: Maybe ActivityFilter
windowHintHideMeta :: Maybe Bool
windowHintHidden :: Maybe Bool
windowHintName :: Maybe Char
windowHintActivity :: Maybe ActivityFilter
windowHintHidden :: Maybe Bool
windowHintHideMeta :: Maybe Bool
windowHintName :: Maybe Char
..})

    focusSpec :: ValueSpec Focus
focusSpec =
      Text -> Focus
NetworkFocus Text
"" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"network" forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
      Text -> Identifier -> Focus
ChannelFocus Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Identifier
mkId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec Text
textSpec

    hotkeySpec :: ValueSpec Char
hotkeySpec =
      Char
'\0' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"none" forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
      forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
"single letter" ValueSpec String
stringSpec \case
        [Char
x] -> forall a b. b -> Either a b
Right Char
x
        String
_   -> forall a b. a -> Either a b
Left Text
"expected a single letter"

tlsModeSpec :: ValueSpec TlsMode
tlsModeSpec :: ValueSpec TlsMode
tlsModeSpec =
  TlsMode
TlsYes   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"yes"      forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  TlsMode
TlsNo    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"no"       forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  TlsMode
TlsStart forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"starttls"

-- TODO: May be nice to be able to do this for all Show Enums.
activitySpec :: ValueSpec ActivityFilter
activitySpec :: ValueSpec ActivityFilter
activitySpec = forall (t :: * -> *) (m :: * -> *) a.
(Foldable1 t, Alt m) =>
t (m a) -> m a
asum1 (forall a. [a] -> NonEmpty a
NonEmpty.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => a -> ValueSpec a
mkSpec [(forall a. Enum a => Int -> a
toEnum Int
0)..]))
  where
    mkSpec :: a -> ValueSpec a
mkSpec a
a = a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec (String -> Text
Text.pack (forall a. Show a => a -> String
show a
a))

tlsVerifySpec :: ValueSpec TlsVerify
tlsVerifySpec :: ValueSpec TlsVerify
tlsVerifySpec =
  TlsVerify
VerifyDefault  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"yes"      forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  TlsVerify
VerifyNone     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"no"       forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  String -> TlsVerify
VerifyHostname forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec String
stringSpec

saslMechanismSpec :: ValueSpec SaslMechanism
saslMechanismSpec :: ValueSpec SaslMechanism
saslMechanismSpec = ValueSpec SaslMechanism
plain forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec SaslMechanism
external forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec SaslMechanism
ecdsa forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec SaslMechanism
scram forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec SaslMechanism
ecdh
  where
    mech :: Text -> SectionsSpec ()
mech Text
m   = forall a. Text -> ValueSpec a -> Text -> SectionsSpec a
reqSection' Text
"mechanism" (Text -> ValueSpec ()
atomSpec Text
m) Text
"Mechanism"
    authzid :: SectionsSpec (Maybe Text)
authzid  = forall a. HasSpec a => Text -> Text -> SectionsSpec (Maybe a)
optSection Text
"authzid" Text
"Authorization identity"
    username :: SectionsSpec Text
username = forall a. HasSpec a => Text -> Text -> SectionsSpec a
reqSection Text
"username" Text
"Authentication identity"

    plain :: ValueSpec SaslMechanism
plain =
      forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"sasl-plain" forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Secret -> SaslMechanism
SaslPlain forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
      forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"mechanism" (Text -> ValueSpec ()
atomSpec Text
"plain") Text
"Mechanism" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
      SectionsSpec (Maybe Text)
authzid forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SectionsSpec Text
username forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. HasSpec a => Text -> Text -> SectionsSpec a
reqSection Text
"password" Text
"Password"

    external :: ValueSpec SaslMechanism
external =
      forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"sasl-external" forall a b. (a -> b) -> a -> b
$ Maybe Text -> SaslMechanism
SaslExternal forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> SectionsSpec ()
mech Text
"external" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
      SectionsSpec (Maybe Text)
authzid

    ecdsa :: ValueSpec SaslMechanism
ecdsa =
      forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"sasl-ecdsa-nist256p-challenge-mech" forall a b. (a -> b) -> a -> b
$
      Maybe Text -> Text -> String -> SaslMechanism
SaslEcdsa forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> SectionsSpec ()
mech Text
"ecdsa-nist256p-challenge" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
      SectionsSpec (Maybe Text)
authzid forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SectionsSpec Text
username forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
      forall a. Text -> ValueSpec a -> Text -> SectionsSpec a
reqSection' Text
"private-key" ValueSpec String
filepathSpec Text
"Private key file"

    scramDigest :: SectionsSpec ScramDigest
scramDigest =
      forall a. a -> Maybe a -> a
fromMaybe ScramDigest
ScramDigestSha2_256 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"digest" ValueSpec ScramDigest
scramDigests Text
"Underlying digest function"

    scramDigests :: ValueSpec ScramDigest
scramDigests =
      ScramDigest
ScramDigestSha1     forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"sha1" forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
      ScramDigest
ScramDigestSha2_256 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"sha2-256" forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
      ScramDigest
ScramDigestSha2_512 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"sha2-512"

    scram :: ValueSpec SaslMechanism
scram =
      forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"sasl-scram" forall a b. (a -> b) -> a -> b
$
      ScramDigest -> Maybe Text -> Text -> Secret -> SaslMechanism
SaslScram forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> SectionsSpec ()
mech Text
"scram" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
      SectionsSpec ScramDigest
scramDigest forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
      SectionsSpec (Maybe Text)
authzid forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SectionsSpec Text
username forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. HasSpec a => Text -> Text -> SectionsSpec a
reqSection Text
"password" Text
"Password"

    ecdh :: ValueSpec SaslMechanism
ecdh =
      forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"sasl-ecdh-x25519-challenge" forall a b. (a -> b) -> a -> b
$
      Maybe Text -> Text -> Secret -> SaslMechanism
SaslEcdh forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> SectionsSpec ()
mech Text
"ecdh-x25519-challenge" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
      SectionsSpec (Maybe Text)
authzid forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SectionsSpec Text
username forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. HasSpec a => Text -> Text -> SectionsSpec a
reqSection Text
"private-key" Text
"Private Key"


filepathSpec :: ValueSpec FilePath
filepathSpec :: ValueSpec String
filepathSpec = forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
"path" ValueSpec String
stringSpec forall a b. (a -> b) -> a -> b
$ \String
str ->
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str
  then forall a b. a -> Either a b
Left Text
"empty path"
  else forall a b. b -> Either a b
Right String
str

hookSpec :: ValueSpec HookConfig
hookSpec :: ValueSpec HookConfig
hookSpec =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Text] -> HookConfig
HookConfig [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasSpec a => ValueSpec a
anySpec forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  (\(Text
x:|[Text]
xs) -> Text -> [Text] -> HookConfig
HookConfig Text
x [Text]
xs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ValueSpec a -> ValueSpec (NonEmpty a)
nonemptySpec forall a. HasSpec a => ValueSpec a
anySpec

-- | Match fingerprints in plain hex or colon-delimited bytes.
-- SHA-1 is 20 bytes. SHA-2-256 is 32 bytes. SHA-2-512 is 64 bytes.
--
-- @
-- 00112233aaFF
-- 00:11:22:33:aa:FF
-- @
fingerprintSpec :: ValueSpec Fingerprint
fingerprintSpec :: ValueSpec Fingerprint
fingerprintSpec =
  forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
"fingerprint" ValueSpec String
stringSpec forall a b. (a -> b) -> a -> b
$ \String
str ->
    do ByteString
bytes <- [Word8] -> ByteString
B.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {b} {a}. (Num b, IsString a) => String -> Either a b
readWord8 (String -> [String]
byteStrs String
str)
       case ByteString -> Int
B.length ByteString
bytes of
         Int
20 -> forall a b. b -> Either a b
Right (ByteString -> Fingerprint
FingerprintSha1   ByteString
bytes)
         Int
32 -> forall a b. b -> Either a b
Right (ByteString -> Fingerprint
FingerprintSha256 ByteString
bytes)
         Int
64 -> forall a b. b -> Either a b
Right (ByteString -> Fingerprint
FingerprintSha512 ByteString
bytes)
         Int
_  -> forall a b. a -> Either a b
Left Text
"expected 20, 32, or 64 bytes"
  where
    -- read a single byte in hex
    readWord8 :: String -> Either a b
readWord8 String
i =
      case forall a. (Eq a, Num a) => ReadS a
readHex String
i of
        [(Integer
x,String
"")]
          | Integer
0 forall a. Ord a => a -> a -> Bool
<= Integer
x, Integer
x forall a. Ord a => a -> a -> Bool
< Integer
256 -> forall a b. b -> Either a b
Right (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
x :: Integer))
          | Bool
otherwise -> forall a b. a -> Either a b
Left a
"byte out-of-bounds"
        [(Integer, String)]
_ -> forall a b. a -> Either a b
Left a
"bad hex-encoded byte"

    byteStrs :: String -> [String]
    byteStrs :: String -> [String]
byteStrs String
str
      | Char
':' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
str = forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
":" String
str
      | Bool
otherwise      = forall e. Int -> [e] -> [[e]]
chunksOf Int
2  String
str

nicksSpec :: ValueSpec (NonEmpty Text)
nicksSpec :: ValueSpec (NonEmpty Text)
nicksSpec = forall a. ValueSpec a -> ValueSpec (NonEmpty a)
oneOrNonemptySpec forall a. HasSpec a => ValueSpec a
anySpec

nickCompletionSpec :: ValueSpec WordCompletionMode
nickCompletionSpec :: ValueSpec WordCompletionMode
nickCompletionSpec =
      WordCompletionMode
defaultNickWordCompleteMode forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"default"
  forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> WordCompletionMode
slackNickWordCompleteMode   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"slack"
  forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec WordCompletionMode
customNickCompletion

customNickCompletion :: ValueSpec WordCompletionMode
customNickCompletion :: ValueSpec WordCompletionMode
customNickCompletion =
  forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"nick-completion" forall a b. (a -> b) -> a -> b
$
  do String
wcmStartPrefix  <- forall a. a -> Maybe a -> a
fromMaybe String
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"start-prefix" ValueSpec String
stringSpec
                        Text
"Prefix for nickname with when completing at start of line."
     String
wcmStartSuffix  <- forall a. a -> Maybe a -> a
fromMaybe String
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"start-suffix" ValueSpec String
stringSpec
                        Text
"Suffix for nickname with when completing at start of line."
     String
wcmMiddlePrefix <- forall a. a -> Maybe a -> a
fromMaybe String
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"middle-prefix" ValueSpec String
stringSpec
                        Text
"Prefix for nickname with when completing in middle of line."
     String
wcmMiddleSuffix <- forall a. a -> Maybe a -> a
fromMaybe String
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"middle-suffix" ValueSpec String
stringSpec
                        Text
"Suffix for nickname with when completing in middle of line."
     pure WordCompletionMode{String
wcmMiddleSuffix :: String
wcmMiddlePrefix :: String
wcmStartSuffix :: String
wcmStartPrefix :: String
wcmMiddleSuffix :: String
wcmMiddlePrefix :: String
wcmStartSuffix :: String
wcmStartPrefix :: String
..}


identifierSpec :: ValueSpec Identifier
identifierSpec :: ValueSpec Identifier
identifierSpec = Text -> Identifier
mkId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasSpec a => ValueSpec a
anySpec

regexSpec :: ValueSpec KnownRegex
regexSpec :: ValueSpec KnownRegex
regexSpec = forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
"regex" forall a. HasSpec a => ValueSpec a
anySpec forall a b. (a -> b) -> a -> b
$ \Text
str ->
  case CompOption -> ExecOption -> Text -> Either String Regex
compile forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt ExecOption{captureGroups :: Bool
captureGroups = Bool
False} Text
str of
    Left String
e  -> forall a b. a -> Either a b
Left  (String -> Text
Text.pack String
e)
    Right Regex
r -> forall a b. b -> Either a b
Right (Text -> Regex -> KnownRegex
KnownRegex Text
str Regex
r)

instance HasSpec Secret where
  anySpec :: ValueSpec Secret
anySpec =
    Text -> Secret
SecretText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec Text
textSpec forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
    NonEmpty Text -> Secret
SecretCommand forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"command" (forall a. HasSpec a => Text -> Text -> SectionsSpec a
reqSection Text
"command" Text
"Command and arguments to execute to secret")

data SecretException = SecretException String String
  deriving Int -> SecretException -> ShowS
[SecretException] -> ShowS
SecretException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecretException] -> ShowS
$cshowList :: [SecretException] -> ShowS
show :: SecretException -> String
$cshow :: SecretException -> String
showsPrec :: Int -> SecretException -> ShowS
$cshowsPrec :: Int -> SecretException -> ShowS
Show

instance Exception SecretException

-- | Run the secret commands in a server configuration replacing them with secret text.
-- Throws 'SecretException'
loadSecrets :: ServerSettings -> IO ServerSettings
loadSecrets :: ServerSettings -> IO ServerSettings
loadSecrets =
  forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf (Lens' ServerSettings (Maybe Secret)
ssPassword             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just) (String -> Secret -> IO Secret
loadSecret String
"server password") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf (Lens' ServerSettings (Maybe Secret)
ssSocksPassword        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just) (String -> Secret -> IO Secret
loadSecret String
"socks password") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf (Lens' ServerSettings (Maybe Secret)
ssTlsClientKeyPassword forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just) (String -> Secret -> IO Secret
loadSecret String
"TLS key password") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf (Lens' ServerSettings (Maybe SaslMechanism)
ssSaslMechanism        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just) SaslMechanism -> IO SaslMechanism
loadSaslSecret

-- | Populate secrets from sasl mechanism
loadSaslSecret :: SaslMechanism -> IO SaslMechanism
loadSaslSecret :: SaslMechanism -> IO SaslMechanism
loadSaslSecret =
  forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf (Prism' SaslMechanism (Maybe Text, Text, Secret)
_SaslPlain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field3 s t a b => Lens s t a b
_3) (String -> Secret -> IO Secret
loadSecret String
"SASL plain password") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf (Prism' SaslMechanism (ScramDigest, Maybe Text, Text, Secret)
_SaslScram forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field4 s t a b => Lens s t a b
_4) (String -> Secret -> IO Secret
loadSecret String
"SASL scram password") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf (Prism' SaslMechanism (Maybe Text, Text, Secret)
_SaslEcdh  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field3 s t a b => Lens s t a b
_3) (String -> Secret -> IO Secret
loadSecret String
"SASL ecdh private key")

-- | Run a command if found and replace it with the first line of stdout result.
loadSecret :: String -> Secret -> IO Secret
loadSecret :: String -> Secret -> IO Secret
loadSecret String
_ (SecretText Text
txt) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Secret
SecretText Text
txt)
loadSecret String
label (SecretCommand (Text
cmd NonEmpty.:| [Text]
args)) =
  do let u :: Text -> String
u = Text -> String
Text.unpack
     Either IOError (ExitCode, ByteString, ByteString)
res <- forall e a. Exception e => IO a -> IO (Either e a)
try (forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
Process.readProcess (String -> [String] -> ProcessConfig () () ()
Process.proc (Text -> String
u Text
cmd) (forall a b. (a -> b) -> [a] -> [b]
map Text -> String
u [Text]
args)))
     case Either IOError (ExitCode, ByteString, ByteString)
res of
       Right (ExitCode
Exit.ExitSuccess,ByteString
out,ByteString
_) ->
         case ByteString -> Either UnicodeException Text
Text.decodeUtf8' (ByteString -> ByteString
L.toStrict ByteString
out) of
             Right Text
str -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Secret
SecretText ((Char -> Bool) -> Text -> Text
Text.takeWhile (Char
'\n' forall a. Eq a => a -> a -> Bool
/=) Text
str))
             Left UnicodeException
e -> forall e a. Exception e => e -> IO a
throwIO (String -> String -> SecretException
SecretException String
label (forall e. Exception e => e -> String
displayException UnicodeException
e))
       Right (Exit.ExitFailure{},ByteString
_,ByteString
err) ->
         case ByteString -> Either UnicodeException Text
Text.decodeUtf8' (ByteString -> ByteString
L.toStrict ByteString
err) of
             Right Text
str -> forall e a. Exception e => e -> IO a
throwIO (String -> String -> SecretException
SecretException String
label (Text -> String
Text.unpack Text
str))
             Left UnicodeException
e -> forall e a. Exception e => e -> IO a
throwIO (String -> String -> SecretException
SecretException String
label (forall e. Exception e => e -> String
displayException UnicodeException
e))
       Left IOError
ioe -> forall e a. Exception e => e -> IO a
throwIO (String -> String -> SecretException
SecretException String
label (forall e. Exception e => e -> String
displayException (IOError
ioe::IOError)))


netPaletteSpec :: ValueSpec NetworkPalette
netPaletteSpec :: ValueSpec NetworkPalette
netPaletteSpec = 
  forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"palette-net" forall a b. (a -> b) -> a -> b
$
  do HashMap Char Attr
_palCModes <- forall a. a -> Maybe a -> a
fromMaybe forall k v. HashMap k v
HashMap.empty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"cmodes" ValueSpec (HashMap Char Attr)
colorMapSpec
                   Text
"Overrides for the styles used for specific channel mode letters."
     HashMap Char Attr
_palUModes <- forall a. a -> Maybe a -> a
fromMaybe forall k v. HashMap k v
HashMap.empty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"umodes" ValueSpec (HashMap Char Attr)
colorMapSpec
                   Text
"Overrides for the styles used for specific user mode letters."
     HashMap Char Attr
_palSnomask <- forall a. a -> Maybe a -> a
fromMaybe forall k v. HashMap k v
HashMap.empty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"snomask" ValueSpec (HashMap Char Attr)
colorMapSpec
                    Text
"Overrides for the styles used for specific snomask letters."
     pure NetworkPalette{HashMap Char Attr
_palSnomask :: HashMap Char Attr
_palUModes :: HashMap Char Attr
_palCModes :: HashMap Char Attr
_palSnomask :: HashMap Char Attr
_palUModes :: HashMap Char Attr
_palCModes :: HashMap Char Attr
..}
  where
    colorMapSpec :: ValueSpec (HashMap Char Attr)
colorMapSpec = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {b}. (Text, b) -> [(Char, b)]
expand forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ValueSpec a -> ValueSpec [(Text, a)]
assocSpec ValueSpec Attr
attrSpec
      where
        expand :: (Text, b) -> [(Char, b)]
expand (Text
modes, b
style) = [(Char
mode, b
style) | Char
mode <- Text -> String
Text.unpack Text
modes, Char -> Bool
isLetter Char
mode]