{-# LANGUAGE 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
  , ssChanservChannels
  , ssFloodPenalty
  , ssFloodThreshold
  , ssMessageHooks
  , ssName
  , ssReconnectAttempts
  , ssReconnectError
  , ssAutoconnect
  , ssNickCompletion
  , ssLogDir
  , ssBindHostName
  , ssSts
  , ssTlsPubkeyFingerprint
  , ssTlsCertFingerprint
  , ssShowAccounts
  , ssCapabilities

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

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

  -- * Defaults
  , defaultServerSettings

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

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

import           Client.Authentication.Scram (ScramDigest(..))
import           Client.Commands.Interpolation
import           Client.Commands.WordCompletion
import           Client.Configuration.Macros (macroCommandSpec)
import           Config.Schema.Spec
import           Control.Exception (Exception, displayException, throwIO, try)
import           Control.Lens
import           Control.Monad ((>=>))
import qualified Data.ByteString as B
import           Data.ByteString (ByteString)
import           Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.List.Split (chunksOf, splitOn)
import           Data.Maybe (fromMaybe)
import           Data.Monoid
import           Data.Text (Text)
import qualified Data.Text as Text
import           Irc.Identifier (Identifier, mkId)
import           Network.Socket (HostName, PortNumber)
import           Numeric (readHex)
import qualified System.Exit as Exit
import qualified System.Process as Process
import           Text.Regex.TDFA
import           Text.Regex.TDFA.Text (compile)
import           Hookup (TlsVerify(..))

-- | 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 -> HostName
_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 HostName
_ssTlsClientCert    :: !(Maybe FilePath) -- ^ path to client TLS certificate
  , ServerSettings -> Maybe HostName
_ssTlsClientKey     :: !(Maybe FilePath) -- ^ path to client TLS key
  , ServerSettings -> Maybe Secret
_ssTlsClientKeyPassword :: !(Maybe Secret) -- ^ client key PEM password
  , ServerSettings -> Maybe HostName
_ssTlsServerCert    :: !(Maybe FilePath) -- ^ additional CA certificates for validating server
  , ServerSettings -> HostName
_ssTlsCiphers       :: String            -- ^ OpenSSL cipher suite
  , ServerSettings -> Maybe HostName
_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 HostName
_ssSocksHost        :: !(Maybe HostName) -- ^ hostname of SOCKS proxy
  , ServerSettings -> PortNumber
_ssSocksPort        :: !PortNumber -- ^ port of SOCKS proxy
  , 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 HostName
_ssLogDir           :: Maybe FilePath -- ^ Directory to save logs of chat
  , ServerSettings -> Maybe HostName
_ssBindHostName     :: Maybe HostName -- ^ Local bind host
  , ServerSettings -> Bool
_ssShowAccounts     :: !Bool -- ^ Render account names
  , ServerSettings -> [Text]
_ssCapabilities     :: ![Text] -- ^ Extra capabilities to unconditionally request
  }
  deriving Int -> ServerSettings -> ShowS
[ServerSettings] -> ShowS
ServerSettings -> HostName
(Int -> ServerSettings -> ShowS)
-> (ServerSettings -> HostName)
-> ([ServerSettings] -> ShowS)
-> Show ServerSettings
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [ServerSettings] -> ShowS
$cshowList :: [ServerSettings] -> ShowS
show :: ServerSettings -> HostName
$cshow :: ServerSettings -> HostName
showsPrec :: Int -> ServerSettings -> ShowS
$cshowsPrec :: Int -> ServerSettings -> ShowS
Show

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

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

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

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

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

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

makeLenses ''ServerSettings
makePrisms ''SaslMechanism

-- | The defaults for server settings.
defaultServerSettings :: ServerSettings
defaultServerSettings :: ServerSettings
defaultServerSettings =
  ServerSettings :: NonEmpty Text
-> Text
-> Text
-> Maybe Secret
-> Maybe SaslMechanism
-> HostName
-> Maybe PortNumber
-> TlsMode
-> TlsVerify
-> Maybe HostName
-> Maybe HostName
-> Maybe Secret
-> Maybe HostName
-> HostName
-> Maybe HostName
-> Maybe Fingerprint
-> Maybe Fingerprint
-> Bool
-> [[ExpansionChunk]]
-> Maybe HostName
-> PortNumber
-> [Identifier]
-> Rational
-> Rational
-> [HookConfig]
-> Maybe Text
-> Int
-> Maybe KnownRegex
-> Bool
-> WordCompletionMode
-> Maybe HostName
-> Maybe HostName
-> Bool
-> [Text]
-> ServerSettings
ServerSettings
       { _ssNicks :: NonEmpty Text
_ssNicks         = Text -> NonEmpty Text
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 :: HostName
_ssHostName      = HostName
""
       , _ssPort :: Maybe PortNumber
_ssPort          = Maybe PortNumber
forall a. Maybe a
Nothing
       , _ssTls :: TlsMode
_ssTls           = TlsMode
TlsNo
       , _ssTlsVerify :: TlsVerify
_ssTlsVerify     = TlsVerify
VerifyDefault
       , _ssTlsClientCert :: Maybe HostName
_ssTlsClientCert = Maybe HostName
forall a. Maybe a
Nothing
       , _ssTlsClientKey :: Maybe HostName
_ssTlsClientKey  = Maybe HostName
forall a. Maybe a
Nothing
       , _ssTlsClientKeyPassword :: Maybe Secret
_ssTlsClientKeyPassword = Maybe Secret
forall a. Maybe a
Nothing
       , _ssTlsServerCert :: Maybe HostName
_ssTlsServerCert = Maybe HostName
forall a. Maybe a
Nothing
       , _ssTlsCiphers :: HostName
_ssTlsCiphers    = HostName
"HIGH"
       , _ssTls13Ciphers :: Maybe HostName
_ssTls13Ciphers  = Maybe HostName
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 HostName
_ssSocksHost     = Maybe HostName
forall a. Maybe a
Nothing
       , _ssSocksPort :: PortNumber
_ssSocksPort     = PortNumber
1080
       , _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 HostName
_ssLogDir           = Maybe HostName
forall a. Maybe a
Nothing
       , _ssBindHostName :: Maybe HostName
_ssBindHostName     = Maybe HostName
forall a. Maybe a
Nothing
       , _ssShowAccounts :: Bool
_ssShowAccounts     = Bool
False
       , _ssCapabilities :: [Text]
_ssCapabilities     = []
       }

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)
sequenceA [SectionsSpec (Maybe (ServerSettings -> ServerSettings))]
settings
     pure (Maybe Text
mbExt, ServerSettings -> ServerSettings
upd)
  where

    composeMaybe :: [Maybe (a -> a)] -> a -> a
    composeMaybe :: [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
forall a. (a -> a) -> Endo a
Endo ((Maybe (a -> a) -> Endo a) -> [Maybe (a -> a)] -> Endo a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Maybe (a -> a) -> Endo a) -> [Maybe (a -> a)] -> Endo a)
-> (((a -> a) -> Endo a) -> Maybe (a -> a) -> Endo a)
-> ((a -> a) -> Endo a)
-> [Maybe (a -> a)]
-> Endo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> a) -> Endo a) -> Maybe (a -> a) -> Endo a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap)

    req :: Text
-> ASetter s t a b
-> ValueSpec b
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
name ASetter s t a b
l ValueSpec b
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 b -> b -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s t a b
l (b -> s -> t) -> ValueSpec b -> ValueSpec (s -> t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec b
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 (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 (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 HostName HostName
-> ValueSpec HostName
-> Text
-> SectionsSpec (Maybe (ServerSettings -> ServerSettings))
forall s t a b.
Text
-> ASetter s t a b
-> ValueSpec b
-> Text
-> SectionsSpec (Maybe (s -> t))
req Text
"hostname" ASetter ServerSettings ServerSettings HostName HostName
Lens' ServerSettings HostName
ssHostName ValueSpec HostName
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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 HostName) (Maybe HostName)
-> ValueSpec HostName
-> 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 HostName) (Maybe HostName)
Lens' ServerSettings (Maybe HostName)
ssTlsClientCert ValueSpec HostName
filepathSpec
        Text
"Path to TLS client certificate"

      , Text
-> ASetter
     ServerSettings ServerSettings (Maybe HostName) (Maybe HostName)
-> ValueSpec HostName
-> 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 HostName) (Maybe HostName)
Lens' ServerSettings (Maybe HostName)
ssTlsClientKey ValueSpec HostName
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 HostName) (Maybe HostName)
-> ValueSpec HostName
-> 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 HostName) (Maybe HostName)
Lens' ServerSettings (Maybe HostName)
ssTlsServerCert ValueSpec HostName
filepathSpec
        Text
"Path to CA certificate bundle"

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

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

      , Text
-> ASetter
     ServerSettings ServerSettings (Maybe HostName) (Maybe HostName)
-> ValueSpec HostName
-> 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 HostName) (Maybe HostName)
Lens' ServerSettings (Maybe HostName)
ssSocksHost ValueSpec HostName
stringSpec
        Text
"Hostname of SOCKS5 proxy server"

      , Text
-> ASetter ServerSettings ServerSettings PortNumber PortNumber
-> ValueSpec PortNumber
-> Text
-> SectionsSpec (Maybe (ServerSettings -> ServerSettings))
forall s t a b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 [[ExpansionChunk]] [[ExpansionChunk]]
-> ValueSpec [[ExpansionChunk]]
-> Text
-> SectionsSpec (Maybe (ServerSettings -> ServerSettings))
forall s t a b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 HostName) (Maybe HostName)
-> ValueSpec HostName
-> 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 HostName) (Maybe HostName)
Lens' ServerSettings (Maybe HostName)
ssLogDir ValueSpec HostName
filepathSpec
        Text
"Path to log file directory for this server"

      , Text
-> ASetter
     ServerSettings ServerSettings (Maybe HostName) (Maybe HostName)
-> ValueSpec HostName
-> 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 HostName) (Maybe HostName)
Lens' ServerSettings (Maybe HostName)
ssBindHostName ValueSpec HostName
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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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 b.
Text
-> ASetter s t a b
-> ValueSpec b
-> 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"
      ]

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

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

saslMechanismSpec :: ValueSpec SaslMechanism
saslMechanismSpec :: ValueSpec SaslMechanism
saslMechanismSpec = ValueSpec SaslMechanism
plain ValueSpec SaslMechanism
-> ValueSpec SaslMechanism -> ValueSpec SaslMechanism
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec SaslMechanism
external ValueSpec SaslMechanism
-> ValueSpec SaslMechanism -> ValueSpec SaslMechanism
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec SaslMechanism
ecdsa ValueSpec SaslMechanism
-> ValueSpec SaslMechanism -> ValueSpec SaslMechanism
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec SaslMechanism
scram ValueSpec SaslMechanism
-> ValueSpec SaslMechanism -> ValueSpec SaslMechanism
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 (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SectionsSpec Text
username SectionsSpec (Secret -> SaslMechanism)
-> SectionsSpec Secret -> SectionsSpec SaslMechanism
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 (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 (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 -> HostName -> SaslMechanism
SaslEcdsa (Maybe Text -> Text -> HostName -> SaslMechanism)
-> SectionsSpec ()
-> SectionsSpec (Maybe Text -> Text -> HostName -> SaslMechanism)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> SectionsSpec ()
mech Text
"ecdsa-nist256p-challenge" SectionsSpec (Maybe Text -> Text -> HostName -> SaslMechanism)
-> SectionsSpec (Maybe Text)
-> SectionsSpec (Text -> HostName -> SaslMechanism)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
      SectionsSpec (Maybe Text)
authzid SectionsSpec (Text -> HostName -> SaslMechanism)
-> SectionsSpec Text -> SectionsSpec (HostName -> SaslMechanism)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SectionsSpec Text
username SectionsSpec (HostName -> SaslMechanism)
-> SectionsSpec HostName -> SectionsSpec SaslMechanism
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
      Text -> ValueSpec HostName -> Text -> SectionsSpec HostName
forall a. Text -> ValueSpec a -> Text -> SectionsSpec a
reqSection' Text
"private-key" ValueSpec HostName
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 (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"sha1" ValueSpec ScramDigest
-> ValueSpec ScramDigest -> ValueSpec ScramDigest
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
      ScramDigest
ScramDigestSha2_256 ScramDigest -> ValueSpec () -> ValueSpec ScramDigest
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"sha2-256" ValueSpec ScramDigest
-> ValueSpec ScramDigest -> ValueSpec ScramDigest
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
      ScramDigest
ScramDigestSha2_512 ScramDigest -> ValueSpec () -> ValueSpec ScramDigest
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 (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 (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SectionsSpec Text
username SectionsSpec (Secret -> SaslMechanism)
-> SectionsSpec Secret -> SectionsSpec SaslMechanism
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 (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SectionsSpec Text
username SectionsSpec (Secret -> SaslMechanism)
-> SectionsSpec Secret -> SectionsSpec SaslMechanism
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 HostName
filepathSpec = Text
-> ValueSpec HostName
-> (HostName -> Either Text HostName)
-> ValueSpec HostName
forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
"path" ValueSpec HostName
stringSpec ((HostName -> Either Text HostName) -> ValueSpec HostName)
-> (HostName -> Either Text HostName) -> ValueSpec HostName
forall a b. (a -> b) -> a -> b
$ \HostName
str ->
  if HostName -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HostName
str
  then Text -> Either Text HostName
forall a b. a -> Either a b
Left Text
"empty path"
  else HostName -> Either Text HostName
forall a b. b -> Either a b
Right HostName
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 (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 HostName
-> (HostName -> Either Text Fingerprint)
-> ValueSpec Fingerprint
forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
"fingerprint" ValueSpec HostName
stringSpec ((HostName -> Either Text Fingerprint) -> ValueSpec Fingerprint)
-> (HostName -> Either Text Fingerprint) -> ValueSpec Fingerprint
forall a b. (a -> b) -> a -> b
$ \HostName
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
<$> (HostName -> Either Text Word8)
-> [HostName] -> Either Text [Word8]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse HostName -> Either Text Word8
forall b a. (Num b, IsString a) => HostName -> Either a b
readWord8 (HostName -> [HostName]
byteStrs HostName
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 :: HostName -> Either a b
readWord8 HostName
i =
      case ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readHex HostName
i of
        [(Integer
x,HostName
"")]
          | 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, HostName)]
_ -> a -> Either a b
forall a b. a -> Either a b
Left a
"bad hex-encoded byte"

    byteStrs :: String -> [String]
    byteStrs :: HostName -> [HostName]
byteStrs HostName
str
      | Char
':' Char -> HostName -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` HostName
str = HostName -> HostName -> [HostName]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn HostName
":" HostName
str
      | Bool
otherwise      = Int -> HostName -> [HostName]
forall e. Int -> [e] -> [[e]]
chunksOf Int
2  HostName
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 (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"default"
  ValueSpec WordCompletionMode
-> ValueSpec WordCompletionMode -> ValueSpec WordCompletionMode
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> WordCompletionMode
slackNickWordCompleteMode   WordCompletionMode -> ValueSpec () -> ValueSpec WordCompletionMode
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"slack"
  ValueSpec WordCompletionMode
-> ValueSpec WordCompletionMode -> ValueSpec WordCompletionMode
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 HostName
wcmStartPrefix  <- HostName -> Maybe HostName -> HostName
forall a. a -> Maybe a -> a
fromMaybe HostName
"" (Maybe HostName -> HostName)
-> SectionsSpec (Maybe HostName) -> SectionsSpec HostName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ValueSpec HostName -> Text -> SectionsSpec (Maybe HostName)
forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"start-prefix" ValueSpec HostName
stringSpec
                        Text
"Prefix for nickname with when completing at start of line."
     HostName
wcmStartSuffix  <- HostName -> Maybe HostName -> HostName
forall a. a -> Maybe a -> a
fromMaybe HostName
"" (Maybe HostName -> HostName)
-> SectionsSpec (Maybe HostName) -> SectionsSpec HostName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ValueSpec HostName -> Text -> SectionsSpec (Maybe HostName)
forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"start-suffix" ValueSpec HostName
stringSpec
                        Text
"Suffix for nickname with when completing at start of line."
     HostName
wcmMiddlePrefix <- HostName -> Maybe HostName -> HostName
forall a. a -> Maybe a -> a
fromMaybe HostName
"" (Maybe HostName -> HostName)
-> SectionsSpec (Maybe HostName) -> SectionsSpec HostName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ValueSpec HostName -> Text -> SectionsSpec (Maybe HostName)
forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"middle-prefix" ValueSpec HostName
stringSpec
                        Text
"Prefix for nickname with when completing in middle of line."
     HostName
wcmMiddleSuffix <- HostName -> Maybe HostName -> HostName
forall a. a -> Maybe a -> a
fromMaybe HostName
"" (Maybe HostName -> HostName)
-> SectionsSpec (Maybe HostName) -> SectionsSpec HostName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ValueSpec HostName -> Text -> SectionsSpec (Maybe HostName)
forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"middle-suffix" ValueSpec HostName
stringSpec
                        Text
"Suffix for nickname with when completing in middle of line."
     pure WordCompletionMode :: HostName -> HostName -> HostName -> HostName -> WordCompletionMode
WordCompletionMode{HostName
wcmMiddleSuffix :: HostName
wcmMiddlePrefix :: HostName
wcmStartSuffix :: HostName
wcmStartPrefix :: HostName
wcmMiddleSuffix :: HostName
wcmMiddlePrefix :: HostName
wcmStartSuffix :: HostName
wcmStartPrefix :: HostName
..}


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 HostName Regex
compile CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt ExecOption :: Bool -> ExecOption
ExecOption{captureGroups :: Bool
captureGroups = Bool
False} Text
str of
    Left HostName
e  -> Text -> Either Text KnownRegex
forall a b. a -> Either a b
Left  (HostName -> Text
Text.pack HostName
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 (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 -> HostName
(Int -> SecretException -> ShowS)
-> (SecretException -> HostName)
-> ([SecretException] -> ShowS)
-> Show SecretException
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [SecretException] -> ShowS
$cshowList :: [SecretException] -> ShowS
show :: SecretException -> HostName
$cshow :: SecretException -> HostName
showsPrec :: Int -> SecretException -> ShowS
$cshowsPrec :: Int -> SecretException -> ShowS
Show

instance Exception SecretException

-- | Run the secret commands in a server configuration replacing them with secret text.
-- Throws 'SecretException'
loadSecrets :: ServerSettings -> IO ServerSettings
loadSecrets :: ServerSettings -> IO ServerSettings
loadSecrets =
  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. Prism (Maybe a) (Maybe b) a b
_Just                  ) (HostName -> Secret -> IO Secret
loadSecret HostName
"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 SaslMechanism -> IO (Maybe SaslMechanism))
-> ServerSettings -> IO ServerSettings
Lens' ServerSettings (Maybe SaslMechanism)
ssSaslMechanism        ((Maybe SaslMechanism -> IO (Maybe SaslMechanism))
 -> ServerSettings -> IO ServerSettings)
-> ((Secret -> IO Secret)
    -> Maybe SaslMechanism -> IO (Maybe SaslMechanism))
-> LensLike IO ServerSettings ServerSettings Secret Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SaslMechanism -> IO SaslMechanism)
-> Maybe SaslMechanism -> IO (Maybe SaslMechanism)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((SaslMechanism -> IO SaslMechanism)
 -> Maybe SaslMechanism -> IO (Maybe SaslMechanism))
-> ((Secret -> IO Secret) -> SaslMechanism -> IO SaslMechanism)
-> (Secret -> IO Secret)
-> Maybe SaslMechanism
-> IO (Maybe SaslMechanism)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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))
-> (Secret -> IO Secret)
-> SaslMechanism
-> IO SaslMechanism
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
_3) (HostName -> Secret -> IO Secret
loadSecret HostName
"SASL 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. Prism (Maybe a) (Maybe b) a b
_Just                  ) (HostName -> Secret -> IO Secret
loadSecret HostName
"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 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 SaslMechanism -> IO (Maybe SaslMechanism))
-> ServerSettings -> IO ServerSettings
Lens' ServerSettings (Maybe SaslMechanism)
ssSaslMechanism        ((Maybe SaslMechanism -> IO (Maybe SaslMechanism))
 -> ServerSettings -> IO ServerSettings)
-> ((Secret -> IO Secret)
    -> Maybe SaslMechanism -> IO (Maybe SaslMechanism))
-> LensLike IO ServerSettings ServerSettings Secret Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SaslMechanism -> IO SaslMechanism)
-> Maybe SaslMechanism -> IO (Maybe SaslMechanism)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((SaslMechanism -> IO SaslMechanism)
 -> Maybe SaslMechanism -> IO (Maybe SaslMechanism))
-> ((Secret -> IO Secret) -> SaslMechanism -> IO SaslMechanism)
-> (Secret -> IO Secret)
-> Maybe SaslMechanism
-> IO (Maybe SaslMechanism)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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))
-> (Secret -> IO Secret)
-> SaslMechanism
-> IO SaslMechanism
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
_4) (HostName -> Secret -> IO Secret
loadSecret HostName
"SASL 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 SaslMechanism -> IO (Maybe SaslMechanism))
-> ServerSettings -> IO ServerSettings
Lens' ServerSettings (Maybe SaslMechanism)
ssSaslMechanism        ((Maybe SaslMechanism -> IO (Maybe SaslMechanism))
 -> ServerSettings -> IO ServerSettings)
-> ((Secret -> IO Secret)
    -> Maybe SaslMechanism -> IO (Maybe SaslMechanism))
-> LensLike IO ServerSettings ServerSettings Secret Secret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SaslMechanism -> IO SaslMechanism)
-> Maybe SaslMechanism -> IO (Maybe SaslMechanism)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((SaslMechanism -> IO SaslMechanism)
 -> Maybe SaslMechanism -> IO (Maybe SaslMechanism))
-> ((Secret -> IO Secret) -> SaslMechanism -> IO SaslMechanism)
-> (Secret -> IO Secret)
-> Maybe SaslMechanism
-> IO (Maybe SaslMechanism)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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))
-> (Secret -> IO Secret)
-> SaslMechanism
-> IO SaslMechanism
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
_3) (HostName -> Secret -> IO Secret
loadSecret HostName
"SASL private key")

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