{-# LANGUAGE LambdaCase, ApplicativeDo, TemplateHaskell, OverloadedStrings, RecordWildCards, BlockArguments #-}
module Client.Configuration.ServerSettings
(
ServerSettings(..)
, HookConfig(..)
, serverSpec
, identifierSpec
, 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
, SaslMechanism(..)
, _SaslExternal
, _SaslEcdsa
, _SaslPlain
, _SaslScram
, Secret(..)
, SecretException(..)
, loadSecrets
, WindowHint(..)
, defaultServerSettings
, UseTls(..)
, Fingerprint(..)
, TlsMode(..)
, 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)
data ServerSettings = ServerSettings
{ ServerSettings -> NonEmpty Text
_ssNicks :: !(NonEmpty Text)
, ServerSettings -> Text
_ssUser :: !Text
, ServerSettings -> Text
_ssReal :: !Text
, ServerSettings -> Maybe Secret
_ssPassword :: !(Maybe Secret)
, ServerSettings -> Maybe SaslMechanism
_ssSaslMechanism :: !(Maybe SaslMechanism)
, ServerSettings -> String
_ssHostName :: !HostName
, ServerSettings -> Maybe PortNumber
_ssPort :: !(Maybe PortNumber)
, ServerSettings -> TlsMode
_ssTls :: !TlsMode
, ServerSettings -> TlsVerify
_ssTlsVerify :: !TlsVerify
, ServerSettings -> Maybe String
_ssTlsClientCert :: !(Maybe FilePath)
, ServerSettings -> Maybe String
_ssTlsClientKey :: !(Maybe FilePath)
, ServerSettings -> Maybe Secret
_ssTlsClientKeyPassword :: !(Maybe Secret)
, ServerSettings -> Maybe String
_ssTlsServerCert :: !(Maybe FilePath)
, ServerSettings -> String
_ssTlsCiphers :: String
, ServerSettings -> Maybe String
_ssTls13Ciphers :: Maybe String
, ServerSettings -> Maybe Fingerprint
_ssTlsPubkeyFingerprint :: !(Maybe Fingerprint)
, ServerSettings -> Maybe Fingerprint
_ssTlsCertFingerprint :: !(Maybe Fingerprint)
, ServerSettings -> Bool
_ssSts :: !Bool
, ServerSettings -> [[ExpansionChunk]]
_ssConnectCmds :: ![[ExpansionChunk]]
, ServerSettings -> Maybe String
_ssSocksHost :: !(Maybe HostName)
, ServerSettings -> PortNumber
_ssSocksPort :: !PortNumber
, ServerSettings -> Maybe Text
_ssSocksUsername :: !(Maybe Text)
, ServerSettings -> Maybe Secret
_ssSocksPassword :: !(Maybe Secret)
, ServerSettings -> [Identifier]
_ssChanservChannels :: ![Identifier]
, ServerSettings -> Rational
_ssFloodPenalty :: !Rational
, ServerSettings -> Rational
_ssFloodThreshold :: !Rational
, ServerSettings -> [HookConfig]
_ssMessageHooks :: ![HookConfig]
, ServerSettings -> Maybe Text
_ssName :: !(Maybe Text)
, ServerSettings -> Int
_ssReconnectAttempts:: !Int
, ServerSettings -> Maybe KnownRegex
_ssReconnectError :: !(Maybe KnownRegex)
, ServerSettings -> Bool
_ssAutoconnect :: !Bool
, ServerSettings -> WordCompletionMode
_ssNickCompletion :: WordCompletionMode
, ServerSettings -> Maybe String
_ssLogDir :: Maybe FilePath
, ServerSettings -> Maybe String
_ssBindHostName :: Maybe HostName
, ServerSettings -> Bool
_ssShowAccounts :: !Bool
, ServerSettings -> [Text]
_ssCapabilities :: ![Text]
, 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
| SecretCommand (NonEmpty 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
data SaslMechanism
= SaslPlain (Maybe Text) Text Secret
| SaslEcdsa (Maybe Text) Text FilePath
| SaslExternal (Maybe Text)
| SaslScram ScramDigest (Maybe Text) Text Secret
| SaslEcdh (Maybe Text) Text Secret
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
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
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
data UseTls
= UseTls
| UseInsecureTls
| UseInsecure
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
data Fingerprint
= FingerprintSha1 ByteString
| FingerprintSha256 ByteString
| FingerprintSha512 ByteString
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
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
, _ssFloodThreshold :: Rational
_ssFloodThreshold = Rational
10
, _ssMessageHooks :: [HookConfig]
_ssMessageHooks = []
, _ssName :: Maybe Text
_ssName = forall a. Maybe a
Nothing
, _ssReconnectAttempts :: Int
_ssReconnectAttempts= Int
6
, _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"
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
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
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
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
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")
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]