{-# 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
(Int -> ServerSettings -> ShowS)
-> (ServerSettings -> String)
-> ([ServerSettings] -> ShowS)
-> Show ServerSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerSettings -> ShowS
showsPrec :: Int -> ServerSettings -> ShowS
$cshow :: ServerSettings -> String
show :: ServerSettings -> String
$cshowList :: [ServerSettings] -> ShowS
showList :: [ServerSettings] -> ShowS
Show

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

data Secret
  = SecretText Text    -- ^ Constant text
  | SecretCommand (NonEmpty Text) -- ^ Command to generate text
  deriving Int -> Secret -> ShowS
[Secret] -> ShowS
Secret -> String
(Int -> Secret -> ShowS)
-> (Secret -> String) -> ([Secret] -> ShowS) -> Show Secret
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Secret -> ShowS
showsPrec :: Int -> Secret -> ShowS
$cshow :: Secret -> String
show :: Secret -> String
$cshowList :: [Secret] -> ShowS
showList :: [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
(Int -> SaslMechanism -> ShowS)
-> (SaslMechanism -> String)
-> ([SaslMechanism] -> ShowS)
-> Show SaslMechanism
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SaslMechanism -> ShowS
showsPrec :: Int -> SaslMechanism -> ShowS
$cshow :: SaslMechanism -> String
show :: SaslMechanism -> String
$cshowList :: [SaslMechanism] -> ShowS
showList :: [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
(Int -> WindowHint -> ShowS)
-> (WindowHint -> String)
-> ([WindowHint] -> ShowS)
-> Show WindowHint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowHint -> ShowS
showsPrec :: Int -> WindowHint -> ShowS
$cshow :: WindowHint -> String
show :: WindowHint -> String
$cshowList :: [WindowHint] -> ShowS
showList :: [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
_) = Text -> String
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
(Int -> HookConfig -> ShowS)
-> (HookConfig -> String)
-> ([HookConfig] -> ShowS)
-> Show HookConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HookConfig -> ShowS
showsPrec :: Int -> HookConfig -> ShowS
$cshow :: HookConfig -> String
show :: HookConfig -> String
$cshowList :: [HookConfig] -> ShowS
showList :: [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
(Int -> UseTls -> ShowS)
-> (UseTls -> String) -> ([UseTls] -> ShowS) -> Show UseTls
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UseTls -> ShowS
showsPrec :: Int -> UseTls -> ShowS
$cshow :: UseTls -> String
show :: UseTls -> String
$cshowList :: [UseTls] -> ShowS
showList :: [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
(Int -> Fingerprint -> ShowS)
-> (Fingerprint -> String)
-> ([Fingerprint] -> ShowS)
-> Show Fingerprint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Fingerprint -> ShowS
showsPrec :: Int -> Fingerprint -> ShowS
$cshow :: Fingerprint -> String
show :: Fingerprint -> String
$cshowList :: [Fingerprint] -> ShowS
showList :: [Fingerprint] -> ShowS
Show

makeLenses ''ServerSettings
makePrisms ''SaslMechanism

-- | The defaults for server settings.
defaultServerSettings :: ServerSettings
defaultServerSettings :: ServerSettings
defaultServerSettings =
  ServerSettings
       { _ssNicks :: NonEmpty Text
_ssNicks         = Text -> NonEmpty Text
forall a. a -> NonEmpty a
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      = Maybe Secret
forall a. Maybe a
Nothing
       , _ssSaslMechanism :: Maybe SaslMechanism
_ssSaslMechanism = Maybe SaslMechanism
forall a. Maybe a
Nothing
       , _ssHostName :: String
_ssHostName      = String
""
       , _ssPort :: Maybe PortNumber
_ssPort          = Maybe PortNumber
forall a. Maybe a
Nothing
       , _ssTls :: TlsMode
_ssTls           = TlsMode
TlsNo
       , _ssTlsVerify :: TlsVerify
_ssTlsVerify     = TlsVerify
VerifyDefault
       , _ssTlsClientCert :: Maybe String
_ssTlsClientCert = Maybe String
forall a. Maybe a
Nothing
       , _ssTlsClientKey :: Maybe String
_ssTlsClientKey  = Maybe String
forall a. Maybe a
Nothing
       , _ssTlsClientKeyPassword :: Maybe Secret
_ssTlsClientKeyPassword = Maybe Secret
forall a. Maybe a
Nothing
       , _ssTlsServerCert :: Maybe String
_ssTlsServerCert = Maybe String
forall a. Maybe a
Nothing
       , _ssTlsCiphers :: String
_ssTlsCiphers    = String
"HIGH"
       , _ssTls13Ciphers :: Maybe String
_ssTls13Ciphers  = Maybe String
forall a. Maybe a
Nothing
       , _ssTlsPubkeyFingerprint :: Maybe Fingerprint
_ssTlsPubkeyFingerprint = Maybe Fingerprint
forall a. Maybe a
Nothing
       , _ssTlsCertFingerprint :: Maybe Fingerprint
_ssTlsCertFingerprint   = Maybe Fingerprint
forall a. Maybe a
Nothing
       , _ssSts :: Bool
_ssSts              = Bool
True
       , _ssConnectCmds :: [[ExpansionChunk]]
_ssConnectCmds   = []
       , _ssSocksHost :: Maybe String
_ssSocksHost     = Maybe String
forall a. Maybe a
Nothing
       , _ssSocksPort :: PortNumber
_ssSocksPort     = PortNumber
1080
       , _ssSocksUsername :: Maybe Text
_ssSocksUsername = Maybe Text
forall a. Maybe a
Nothing
       , _ssSocksPassword :: Maybe Secret
_ssSocksPassword = Maybe Secret
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             = Maybe Text
forall a. Maybe a
Nothing
       , _ssReconnectAttempts :: Int
_ssReconnectAttempts= Int
6 -- six feels great
       , _ssReconnectError :: Maybe KnownRegex
_ssReconnectError   = Maybe KnownRegex
forall a. Maybe a
Nothing
       , _ssAutoconnect :: Bool
_ssAutoconnect      = Bool
False
       , _ssNickCompletion :: WordCompletionMode
_ssNickCompletion   = WordCompletionMode
defaultNickWordCompleteMode
       , _ssLogDir :: Maybe String
_ssLogDir           = Maybe String
forall a. Maybe a
Nothing
       , _ssBindHostName :: Maybe String
_ssBindHostName     = Maybe String
forall a. Maybe a
Nothing
       , _ssShowAccounts :: Bool
_ssShowAccounts     = Bool
False
       , _ssCapabilities :: [Text]
_ssCapabilities     = []
       , _ssWindowHints :: Map Focus WindowHint
_ssWindowHints      = Map Focus WindowHint
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 = Text
-> SectionsSpec (Maybe Text, ServerSettings -> ServerSettings)
-> ValueSpec (Maybe Text, ServerSettings -> ServerSettings)
forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"server-settings" (SectionsSpec (Maybe Text, ServerSettings -> ServerSettings)
 -> ValueSpec (Maybe Text, ServerSettings -> ServerSettings))
-> SectionsSpec (Maybe Text, ServerSettings -> ServerSettings)
-> ValueSpec (Maybe Text, ServerSettings -> ServerSettings)
forall a b. (a -> b) -> a -> b
$
  do Maybe Text
mbExt <- Text -> Text -> SectionsSpec (Maybe Text)
forall a. HasSpec a => Text -> Text -> SectionsSpec (Maybe a)
optSection Text
"extends" Text
"name of a server to use for defaults"
     ServerSettings -> ServerSettings
upd <- [Maybe (ServerSettings -> ServerSettings)]
-> ServerSettings -> ServerSettings
forall a. [Maybe (a -> a)] -> a -> a
composeMaybe ([Maybe (ServerSettings -> ServerSettings)]
 -> ServerSettings -> ServerSettings)
-> SectionsSpec [Maybe (ServerSettings -> ServerSettings)]
-> SectionsSpec (ServerSettings -> ServerSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SectionsSpec (Maybe (ServerSettings -> ServerSettings))]
-> SectionsSpec [Maybe (ServerSettings -> ServerSettings)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [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 = (Unwrapped (Endo a) -> Endo a)
-> ((Unwrapped (Endo a) -> Endo a) -> [Maybe (a -> a)] -> Endo a)
-> [Maybe (a -> a)]
-> Unwrapped (Endo a)
forall (f :: * -> *) s t.
(Functor f, Rewrapping s t) =>
(Unwrapped s -> s)
-> ((Unwrapped t -> t) -> f s) -> f (Unwrapped s)
ala Unwrapped (Endo a) -> Endo a
(a -> a) -> Endo a
forall a. (a -> a) -> Endo a
Endo ((Maybe (Unwrapped (Endo a)) -> Endo a)
-> [Maybe (Unwrapped (Endo a))] -> Endo a
(Maybe (Unwrapped (Endo a)) -> Endo a)
-> [Maybe (a -> a)] -> Endo a
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Maybe (Unwrapped (Endo a)) -> Endo a)
 -> [Maybe (a -> a)] -> Endo a)
-> ((Unwrapped (Endo a) -> Endo a)
    -> Maybe (Unwrapped (Endo a)) -> Endo a)
-> (Unwrapped (Endo a) -> Endo a)
-> [Maybe (a -> a)]
-> Endo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped (Endo a) -> Endo a)
-> Maybe (Unwrapped (Endo a)) -> Endo a
forall m a. Monoid m => (a -> m) -> Maybe a -> m
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
      = Text -> ValueSpec (s -> t) -> Text -> SectionsSpec (Maybe (s -> t))
forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
name (ValueSpec (s -> t) -> Text -> SectionsSpec (Maybe (s -> t)))
-> Text -> ValueSpec (s -> t) -> SectionsSpec (Maybe (s -> t))
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? Text
info
      (ValueSpec (s -> t) -> SectionsSpec (Maybe (s -> t)))
-> ValueSpec (s -> t) -> SectionsSpec (Maybe (s -> t))
forall a b. (a -> b) -> a -> b
$ ASetter s t a a -> a -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s t a a
l (a -> s -> t) -> ValueSpec a -> ValueSpec (s -> t)
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
      = Text -> ValueSpec (s -> t) -> Text -> SectionsSpec (Maybe (s -> t))
forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
name (ValueSpec (s -> t) -> Text -> SectionsSpec (Maybe (s -> t)))
-> Text -> ValueSpec (s -> t) -> SectionsSpec (Maybe (s -> t))
forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
?? Text
info
      (ValueSpec (s -> t) -> SectionsSpec (Maybe (s -> t)))
-> ValueSpec (s -> t) -> SectionsSpec (Maybe (s -> t))
forall a b. (a -> b) -> a -> b
$ ASetter s t a (Maybe a) -> Maybe a -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s t a (Maybe a)
l (Maybe a -> s -> t) -> (a -> Maybe a) -> a -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> s -> t) -> ValueSpec a -> ValueSpec (s -> t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec a
s ValueSpec (s -> t) -> ValueSpec (s -> t) -> ValueSpec (s -> t)
forall a. ValueSpec a -> ValueSpec a -> ValueSpec a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
        ASetter s t a (Maybe a) -> Maybe a -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s t a (Maybe a)
l Maybe a
forall a. Maybe a
Nothing (s -> t) -> ValueSpec () -> ValueSpec (s -> t)
forall a b. a -> ValueSpec b -> ValueSpec a
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 =
      [ Text
-> ASetter ServerSettings ServerSettings (Maybe Text) (Maybe Text)
-> ValueSpec Text
-> Text
-> SectionsSpec (Maybe (ServerSettings -> ServerSettings))
forall {s} {t} {a} {a}.
Text
-> ASetter s t a (Maybe a)
-> ValueSpec a
-> Text
-> SectionsSpec (Maybe (s -> t))
opt Text
"name" ASetter ServerSettings ServerSettings (Maybe Text) (Maybe Text)
Lens' ServerSettings (Maybe Text)
ssName ValueSpec Text
forall a. HasSpec a => ValueSpec a
anySpec
        Text
"The name used to identify this server in the client"

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

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

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

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

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

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

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

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

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

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

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

      , Text
-> ASetter
     ServerSettings ServerSettings (Maybe Secret) (Maybe Secret)
-> ValueSpec Secret
-> Text
-> SectionsSpec (Maybe (ServerSettings -> ServerSettings))
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" ASetter ServerSettings ServerSettings (Maybe Secret) (Maybe Secret)
Lens' ServerSettings (Maybe Secret)
ssTlsClientKeyPassword ValueSpec Secret
forall a. HasSpec a => ValueSpec a
anySpec
        Text
"Password for decrypting TLS client key PEM file"

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

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

      , Text
-> ASetter
     ServerSettings ServerSettings (Maybe String) (Maybe String)
-> ValueSpec String
-> Text
-> SectionsSpec (Maybe (ServerSettings -> ServerSettings))
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" ASetter ServerSettings ServerSettings (Maybe String) (Maybe String)
Lens' ServerSettings (Maybe String)
ssTls13Ciphers ValueSpec String
stringSpec
        Text
"OpenSSL TLS 1.3 cipher specification."

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

tlsModeSpec :: ValueSpec TlsMode
tlsModeSpec :: ValueSpec TlsMode
tlsModeSpec =
  TlsMode
TlsYes   TlsMode -> ValueSpec () -> ValueSpec TlsMode
forall a b. a -> ValueSpec b -> ValueSpec a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"yes"      ValueSpec TlsMode -> ValueSpec TlsMode -> ValueSpec TlsMode
forall a. ValueSpec a -> ValueSpec a -> ValueSpec a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  TlsMode
TlsNo    TlsMode -> ValueSpec () -> ValueSpec TlsMode
forall a b. a -> ValueSpec b -> ValueSpec a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"no"       ValueSpec TlsMode -> ValueSpec TlsMode -> ValueSpec TlsMode
forall a. ValueSpec a -> ValueSpec a -> ValueSpec a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  TlsMode
TlsStart TlsMode -> ValueSpec () -> ValueSpec TlsMode
forall a b. a -> ValueSpec b -> ValueSpec a
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 = NonEmpty (ValueSpec ActivityFilter) -> ValueSpec ActivityFilter
forall (t :: * -> *) (m :: * -> *) a.
(Foldable1 t, Alt m) =>
t (m a) -> m a
asum1 ([ValueSpec ActivityFilter] -> NonEmpty (ValueSpec ActivityFilter)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList ((ActivityFilter -> ValueSpec ActivityFilter)
-> [ActivityFilter] -> [ValueSpec ActivityFilter]
forall a b. (a -> b) -> [a] -> [b]
map ActivityFilter -> ValueSpec ActivityFilter
forall {a}. Show a => a -> ValueSpec a
mkSpec [(Int -> ActivityFilter
forall a. Enum a => Int -> a
toEnum Int
0)..]))
  where
    mkSpec :: a -> ValueSpec a
mkSpec a
a = a
a a -> ValueSpec () -> ValueSpec a
forall a b. a -> ValueSpec b -> ValueSpec a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec (String -> Text
Text.pack (a -> String
forall a. Show a => a -> String
show a
a))

tlsVerifySpec :: ValueSpec TlsVerify
tlsVerifySpec :: ValueSpec TlsVerify
tlsVerifySpec =
  TlsVerify
VerifyDefault  TlsVerify -> ValueSpec () -> ValueSpec TlsVerify
forall a b. a -> ValueSpec b -> ValueSpec a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"yes"      ValueSpec TlsVerify -> ValueSpec TlsVerify -> ValueSpec TlsVerify
forall a. ValueSpec a -> ValueSpec a -> ValueSpec a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  TlsVerify
VerifyNone     TlsVerify -> ValueSpec () -> ValueSpec TlsVerify
forall a b. a -> ValueSpec b -> ValueSpec a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"no"       ValueSpec TlsVerify -> ValueSpec TlsVerify -> ValueSpec TlsVerify
forall a. ValueSpec a -> ValueSpec a -> ValueSpec a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  String -> TlsVerify
VerifyHostname (String -> TlsVerify) -> ValueSpec String -> ValueSpec TlsVerify
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 ValueSpec SaslMechanism
-> ValueSpec SaslMechanism -> ValueSpec SaslMechanism
forall a. ValueSpec a -> ValueSpec a -> ValueSpec a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec SaslMechanism
external ValueSpec SaslMechanism
-> ValueSpec SaslMechanism -> ValueSpec SaslMechanism
forall a. ValueSpec a -> ValueSpec a -> ValueSpec a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec SaslMechanism
ecdsa ValueSpec SaslMechanism
-> ValueSpec SaslMechanism -> ValueSpec SaslMechanism
forall a. ValueSpec a -> ValueSpec a -> ValueSpec a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec SaslMechanism
scram ValueSpec SaslMechanism
-> ValueSpec SaslMechanism -> ValueSpec SaslMechanism
forall a. ValueSpec a -> ValueSpec a -> ValueSpec a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec SaslMechanism
ecdh
  where
    mech :: Text -> SectionsSpec ()
mech Text
m   = Text -> ValueSpec () -> Text -> SectionsSpec ()
forall a. Text -> ValueSpec a -> Text -> SectionsSpec a
reqSection' Text
"mechanism" (Text -> ValueSpec ()
atomSpec Text
m) Text
"Mechanism"
    authzid :: SectionsSpec (Maybe Text)
authzid  = Text -> Text -> SectionsSpec (Maybe Text)
forall a. HasSpec a => Text -> Text -> SectionsSpec (Maybe a)
optSection Text
"authzid" Text
"Authorization identity"
    username :: SectionsSpec Text
username = Text -> Text -> SectionsSpec Text
forall a. HasSpec a => Text -> Text -> SectionsSpec a
reqSection Text
"username" Text
"Authentication identity"

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

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

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

    scramDigest :: SectionsSpec ScramDigest
scramDigest =
      ScramDigest -> Maybe ScramDigest -> ScramDigest
forall a. a -> Maybe a -> a
fromMaybe ScramDigest
ScramDigestSha2_256 (Maybe ScramDigest -> ScramDigest)
-> SectionsSpec (Maybe ScramDigest) -> SectionsSpec ScramDigest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      Text
-> ValueSpec ScramDigest
-> Text
-> SectionsSpec (Maybe ScramDigest)
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     ScramDigest -> ValueSpec () -> ValueSpec ScramDigest
forall a b. a -> ValueSpec b -> ValueSpec a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"sha1" ValueSpec ScramDigest
-> ValueSpec ScramDigest -> ValueSpec ScramDigest
forall a. ValueSpec a -> ValueSpec a -> ValueSpec a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
      ScramDigest
ScramDigestSha2_256 ScramDigest -> ValueSpec () -> ValueSpec ScramDigest
forall a b. a -> ValueSpec b -> ValueSpec a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"sha2-256" ValueSpec ScramDigest
-> ValueSpec ScramDigest -> ValueSpec ScramDigest
forall a. ValueSpec a -> ValueSpec a -> ValueSpec a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
      ScramDigest
ScramDigestSha2_512 ScramDigest -> ValueSpec () -> ValueSpec ScramDigest
forall a b. a -> ValueSpec b -> ValueSpec a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"sha2-512"

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

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


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

hookSpec :: ValueSpec HookConfig
hookSpec :: ValueSpec HookConfig
hookSpec =
  (Text -> [Text] -> HookConfig) -> [Text] -> Text -> HookConfig
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Text] -> HookConfig
HookConfig [] (Text -> HookConfig) -> ValueSpec Text -> ValueSpec HookConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec Text
forall a. HasSpec a => ValueSpec a
anySpec ValueSpec HookConfig
-> ValueSpec HookConfig -> ValueSpec HookConfig
forall a. ValueSpec a -> ValueSpec a -> ValueSpec a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  (\(Text
x:|[Text]
xs) -> Text -> [Text] -> HookConfig
HookConfig Text
x [Text]
xs) (NonEmpty Text -> HookConfig)
-> ValueSpec (NonEmpty Text) -> ValueSpec HookConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec Text -> ValueSpec (NonEmpty Text)
forall a. ValueSpec a -> ValueSpec (NonEmpty a)
nonemptySpec ValueSpec Text
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 =
  Text
-> ValueSpec String
-> (String -> Either Text Fingerprint)
-> ValueSpec Fingerprint
forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
"fingerprint" ValueSpec String
stringSpec ((String -> Either Text Fingerprint) -> ValueSpec Fingerprint)
-> (String -> Either Text Fingerprint) -> ValueSpec Fingerprint
forall a b. (a -> b) -> a -> b
$ \String
str ->
    do ByteString
bytes <- [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> Either Text [Word8] -> Either Text ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Either Text Word8) -> [String] -> Either Text [Word8]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse String -> Either Text Word8
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 -> Fingerprint -> Either Text Fingerprint
forall a b. b -> Either a b
Right (ByteString -> Fingerprint
FingerprintSha1   ByteString
bytes)
         Int
32 -> Fingerprint -> Either Text Fingerprint
forall a b. b -> Either a b
Right (ByteString -> Fingerprint
FingerprintSha256 ByteString
bytes)
         Int
64 -> Fingerprint -> Either Text Fingerprint
forall a b. b -> Either a b
Right (ByteString -> Fingerprint
FingerprintSha512 ByteString
bytes)
         Int
_  -> Text -> Either Text Fingerprint
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 ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readHex String
i of
        [(Integer
x,String
"")]
          | Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
x, Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
256 -> b -> Either a b
forall a b. b -> Either a b
Right (Integer -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
x :: Integer))
          | Bool
otherwise -> a -> Either a b
forall a b. a -> Either a b
Left a
"byte out-of-bounds"
        [(Integer, String)]
_ -> a -> Either a b
forall a b. a -> Either a b
Left a
"bad hex-encoded byte"

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

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

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

customNickCompletion :: ValueSpec WordCompletionMode
customNickCompletion :: ValueSpec WordCompletionMode
customNickCompletion =
  Text
-> SectionsSpec WordCompletionMode -> ValueSpec WordCompletionMode
forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"nick-completion" (SectionsSpec WordCompletionMode -> ValueSpec WordCompletionMode)
-> SectionsSpec WordCompletionMode -> ValueSpec WordCompletionMode
forall a b. (a -> b) -> a -> b
$
  do String
wcmStartPrefix  <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> SectionsSpec (Maybe String) -> SectionsSpec String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ValueSpec String -> Text -> SectionsSpec (Maybe String)
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  <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> SectionsSpec (Maybe String) -> SectionsSpec String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ValueSpec String -> Text -> SectionsSpec (Maybe String)
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 <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> SectionsSpec (Maybe String) -> SectionsSpec String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ValueSpec String -> Text -> SectionsSpec (Maybe String)
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 <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> SectionsSpec (Maybe String) -> SectionsSpec String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ValueSpec String -> Text -> SectionsSpec (Maybe String)
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
wcmStartPrefix :: String
wcmStartSuffix :: String
wcmMiddlePrefix :: String
wcmMiddleSuffix :: String
wcmStartPrefix :: String
wcmStartSuffix :: String
wcmMiddlePrefix :: String
wcmMiddleSuffix :: String
..}


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

regexSpec :: ValueSpec KnownRegex
regexSpec :: ValueSpec KnownRegex
regexSpec = Text
-> ValueSpec Text
-> (Text -> Either Text KnownRegex)
-> ValueSpec KnownRegex
forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
"regex" ValueSpec Text
forall a. HasSpec a => ValueSpec a
anySpec ((Text -> Either Text KnownRegex) -> ValueSpec KnownRegex)
-> (Text -> Either Text KnownRegex) -> ValueSpec KnownRegex
forall a b. (a -> b) -> a -> b
$ \Text
str ->
  case CompOption -> ExecOption -> Text -> Either String Regex
compile CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt ExecOption{captureGroups :: Bool
captureGroups = Bool
False} Text
str of
    Left String
e  -> Text -> Either Text KnownRegex
forall a b. a -> Either a b
Left  (String -> Text
Text.pack String
e)
    Right Regex
r -> KnownRegex -> Either Text KnownRegex
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 (Text -> Secret) -> ValueSpec Text -> ValueSpec Secret
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec Text
textSpec ValueSpec Secret -> ValueSpec Secret -> ValueSpec Secret
forall a. ValueSpec a -> ValueSpec a -> ValueSpec a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
    NonEmpty Text -> Secret
SecretCommand (NonEmpty Text -> Secret)
-> ValueSpec (NonEmpty Text) -> ValueSpec Secret
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> SectionsSpec (NonEmpty Text) -> ValueSpec (NonEmpty Text)
forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"command" (Text -> Text -> SectionsSpec (NonEmpty Text)
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
(Int -> SecretException -> ShowS)
-> (SecretException -> String)
-> ([SecretException] -> ShowS)
-> Show SecretException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecretException -> ShowS
showsPrec :: Int -> SecretException -> ShowS
$cshow :: SecretException -> String
show :: SecretException -> String
$cshowList :: [SecretException] -> ShowS
showList :: [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 =
  LensLike IO ServerSettings ServerSettings Secret Secret
-> LensLike IO ServerSettings ServerSettings Secret Secret
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf ((Maybe Secret -> IO (Maybe Secret))
-> ServerSettings -> IO ServerSettings
Lens' ServerSettings (Maybe Secret)
ssPassword             ((Maybe Secret -> IO (Maybe Secret))
 -> ServerSettings -> IO ServerSettings)
-> ((Secret -> IO Secret) -> Maybe Secret -> IO (Maybe Secret))
-> LensLike IO ServerSettings ServerSettings Secret Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Secret -> IO Secret) -> Maybe Secret -> IO (Maybe Secret)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) (String -> Secret -> IO Secret
loadSecret String
"server password") (ServerSettings -> IO ServerSettings)
-> (ServerSettings -> IO ServerSettings)
-> ServerSettings
-> IO ServerSettings
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  LensLike IO ServerSettings ServerSettings Secret Secret
-> LensLike IO ServerSettings ServerSettings Secret Secret
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf ((Maybe Secret -> IO (Maybe Secret))
-> ServerSettings -> IO ServerSettings
Lens' ServerSettings (Maybe Secret)
ssSocksPassword        ((Maybe Secret -> IO (Maybe Secret))
 -> ServerSettings -> IO ServerSettings)
-> ((Secret -> IO Secret) -> Maybe Secret -> IO (Maybe Secret))
-> LensLike IO ServerSettings ServerSettings Secret Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Secret -> IO Secret) -> Maybe Secret -> IO (Maybe Secret)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) (String -> Secret -> IO Secret
loadSecret String
"socks password") (ServerSettings -> IO ServerSettings)
-> (ServerSettings -> IO ServerSettings)
-> ServerSettings
-> IO ServerSettings
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  LensLike IO ServerSettings ServerSettings Secret Secret
-> LensLike IO ServerSettings ServerSettings Secret Secret
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf ((Maybe Secret -> IO (Maybe Secret))
-> ServerSettings -> IO ServerSettings
Lens' ServerSettings (Maybe Secret)
ssTlsClientKeyPassword ((Maybe Secret -> IO (Maybe Secret))
 -> ServerSettings -> IO ServerSettings)
-> ((Secret -> IO Secret) -> Maybe Secret -> IO (Maybe Secret))
-> LensLike IO ServerSettings ServerSettings Secret Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Secret -> IO Secret) -> Maybe Secret -> IO (Maybe Secret)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) (String -> Secret -> IO Secret
loadSecret String
"TLS key password") (ServerSettings -> IO ServerSettings)
-> (ServerSettings -> IO ServerSettings)
-> ServerSettings
-> IO ServerSettings
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  LensLike
  IO ServerSettings ServerSettings SaslMechanism SaslMechanism
-> LensLike
     IO ServerSettings ServerSettings SaslMechanism SaslMechanism
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf ((Maybe SaslMechanism -> IO (Maybe SaslMechanism))
-> ServerSettings -> IO ServerSettings
Lens' ServerSettings (Maybe SaslMechanism)
ssSaslMechanism        ((Maybe SaslMechanism -> IO (Maybe SaslMechanism))
 -> ServerSettings -> IO ServerSettings)
-> ((SaslMechanism -> IO SaslMechanism)
    -> Maybe SaslMechanism -> IO (Maybe SaslMechanism))
-> LensLike
     IO ServerSettings ServerSettings SaslMechanism SaslMechanism
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SaslMechanism -> IO SaslMechanism)
-> Maybe SaslMechanism -> IO (Maybe SaslMechanism)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just) SaslMechanism -> IO SaslMechanism
loadSaslSecret

-- | Populate secrets from sasl mechanism
loadSaslSecret :: SaslMechanism -> IO SaslMechanism
loadSaslSecret :: SaslMechanism -> IO SaslMechanism
loadSaslSecret =
  LensLike IO SaslMechanism SaslMechanism Secret Secret
-> LensLike IO SaslMechanism SaslMechanism Secret Secret
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf (((Maybe Text, Text, Secret) -> IO (Maybe Text, Text, Secret))
-> SaslMechanism -> IO SaslMechanism
Prism' SaslMechanism (Maybe Text, Text, Secret)
_SaslPlain (((Maybe Text, Text, Secret) -> IO (Maybe Text, Text, Secret))
 -> SaslMechanism -> IO SaslMechanism)
-> ((Secret -> IO Secret)
    -> (Maybe Text, Text, Secret) -> IO (Maybe Text, Text, Secret))
-> LensLike IO SaslMechanism SaslMechanism Secret Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Secret -> IO Secret)
-> (Maybe Text, Text, Secret) -> IO (Maybe Text, Text, Secret)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Maybe Text, Text, Secret) (Maybe Text, Text, Secret) Secret Secret
_3) (String -> Secret -> IO Secret
loadSecret String
"SASL plain password") (SaslMechanism -> IO SaslMechanism)
-> (SaslMechanism -> IO SaslMechanism)
-> SaslMechanism
-> IO SaslMechanism
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  LensLike IO SaslMechanism SaslMechanism Secret Secret
-> LensLike IO SaslMechanism SaslMechanism Secret Secret
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf (((ScramDigest, Maybe Text, Text, Secret)
 -> IO (ScramDigest, Maybe Text, Text, Secret))
-> SaslMechanism -> IO SaslMechanism
Prism' SaslMechanism (ScramDigest, Maybe Text, Text, Secret)
_SaslScram (((ScramDigest, Maybe Text, Text, Secret)
  -> IO (ScramDigest, Maybe Text, Text, Secret))
 -> SaslMechanism -> IO SaslMechanism)
-> ((Secret -> IO Secret)
    -> (ScramDigest, Maybe Text, Text, Secret)
    -> IO (ScramDigest, Maybe Text, Text, Secret))
-> LensLike IO SaslMechanism SaslMechanism Secret Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Secret -> IO Secret)
-> (ScramDigest, Maybe Text, Text, Secret)
-> IO (ScramDigest, Maybe Text, Text, Secret)
forall s t a b. Field4 s t a b => Lens s t a b
Lens
  (ScramDigest, Maybe Text, Text, Secret)
  (ScramDigest, Maybe Text, Text, Secret)
  Secret
  Secret
_4) (String -> Secret -> IO Secret
loadSecret String
"SASL scram password") (SaslMechanism -> IO SaslMechanism)
-> (SaslMechanism -> IO SaslMechanism)
-> SaslMechanism
-> IO SaslMechanism
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
  LensLike IO SaslMechanism SaslMechanism Secret Secret
-> LensLike IO SaslMechanism SaslMechanism Secret Secret
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf (((Maybe Text, Text, Secret) -> IO (Maybe Text, Text, Secret))
-> SaslMechanism -> IO SaslMechanism
Prism' SaslMechanism (Maybe Text, Text, Secret)
_SaslEcdh  (((Maybe Text, Text, Secret) -> IO (Maybe Text, Text, Secret))
 -> SaslMechanism -> IO SaslMechanism)
-> ((Secret -> IO Secret)
    -> (Maybe Text, Text, Secret) -> IO (Maybe Text, Text, Secret))
-> LensLike IO SaslMechanism SaslMechanism Secret Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Secret -> IO Secret)
-> (Maybe Text, Text, Secret) -> IO (Maybe Text, Text, Secret)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Maybe Text, Text, Secret) (Maybe Text, Text, Secret) Secret Secret
_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) = Secret -> IO Secret
forall a. a -> IO a
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 <- IO (ExitCode, ByteString, ByteString)
-> IO (Either IOError (ExitCode, ByteString, ByteString))
forall e a. Exception e => IO a -> IO (Either e a)
try (ProcessConfig () () () -> IO (ExitCode, ByteString, ByteString)
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) ((Text -> String) -> [Text] -> [String]
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 -> Secret -> IO Secret
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Secret
SecretText ((Char -> Bool) -> Text -> Text
Text.takeWhile (Char
'\n' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=) Text
str))
             Left UnicodeException
e -> SecretException -> IO Secret
forall e a. Exception e => e -> IO a
throwIO (String -> String -> SecretException
SecretException String
label (UnicodeException -> String
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 -> SecretException -> IO Secret
forall e a. Exception e => e -> IO a
throwIO (String -> String -> SecretException
SecretException String
label (Text -> String
Text.unpack Text
str))
             Left UnicodeException
e -> SecretException -> IO Secret
forall e a. Exception e => e -> IO a
throwIO (String -> String -> SecretException
SecretException String
label (UnicodeException -> String
forall e. Exception e => e -> String
displayException UnicodeException
e))
       Left IOError
ioe -> SecretException -> IO Secret
forall e a. Exception e => e -> IO a
throwIO (String -> String -> SecretException
SecretException String
label (IOError -> String
forall e. Exception e => e -> String
displayException (IOError
ioe::IOError)))


netPaletteSpec :: ValueSpec NetworkPalette
netPaletteSpec :: ValueSpec NetworkPalette
netPaletteSpec = 
  Text -> SectionsSpec NetworkPalette -> ValueSpec NetworkPalette
forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"palette-net" (SectionsSpec NetworkPalette -> ValueSpec NetworkPalette)
-> SectionsSpec NetworkPalette -> ValueSpec NetworkPalette
forall a b. (a -> b) -> a -> b
$
  do HashMap Char Attr
_palCModes <- HashMap Char Attr -> Maybe (HashMap Char Attr) -> HashMap Char Attr
forall a. a -> Maybe a -> a
fromMaybe HashMap Char Attr
forall k v. HashMap k v
HashMap.empty (Maybe (HashMap Char Attr) -> HashMap Char Attr)
-> SectionsSpec (Maybe (HashMap Char Attr))
-> SectionsSpec (HashMap Char Attr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ValueSpec (HashMap Char Attr)
-> Text
-> SectionsSpec (Maybe (HashMap Char Attr))
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 <- HashMap Char Attr -> Maybe (HashMap Char Attr) -> HashMap Char Attr
forall a. a -> Maybe a -> a
fromMaybe HashMap Char Attr
forall k v. HashMap k v
HashMap.empty (Maybe (HashMap Char Attr) -> HashMap Char Attr)
-> SectionsSpec (Maybe (HashMap Char Attr))
-> SectionsSpec (HashMap Char Attr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ValueSpec (HashMap Char Attr)
-> Text
-> SectionsSpec (Maybe (HashMap Char Attr))
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 <- HashMap Char Attr -> Maybe (HashMap Char Attr) -> HashMap Char Attr
forall a. a -> Maybe a -> a
fromMaybe HashMap Char Attr
forall k v. HashMap k v
HashMap.empty (Maybe (HashMap Char Attr) -> HashMap Char Attr)
-> SectionsSpec (Maybe (HashMap Char Attr))
-> SectionsSpec (HashMap Char Attr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ValueSpec (HashMap Char Attr)
-> Text
-> SectionsSpec (Maybe (HashMap Char Attr))
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
_palCModes :: HashMap Char Attr
_palUModes :: HashMap Char Attr
_palSnomask :: HashMap Char Attr
_palCModes :: HashMap Char Attr
_palUModes :: HashMap Char Attr
_palSnomask :: HashMap Char Attr
..}
  where
    colorMapSpec :: ValueSpec (HashMap Char Attr)
colorMapSpec = [(Char, Attr)] -> HashMap Char Attr
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Char, Attr)] -> HashMap Char Attr)
-> ([(Text, Attr)] -> [(Char, Attr)])
-> [(Text, Attr)]
-> HashMap Char Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Attr) -> [(Char, Attr)])
-> [(Text, Attr)] -> [(Char, Attr)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, Attr) -> [(Char, Attr)]
forall {b}. (Text, b) -> [(Char, b)]
expand ([(Text, Attr)] -> HashMap Char Attr)
-> ValueSpec [(Text, Attr)] -> ValueSpec (HashMap Char Attr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec Attr -> ValueSpec [(Text, Attr)]
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]