{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiWayIf #-}
module Matterhorn.Config
  ( Config(..)
  , PasswordSource(..)
  , findConfig
  , defaultConfig
  , configConnectionType
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import qualified Paths_matterhorn as Paths

import           Brick.Keybindings
import           Control.Monad.Trans.Except
import           Control.Monad.Trans.Class ( lift )
import           Data.Char ( isDigit, isAlpha )
import           Data.List ( isPrefixOf )
import           Data.List.Split ( splitOn )
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Graphics.Vty as Vty
import           System.Directory ( makeAbsolute, getHomeDirectory )
import           System.Environment ( getExecutablePath )
import           System.FilePath ( (</>), takeDirectory, splitPath, joinPath )
import           System.Process ( readProcess )
import           Network.Mattermost.Types (ConnectionType(..))
import           Network.URI ( isIPv4address, isIPv6address )

import           Matterhorn.Config.Schema
import           Matterhorn.FilePaths
import           Matterhorn.IOUtil
import           Matterhorn.Types


defaultPort :: Int
defaultPort :: Int
defaultPort = Int
443

bundledSyntaxPlaceholderName :: String
bundledSyntaxPlaceholderName :: String
bundledSyntaxPlaceholderName = String
"BUNDLED_SYNTAX"

userSyntaxPlaceholderName :: String
userSyntaxPlaceholderName :: String
userSyntaxPlaceholderName = String
"USER_SYNTAX"

defaultSkylightingPaths :: IO [FilePath]
defaultSkylightingPaths :: IO [String]
defaultSkylightingPaths = do
    String
xdg <- IO String
xdgSyntaxDir
    [String]
dataDirs <- IO [String]
xdgDataDirs
    String
adjacent <- IO String
getBundledSyntaxPath
    String
cabalDataFiles <- String -> IO String
Paths.getDataFileName String
syntaxDirName
    [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String
xdg, String
adjacent, String
cabalDataFiles] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
dataDirs

getBundledSyntaxPath :: IO FilePath
getBundledSyntaxPath :: IO String
getBundledSyntaxPath = do
    String
selfPath <- IO String
getExecutablePath
    let distDir :: String
distDir = String
"dist-newstyle/"
        pathBits :: [String]
pathBits = String -> [String]
splitPath String
selfPath

    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ if String
distDir String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
pathBits
             then
                 -- We're in development, so use the development
                 -- executable path to locate the XML path in the
                 -- development tree.
                 ([String] -> String
joinPath ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
distDir) [String]
pathBits) String -> String -> String
</> String
syntaxDirName
             else
                 -- In this case we assume the binary is being run from
                 -- a release, in which case the syntax directory is a
                 -- sibling of the executable path.
                 String -> String
takeDirectory String
selfPath String -> String -> String
</> String
syntaxDirName

fromIni :: IniParser Config
fromIni :: IniParser Config
fromIni = do
  Text -> SectionParser Config -> IniParser Config
forall a. Text -> SectionParser a -> IniParser a
section Text
"mattermost" (SectionParser Config -> IniParser Config)
-> SectionParser Config -> IniParser Config
forall a b. (a -> b) -> a -> b
$ do
    Maybe Text
configUser           <- Text -> (Text -> Either String Text) -> SectionParser (Maybe Text)
forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"user" Text -> Either String Text
forall e. Text -> Either e Text
stringField
    Maybe Text
configHost           <- Text -> (Text -> Either String Text) -> SectionParser (Maybe Text)
forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"host" Text -> Either String Text
hostField
    Maybe Text
configTeam           <- Text -> (Text -> Either String Text) -> SectionParser (Maybe Text)
forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"team" Text -> Either String Text
forall e. Text -> Either e Text
stringField
    Int
configPort           <- Text -> (Text -> Either String Int) -> Int -> SectionParser Int
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"port" Text -> Either String Int
forall a. (Num a, Read a, Typeable a) => Text -> Either String a
number (Config -> Int
configPort Config
defaultConfig)
    Maybe Text
configUrlPath        <- Text -> (Text -> Either String Text) -> SectionParser (Maybe Text)
forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"urlPath" Text -> Either String Text
forall e. Text -> Either e Text
stringField
    ChannelListWidth
configChannelListWidth <- Text
-> (Text -> Either String ChannelListWidth)
-> ChannelListWidth
-> SectionParser ChannelListWidth
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"channelListWidth" Text -> Either String ChannelListWidth
channelListWidthField
                              (Config -> ChannelListWidth
configChannelListWidth Config
defaultConfig)
    CPUUsagePolicy
configCpuUsagePolicy <- Text
-> (Text -> Either String CPUUsagePolicy)
-> CPUUsagePolicy
-> SectionParser CPUUsagePolicy
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"cpuUsagePolicy" Text -> Either String CPUUsagePolicy
cpuUsagePolicy
                            (Config -> CPUUsagePolicy
configCpuUsagePolicy Config
defaultConfig)
    Int
configLogMaxBufferSize <- Text -> (Text -> Either String Int) -> Int -> SectionParser Int
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"logMaxBufferSize" Text -> Either String Int
forall a. (Num a, Read a, Typeable a) => Text -> Either String a
number
                              (Config -> Int
configLogMaxBufferSize Config
defaultConfig)
    Maybe Text
configTimeFormat     <- Text -> (Text -> Either String Text) -> SectionParser (Maybe Text)
forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"timeFormat" Text -> Either String Text
forall e. Text -> Either e Text
stringField
    Maybe Text
configDateFormat     <- Text -> (Text -> Either String Text) -> SectionParser (Maybe Text)
forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"dateFormat" Text -> Either String Text
forall e. Text -> Either e Text
stringField
    Maybe Text
configTheme          <- Text -> (Text -> Either String Text) -> SectionParser (Maybe Text)
forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"theme" Text -> Either String Text
forall e. Text -> Either e Text
stringField
    Maybe Text
configThemeCustomizationFile <- Text -> (Text -> Either String Text) -> SectionParser (Maybe Text)
forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"themeCustomizationFile" Text -> Either String Text
forall e. Text -> Either e Text
stringField
    Maybe Text
configAspellDictionary <- Text -> (Text -> Either String Text) -> SectionParser (Maybe Text)
forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"aspellDictionary" Text -> Either String Text
forall e. Text -> Either e Text
stringField
    Maybe Text
configURLOpenCommand <- Text -> (Text -> Either String Text) -> SectionParser (Maybe Text)
forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"urlOpenCommand" Text -> Either String Text
forall e. Text -> Either e Text
stringField
    Bool
configURLOpenCommandInteractive <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"urlOpenCommandIsInteractive" Bool
False
    Bool
configSmartBacktick  <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"smartbacktick"
      (Config -> Bool
configSmartBacktick Config
defaultConfig)
    Bool
configSmartEditing <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"smartediting"
      (Config -> Bool
configSmartEditing Config
defaultConfig)
    Bool
configShowOlderEdits <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"showOlderEdits"
      (Config -> Bool
configShowOlderEdits Config
defaultConfig)
    BackgroundInfo
configShowBackground <- Text
-> (Text -> Either String BackgroundInfo)
-> BackgroundInfo
-> SectionParser BackgroundInfo
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"showBackgroundActivity" Text -> Either String BackgroundInfo
backgroundField
      (Config -> BackgroundInfo
configShowBackground Config
defaultConfig)
    Bool
configShowMessagePreview <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"showMessagePreview"
      (Config -> Bool
configShowMessagePreview Config
defaultConfig)
    Bool
configShowChannelList <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"showChannelList"
      (Config -> Bool
configShowChannelList Config
defaultConfig)
    Bool
configShowExpandedChannelTopics <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"showExpandedChannelTopics"
      (Config -> Bool
configShowExpandedChannelTopics Config
defaultConfig)
    Bool
configShowTypingIndicator <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"showTypingIndicator"
      (Config -> Bool
configShowTypingIndicator Config
defaultConfig)
    Bool
configSendTypingNotifications <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"sendTypingNotifications"
      (Config -> Bool
configSendTypingNotifications Config
defaultConfig)
    Bool
configEnableAspell <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"enableAspell"
      (Config -> Bool
configEnableAspell Config
defaultConfig)
    [String]
configSyntaxDirs <- Text
-> (Text -> Either String [String])
-> [String]
-> SectionParser [String]
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"syntaxDirectories" Text -> Either String [String]
syntaxDirsField []
    Maybe Text
configActivityNotifyCommand <- Text -> SectionParser (Maybe Text)
fieldMb Text
"activityNotifyCommand"
    NotificationVersion
configActivityNotifyVersion <- Text
-> (Text -> Either String NotificationVersion)
-> NotificationVersion
-> SectionParser NotificationVersion
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"activityNotifyVersion"
      Text -> Either String NotificationVersion
notifyVersion (Config -> NotificationVersion
configActivityNotifyVersion Config
defaultConfig)
    Bool
configShowMessageTimestamps <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"showMessageTimestamps"
      (Config -> Bool
configShowMessageTimestamps Config
defaultConfig)
    Bool
configActivityBell <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"activityBell"
      (Config -> Bool
configActivityBell Config
defaultConfig)
    Int
configTruncateVerbatimBlocksInt <- Text -> (Text -> Either String Int) -> Int -> SectionParser Int
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"truncateVerbatimBlockHeight" Text -> Either String Int
forall a. (Num a, Read a, Typeable a) => Text -> Either String a
number
      (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Int -> Int
forall a. a -> a
id (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Config -> Maybe Int
configTruncateVerbatimBlocks Config
defaultConfig)
    ChannelListSorting
configChannelListSorting <- Text
-> (Text -> Either String ChannelListSorting)
-> ChannelListSorting
-> SectionParser ChannelListSorting
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"channelListSorting"
      Text -> Either String ChannelListSorting
parseChannelListSorting (Config -> ChannelListSorting
configChannelListSorting Config
defaultConfig)
    TeamListSorting
configTeamListSorting <- Text
-> (Text -> Either String TeamListSorting)
-> TeamListSorting
-> SectionParser TeamListSorting
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"teamListSorting"
      Text -> Either String TeamListSorting
parseTeamListSorting (Config -> TeamListSorting
configTeamListSorting Config
defaultConfig)
    let configTruncateVerbatimBlocks :: Maybe Int
configTruncateVerbatimBlocks = case Int
configTruncateVerbatimBlocksInt of
            Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> Maybe Int
forall a. Maybe a
Nothing
              | Bool
otherwise -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
    Bool
configHyperlinkingMode <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"hyperlinkURLs"
      (Config -> Bool
configHyperlinkingMode Config
defaultConfig)
    Bool
configShowLastOpenThread <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"showLastOpenThread"
      (Config -> Bool
configShowLastOpenThread Config
defaultConfig)
    Maybe PasswordSource
configPass <- (PasswordSource -> Maybe PasswordSource
forall a. a -> Maybe a
Just (PasswordSource -> Maybe PasswordSource)
-> (Text -> PasswordSource) -> Text -> Maybe PasswordSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PasswordSource
PasswordCommand (Text -> Maybe PasswordSource)
-> Parser IniSection IniValue Text
-> Parser IniSection IniValue (Maybe PasswordSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser IniSection IniValue Text
field Text
"passcmd") Parser IniSection IniValue (Maybe PasswordSource)
-> Parser IniSection IniValue (Maybe PasswordSource)
-> Parser IniSection IniValue (Maybe PasswordSource)
forall e t a. Parser e t a -> Parser e t a -> Parser e t a
<!>
                  (PasswordSource -> Maybe PasswordSource
forall a. a -> Maybe a
Just (PasswordSource -> Maybe PasswordSource)
-> (Text -> PasswordSource) -> Text -> Maybe PasswordSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PasswordSource
PasswordString  (Text -> Maybe PasswordSource)
-> Parser IniSection IniValue Text
-> Parser IniSection IniValue (Maybe PasswordSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser IniSection IniValue Text
field Text
"pass") Parser IniSection IniValue (Maybe PasswordSource)
-> Parser IniSection IniValue (Maybe PasswordSource)
-> Parser IniSection IniValue (Maybe PasswordSource)
forall e t a. Parser e t a -> Parser e t a -> Parser e t a
<!>
                  Maybe PasswordSource
-> Parser IniSection IniValue (Maybe PasswordSource)
forall a. a -> Parser IniSection IniValue a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PasswordSource
forall a. Maybe a
Nothing
    ChannelListOrientation
configChannelListOrientation <- Text
-> (Text -> Either String ChannelListOrientation)
-> ChannelListOrientation
-> SectionParser ChannelListOrientation
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"channelListOrientation"
        Text -> Either String ChannelListOrientation
channelListOrientationField
        (Config -> ChannelListOrientation
configChannelListOrientation Config
defaultConfig)
    ThreadOrientation
configThreadOrientation <- Text
-> (Text -> Either String ThreadOrientation)
-> ThreadOrientation
-> SectionParser ThreadOrientation
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"threadOrientation"
        Text -> Either String ThreadOrientation
threadOrientationField
        (Config -> ThreadOrientation
configThreadOrientation Config
defaultConfig)
    Maybe TokenSource
configToken <- (TokenSource -> Maybe TokenSource
forall a. a -> Maybe a
Just (TokenSource -> Maybe TokenSource)
-> (Text -> TokenSource) -> Text -> Maybe TokenSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TokenSource
TokenCommand  (Text -> Maybe TokenSource)
-> Parser IniSection IniValue Text
-> Parser IniSection IniValue (Maybe TokenSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser IniSection IniValue Text
field Text
"tokencmd") Parser IniSection IniValue (Maybe TokenSource)
-> Parser IniSection IniValue (Maybe TokenSource)
-> Parser IniSection IniValue (Maybe TokenSource)
forall e t a. Parser e t a -> Parser e t a -> Parser e t a
<!>
                   Maybe TokenSource -> Parser IniSection IniValue (Maybe TokenSource)
forall a. a -> Parser IniSection IniValue a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TokenSource
forall a. Maybe a
Nothing
    Maybe OTPTokenSource
configOTPToken <- (OTPTokenSource -> Maybe OTPTokenSource
forall a. a -> Maybe a
Just (OTPTokenSource -> Maybe OTPTokenSource)
-> (Text -> OTPTokenSource) -> Text -> Maybe OTPTokenSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> OTPTokenSource
OTPTokenCommand  (Text -> Maybe OTPTokenSource)
-> Parser IniSection IniValue Text
-> Parser IniSection IniValue (Maybe OTPTokenSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser IniSection IniValue Text
field Text
"otptokencmd") Parser IniSection IniValue (Maybe OTPTokenSource)
-> Parser IniSection IniValue (Maybe OTPTokenSource)
-> Parser IniSection IniValue (Maybe OTPTokenSource)
forall e t a. Parser e t a -> Parser e t a -> Parser e t a
<!>
                      Maybe OTPTokenSource
-> Parser IniSection IniValue (Maybe OTPTokenSource)
forall a. a -> Parser IniSection IniValue a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe OTPTokenSource
forall a. Maybe a
Nothing
    Bool
configUnsafeUseHTTP <-
      Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"unsafeUseUnauthenticatedConnection" Bool
False
    Bool
configValidateServerCertificate <-
      Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"validateServerCertificate" Bool
True
    Int
configDirectChannelExpirationDays <- Text -> (Text -> Either String Int) -> Int -> SectionParser Int
forall a. Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf Text
"directChannelExpirationDays" Text -> Either String Int
forall a. (Num a, Read a, Typeable a) => Text -> Either String a
number
      (Config -> Int
configDirectChannelExpirationDays Config
defaultConfig)
    Maybe String
configDefaultAttachmentPath <- Text
-> (Text -> Either String String) -> SectionParser (Maybe String)
forall a.
Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf Text
"defaultAttachmentPath" Text -> Either String String
forall e. Text -> Either e String
filePathField
    Bool
configMouseMode <- Text -> Bool -> SectionParser Bool
fieldFlagDef Text
"enableMouseMode"
      (Config -> Bool
configMouseMode Config
defaultConfig)

    let configAbsPath :: Maybe a
configAbsPath = Maybe a
forall a. Maybe a
Nothing
        configUserKeys :: KeyConfig KeyEvent
configUserKeys = KeyEvents KeyEvent
-> [(KeyEvent, [Binding])]
-> [(KeyEvent, BindingState)]
-> KeyConfig KeyEvent
forall k.
Ord k =>
KeyEvents k
-> [(k, [Binding])] -> [(k, BindingState)] -> KeyConfig k
newKeyConfig KeyEvents KeyEvent
allEvents [] []
    Config -> SectionParser Config
forall a. a -> Parser IniSection IniValue a
forall (m :: * -> *) a. Monad m => a -> m a
return Config { Bool
Int
[String]
Maybe Int
Maybe String
Maybe Text
Maybe OTPTokenSource
Maybe TokenSource
Maybe PasswordSource
KeyConfig KeyEvent
ThreadOrientation
ChannelListOrientation
BackgroundInfo
CPUUsagePolicy
ChannelListWidth
TeamListSorting
ChannelListSorting
NotificationVersion
forall a. Maybe a
configUser :: Maybe Text
configHost :: Maybe Text
configTeam :: Maybe Text
configPort :: Int
configPort :: Int
configUrlPath :: Maybe Text
configChannelListWidth :: ChannelListWidth
configChannelListWidth :: ChannelListWidth
configCpuUsagePolicy :: CPUUsagePolicy
configCpuUsagePolicy :: CPUUsagePolicy
configLogMaxBufferSize :: Int
configLogMaxBufferSize :: Int
configTimeFormat :: Maybe Text
configDateFormat :: Maybe Text
configTheme :: Maybe Text
configThemeCustomizationFile :: Maybe Text
configAspellDictionary :: Maybe Text
configURLOpenCommand :: Maybe Text
configURLOpenCommandInteractive :: Bool
configSmartBacktick :: Bool
configSmartBacktick :: Bool
configSmartEditing :: Bool
configSmartEditing :: Bool
configShowOlderEdits :: Bool
configShowOlderEdits :: Bool
configShowBackground :: BackgroundInfo
configShowBackground :: BackgroundInfo
configShowMessagePreview :: Bool
configShowMessagePreview :: Bool
configShowChannelList :: Bool
configShowChannelList :: Bool
configShowExpandedChannelTopics :: Bool
configShowExpandedChannelTopics :: Bool
configShowTypingIndicator :: Bool
configShowTypingIndicator :: Bool
configSendTypingNotifications :: Bool
configSendTypingNotifications :: Bool
configEnableAspell :: Bool
configEnableAspell :: Bool
configSyntaxDirs :: [String]
configActivityNotifyCommand :: Maybe Text
configActivityNotifyVersion :: NotificationVersion
configActivityNotifyVersion :: NotificationVersion
configShowMessageTimestamps :: Bool
configShowMessageTimestamps :: Bool
configActivityBell :: Bool
configActivityBell :: Bool
configTruncateVerbatimBlocks :: Maybe Int
configChannelListSorting :: ChannelListSorting
configChannelListSorting :: ChannelListSorting
configTeamListSorting :: TeamListSorting
configTeamListSorting :: TeamListSorting
configTruncateVerbatimBlocks :: Maybe Int
configHyperlinkingMode :: Bool
configHyperlinkingMode :: Bool
configShowLastOpenThread :: Bool
configShowLastOpenThread :: Bool
configPass :: Maybe PasswordSource
configChannelListOrientation :: ChannelListOrientation
configChannelListOrientation :: ChannelListOrientation
configThreadOrientation :: ThreadOrientation
configThreadOrientation :: ThreadOrientation
configToken :: Maybe TokenSource
configOTPToken :: Maybe OTPTokenSource
configUnsafeUseHTTP :: Bool
configValidateServerCertificate :: Bool
configDirectChannelExpirationDays :: Int
configDirectChannelExpirationDays :: Int
configDefaultAttachmentPath :: Maybe String
configMouseMode :: Bool
configMouseMode :: Bool
configAbsPath :: forall a. Maybe a
configUserKeys :: KeyConfig KeyEvent
configUser :: Maybe Text
configHost :: Maybe Text
configTeam :: Maybe Text
configUrlPath :: Maybe Text
configPass :: Maybe PasswordSource
configToken :: Maybe TokenSource
configOTPToken :: Maybe OTPTokenSource
configTimeFormat :: Maybe Text
configDateFormat :: Maybe Text
configTheme :: Maybe Text
configThemeCustomizationFile :: Maybe Text
configURLOpenCommand :: Maybe Text
configURLOpenCommandInteractive :: Bool
configActivityNotifyCommand :: Maybe Text
configAspellDictionary :: Maybe Text
configUnsafeUseHTTP :: Bool
configValidateServerCertificate :: Bool
configAbsPath :: Maybe String
configUserKeys :: KeyConfig KeyEvent
configSyntaxDirs :: [String]
configDefaultAttachmentPath :: Maybe String
.. }

defaultBindings :: [(KeyEvent, [Binding])]
defaultBindings :: [(KeyEvent, [Binding])]
defaultBindings =
    [ (KeyEvent
VtyRefreshEvent                  , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'l' ])
    , (KeyEvent
ShowHelpEvent                    , [ Int -> Binding
fn Int
1 ])
    , (KeyEvent
EnterSelectModeEvent             , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
's' ])
    , (KeyEvent
ReplyRecentEvent                 , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'r' ])
    , (KeyEvent
ToggleMessagePreviewEvent        , [ Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
'p' ])
    , (KeyEvent
InvokeEditorEvent                , [ Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
'k' ])
    , (KeyEvent
EnterFastSelectModeEvent         , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'g' ])
    , (KeyEvent
QuitEvent                        , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'q' ])
    , (KeyEvent
NextChannelEvent                 , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'n' ])
    , (KeyEvent
PrevChannelEvent                 , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'p' ])
    , (KeyEvent
NextChannelEventAlternate        , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KDown ])
    , (KeyEvent
PrevChannelEventAlternate        , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KUp ])
    , (KeyEvent
NextUnreadChannelEvent           , [ Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
'a' ])
    , (KeyEvent
ShowAttachmentListEvent          , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'x' ])
    , (KeyEvent
ChangeMessageEditorFocus         , [ Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
'o' ])
    , (KeyEvent
NextUnreadUserOrChannelEvent     , [ ])
    , (KeyEvent
LastChannelEvent                 , [ Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
's' ])
    , (KeyEvent
EnterOpenURLModeEvent            , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'o' ])
    , (KeyEvent
ClearUnreadEvent                 , [ Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
'l' ])
    , (KeyEvent
ToggleMultiLineEvent             , [ Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
'e' ])
    , (KeyEvent
EnterFlaggedPostsEvent           , [ Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
'8' ])
    , (KeyEvent
ToggleChannelListVisibleEvent    , [ Int -> Binding
fn Int
2 ])
    , (KeyEvent
ToggleExpandedChannelTopicsEvent , [ Int -> Binding
fn Int
3 ])
    , (KeyEvent
CycleChannelListSorting          , [ Int -> Binding
fn Int
4 ])
    , (KeyEvent
SelectNextTabEvent               , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'\t' ])
    , (KeyEvent
SelectPreviousTabEvent           , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KBackTab ])
    , (KeyEvent
SaveAttachmentEvent              , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
's' ])
    , (KeyEvent
LoadMoreEvent                    , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'b' ])
    , (KeyEvent
ScrollUpEvent                    , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KUp ])
    , (KeyEvent
ScrollDownEvent                  , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KDown ])
    , (KeyEvent
ScrollLeftEvent                  , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KLeft ])
    , (KeyEvent
ScrollRightEvent                 , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KRight ])
    , (KeyEvent
ChannelListScrollUpEvent         , [ Key -> Binding
forall a. ToBinding a => a -> Binding
ctrl Key
Vty.KUp ])
    , (KeyEvent
ChannelListScrollDownEvent       , [ Key -> Binding
forall a. ToBinding a => a -> Binding
ctrl Key
Vty.KDown ])
    , (KeyEvent
PageUpEvent                      , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KPageUp ])
    , (KeyEvent
PageDownEvent                    , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KPageDown ])
    , (KeyEvent
PageLeftEvent                    , [ Key -> Binding
forall a. ToBinding a => a -> Binding
shift Key
Vty.KLeft ])
    , (KeyEvent
PageRightEvent                   , [ Key -> Binding
forall a. ToBinding a => a -> Binding
shift Key
Vty.KRight ])
    , (KeyEvent
ScrollTopEvent                   , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KHome, Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
'<' ])
    , (KeyEvent
ScrollBottomEvent                , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnd, Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
'>' ])
    , (KeyEvent
SelectOldestMessageEvent         , [ Key -> Binding
forall a. ToBinding a => a -> Binding
shift Key
Vty.KHome ])
    , (KeyEvent
SelectUpEvent                    , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'k', Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KUp ])
    , (KeyEvent
SelectDownEvent                  , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'j', Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KDown ])
    , (KeyEvent
ActivateListItemEvent            , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnter ])
    , (KeyEvent
SearchSelectUpEvent              , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'p', Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KUp ])
    , (KeyEvent
SearchSelectDownEvent            , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'n', Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KDown ])
    , (KeyEvent
ViewMessageEvent                 , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'v' ])
    , (KeyEvent
FillGapEvent                     , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnter ])
    , (KeyEvent
CopyPostLinkEvent                , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'l' ])
    , (KeyEvent
FlagMessageEvent                 , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'f' ])
    , (KeyEvent
OpenThreadEvent                  , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
't' ])
    , (KeyEvent
PinMessageEvent                  , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'p' ])
    , (KeyEvent
OpenMessageInExternalEditorEvent , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'O' ])
    , (KeyEvent
YankMessageEvent                 , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'y' ])
    , (KeyEvent
YankWholeMessageEvent            , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'Y' ])
    , (KeyEvent
DeleteMessageEvent               , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'd' ])
    , (KeyEvent
EditMessageEvent                 , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'e' ])
    , (KeyEvent
ReplyMessageEvent                , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'r' ])
    , (KeyEvent
ReactToMessageEvent              , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'a' ])
    , (KeyEvent
OpenMessageURLEvent              , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'o' ])
    , (KeyEvent
AttachmentListAddEvent           , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'a' ])
    , (KeyEvent
AttachmentListDeleteEvent        , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'd' ])
    , (KeyEvent
AttachmentOpenEvent              , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'o' ])
    , (KeyEvent
CancelEvent                      , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KEsc, Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'c' ])
    , (KeyEvent
EditorBolEvent                   , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'a' ])
    , (KeyEvent
EditorEolEvent                   , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'e' ])
    , (KeyEvent
EditorTransposeCharsEvent        , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
't' ])
    , (KeyEvent
EditorDeleteCharacter            , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'd' ])
    , (KeyEvent
EditorKillToBolEvent             , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'u' ])
    , (KeyEvent
EditorKillToEolEvent             , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'k' ])
    , (KeyEvent
EditorPrevCharEvent              , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'b' ])
    , (KeyEvent
EditorNextCharEvent              , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'f' ])
    , (KeyEvent
EditorPrevWordEvent              , [ Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
'b' ])
    , (KeyEvent
EditorNextWordEvent              , [ Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
'f' ])
    , (KeyEvent
EditorDeleteNextWordEvent        , [ Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
'd' ])
    , (KeyEvent
EditorDeletePrevWordEvent        , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'w', Key -> Binding
forall a. ToBinding a => a -> Binding
meta Key
Vty.KBS ])
    , (KeyEvent
EditorHomeEvent                  , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KHome ])
    , (KeyEvent
EditorEndEvent                   , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnd ])
    , (KeyEvent
EditorYankEvent                  , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'y' ])
    , (KeyEvent
FileBrowserBeginSearchEvent      , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'/' ])
    , (KeyEvent
FileBrowserSelectEnterEvent      , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnter ])
    , (KeyEvent
FileBrowserSelectCurrentEvent    , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
' ' ])
    , (KeyEvent
FileBrowserListPageUpEvent       , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'b', Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KPageUp ])
    , (KeyEvent
FileBrowserListPageDownEvent     , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'f', Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KPageDown ])
    , (KeyEvent
FileBrowserListHalfPageUpEvent   , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'u' ])
    , (KeyEvent
FileBrowserListHalfPageDownEvent , [ Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'd' ])
    , (KeyEvent
FileBrowserListTopEvent          , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'g', Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KHome, Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
'<' ])
    , (KeyEvent
FileBrowserListBottomEvent       , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'G', Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnd, Char -> Binding
forall a. ToBinding a => a -> Binding
meta Char
'>' ])
    , (KeyEvent
FileBrowserListNextEvent         , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'j', Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'n', Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KDown ])
    , (KeyEvent
FileBrowserListPrevEvent         , [ Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'k', Char -> Binding
forall a. ToBinding a => a -> Binding
ctrl Char
'p', Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KUp ])
    , (KeyEvent
FormSubmitEvent                  , [ Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnter ])
    , (KeyEvent
NextTeamEvent                    , [ Key -> Binding
forall a. ToBinding a => a -> Binding
ctrl Key
Vty.KRight ])
    , (KeyEvent
PrevTeamEvent                    , [ Key -> Binding
forall a. ToBinding a => a -> Binding
ctrl Key
Vty.KLeft ])
    , (KeyEvent
MoveCurrentTeamLeftEvent         , [ ])
    , (KeyEvent
MoveCurrentTeamRightEvent        , [ ])
    ]

channelListWidthField :: Text -> Either String ChannelListWidth
channelListWidthField :: Text -> Either String ChannelListWidth
channelListWidthField Text
t =
    case Text -> Text
T.toLower Text
t of
        Text
"auto" -> ChannelListWidth -> Either String ChannelListWidth
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ChannelListWidth
ChannelListWidthAuto
        Text
_ -> case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
t) of
            Maybe Int
Nothing -> String -> Either String ChannelListWidth
forall a b. a -> Either a b
Left String
"Invalid value for channelListWidth"
            Just Int
w  -> ChannelListWidth -> Either String ChannelListWidth
forall a b. b -> Either a b
Right (ChannelListWidth -> Either String ChannelListWidth)
-> ChannelListWidth -> Either String ChannelListWidth
forall a b. (a -> b) -> a -> b
$ Int -> ChannelListWidth
ChannelListWidthFixed Int
w

channelListOrientationField :: Text -> Either String ChannelListOrientation
channelListOrientationField :: Text -> Either String ChannelListOrientation
channelListOrientationField Text
t =
    case Text -> Text
T.toLower Text
t of
        Text
"left" -> ChannelListOrientation -> Either String ChannelListOrientation
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ChannelListOrientation
ChannelListLeft
        Text
"right" -> ChannelListOrientation -> Either String ChannelListOrientation
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ChannelListOrientation
ChannelListRight
        Text
_ -> String -> Either String ChannelListOrientation
forall a b. a -> Either a b
Left (String -> Either String ChannelListOrientation)
-> String -> Either String ChannelListOrientation
forall a b. (a -> b) -> a -> b
$ String
"Invalid value for channelListOrientation: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t

threadOrientationField :: Text -> Either String ThreadOrientation
threadOrientationField :: Text -> Either String ThreadOrientation
threadOrientationField Text
t =
    case Text -> Text
T.toLower Text
t of
        Text
"left" -> ThreadOrientation -> Either String ThreadOrientation
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ThreadOrientation
ThreadLeft
        Text
"right" -> ThreadOrientation -> Either String ThreadOrientation
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ThreadOrientation
ThreadRight
        Text
"above" -> ThreadOrientation -> Either String ThreadOrientation
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ThreadOrientation
ThreadAbove
        Text
"below" -> ThreadOrientation -> Either String ThreadOrientation
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ThreadOrientation
ThreadBelow
        Text
_ -> String -> Either String ThreadOrientation
forall a b. a -> Either a b
Left (String -> Either String ThreadOrientation)
-> String -> Either String ThreadOrientation
forall a b. (a -> b) -> a -> b
$ String
"Invalid value for threadOrientation: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t

syntaxDirsField :: Text -> Either String [FilePath]
syntaxDirsField :: Text -> Either String [String]
syntaxDirsField = Text
-> (Text -> Either String (Item [String]))
-> Text
-> Either String [String]
forall l.
IsList l =>
Text -> (Text -> Either String (Item l)) -> Text -> Either String l
listWithSeparator Text
":" Text -> Either String String
Text -> Either String (Item [String])
forall a. IsString a => Text -> Either String a
string

validHostnameFragmentChar :: Char -> Bool
validHostnameFragmentChar :: Char -> Bool
validHostnameFragmentChar Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'

isHostnameFragment :: String -> Bool
isHostnameFragment :: String -> Bool
isHostnameFragment String
"" = Bool
False
isHostnameFragment String
s = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validHostnameFragmentChar String
s

isHostname :: String -> Bool
isHostname :: String -> Bool
isHostname String
"" = Bool
False
isHostname String
s =
    let parts :: [String]
parts = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
s
        h :: String
h = case [String]
parts of
            (String
p:[String]
_) -> String
p
            [] -> String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"BUG: isHostname: should always get at least one component: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall a. Show a => a -> String
show [String]
parts
    in (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
isHostnameFragment [String]
parts Bool -> Bool -> Bool
&& Bool -> Bool
not (String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
h)

hostField :: Text -> Either String Text
hostField :: Text -> Either String Text
hostField Text
t =
    let s :: String
s = Text -> String
T.unpack Text
t
        valid :: Bool
valid = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ String -> Bool
isIPv4address String
s
                   , String -> Bool
isIPv6address String
s
                   , String -> Bool
isHostname String
s
                   ]
    in if Bool
valid
       then Text -> Either String Text
forall a b. b -> Either a b
Right Text
t
       else String -> Either String Text
forall a b. a -> Either a b
Left String
"Invalid 'host' value, must be a hostname or IPv4/IPv6 address"

expandTilde :: FilePath -> FilePath -> FilePath
expandTilde :: String -> String -> String
expandTilde String
homeDir String
p =
    let parts :: [String]
parts = String -> [String]
splitPath String
p
        f :: String -> String
f String
part | String
part String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"~/" = String
homeDir String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/"
               | Bool
otherwise    = String
part
    in [String] -> String
joinPath ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> String
f (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
parts

backgroundField :: Text -> Either String BackgroundInfo
backgroundField :: Text -> Either String BackgroundInfo
backgroundField Text
t =
    case Text
t of
        Text
"Disabled" -> BackgroundInfo -> Either String BackgroundInfo
forall a b. b -> Either a b
Right BackgroundInfo
Disabled
        Text
"Active" -> BackgroundInfo -> Either String BackgroundInfo
forall a b. b -> Either a b
Right BackgroundInfo
Active
        Text
"ActiveCount" -> BackgroundInfo -> Either String BackgroundInfo
forall a b. b -> Either a b
Right BackgroundInfo
ActiveCount
        Text
_ -> String -> Either String BackgroundInfo
forall a b. a -> Either a b
Left (String
"Invalid value " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t
                  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"; must be one of: Disabled, Active, ActiveCount")

notifyVersion :: Text -> Either String NotificationVersion
notifyVersion :: Text -> Either String NotificationVersion
notifyVersion Text
t =
    case Text
t of
        Text
"1" -> NotificationVersion -> Either String NotificationVersion
forall a b. b -> Either a b
Right NotificationVersion
NotifyV1
        Text
"2" -> NotificationVersion -> Either String NotificationVersion
forall a b. b -> Either a b
Right NotificationVersion
NotifyV2
        Text
_ -> String -> Either String NotificationVersion
forall a b. a -> Either a b
Left (String
"Invalid value " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t
                  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"; must be one of NotifyV1, NotifyV2")

parseChannelListSorting :: Text -> Either String ChannelListSorting
parseChannelListSorting :: Text -> Either String ChannelListSorting
parseChannelListSorting Text
t =
    let validValues :: [(String, ChannelListSorting)]
validValues = [ (String
"default", ChannelListSorting
ChannelListSortDefault)
                      , (String
"unread-first", ChannelListSorting
ChannelListSortUnreadFirst)
                      ]
    in case String
-> [(String, ChannelListSorting)] -> Maybe ChannelListSorting
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
t) [(String, ChannelListSorting)]
validValues of
        Just ChannelListSorting
s -> ChannelListSorting -> Either String ChannelListSorting
forall a b. b -> Either a b
Right ChannelListSorting
s
        Maybe ChannelListSorting
Nothing ->
            String -> Either String ChannelListSorting
forall a b. a -> Either a b
Left (String
"Invalid value " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"; must be one of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((String, ChannelListSorting) -> String
forall a b. (a, b) -> a
fst ((String, ChannelListSorting) -> String)
-> [(String, ChannelListSorting)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, ChannelListSorting)]
validValues))

parseTeamListSorting :: Text -> Either String TeamListSorting
parseTeamListSorting :: Text -> Either String TeamListSorting
parseTeamListSorting Text
t =
    let validValues :: [(String, TeamListSorting)]
validValues = [ (String
"default", TeamListSorting
TeamListSortDefault)
                      , (String
"unread-first", TeamListSorting
TeamListSortUnreadFirst)
                      ]
    in case String -> [(String, TeamListSorting)] -> Maybe TeamListSorting
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
t) [(String, TeamListSorting)]
validValues of
        Just TeamListSorting
s -> TeamListSorting -> Either String TeamListSorting
forall a b. b -> Either a b
Right TeamListSorting
s
        Maybe TeamListSorting
Nothing ->
            String -> Either String TeamListSorting
forall a b. a -> Either a b
Left (String
"Invalid value " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"; must be one of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((String, TeamListSorting) -> String
forall a b. (a, b) -> a
fst ((String, TeamListSorting) -> String)
-> [(String, TeamListSorting)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, TeamListSorting)]
validValues))

cpuUsagePolicy :: Text -> Either String CPUUsagePolicy
cpuUsagePolicy :: Text -> Either String CPUUsagePolicy
cpuUsagePolicy Text
t =
    case Text -> Text
T.toLower Text
t of
        Text
"single" -> CPUUsagePolicy -> Either String CPUUsagePolicy
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return CPUUsagePolicy
SingleCPU
        Text
"multiple" -> CPUUsagePolicy -> Either String CPUUsagePolicy
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return CPUUsagePolicy
MultipleCPUs
        Text
_ -> String -> Either String CPUUsagePolicy
forall a b. a -> Either a b
Left (String -> Either String CPUUsagePolicy)
-> String -> Either String CPUUsagePolicy
forall a b. (a -> b) -> a -> b
$ String
"Invalid CPU usage policy value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t

stringField :: Text -> Either e Text
stringField :: forall e. Text -> Either e Text
stringField Text
t =
    case Text -> Bool
isQuoted Text
t of
        Bool
True -> Text -> Either e Text
forall a b. b -> Either a b
Right (Text -> Either e Text) -> Text -> Either e Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
parseQuotedString Text
t
        Bool
False -> Text -> Either e Text
forall a b. b -> Either a b
Right Text
t

filePathField :: Text -> Either e FilePath
filePathField :: forall e. Text -> Either e String
filePathField Text
t = let path :: String
path = Text -> String
T.unpack Text
t in String -> Either e String
forall a b. b -> Either a b
Right String
path

parseQuotedString :: Text -> Text
parseQuotedString :: Text -> Text
parseQuotedString Text
t =
    let body :: Text
body = Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text
Text -> Text
T.init Text
t
        unescapeQuotes :: Text -> Text
unescapeQuotes Text
s | Text -> Bool
T.null Text
s = Text
s
                         | Text
"\\\"" Text -> Text -> Bool
`T.isPrefixOf` Text
s = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
unescapeQuotes (Int -> Text -> Text
T.drop Int
2 Text
s)
                         | Bool
otherwise = (Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
T.head Text
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
unescapeQuotes (Int -> Text -> Text
T.drop Int
1 Text
s)
    in Text -> Text
unescapeQuotes Text
body

isQuoted :: Text -> Bool
isQuoted :: Text -> Bool
isQuoted Text
t =
    let quote :: Text
quote = Text
"\""
    in (Text
quote Text -> Text -> Bool
`T.isPrefixOf` Text
t) Bool -> Bool -> Bool
&&
       (Text
quote Text -> Text -> Bool
`T.isSuffixOf` Text
t)

addDefaultKeys :: Config -> Config
addDefaultKeys :: Config -> Config
addDefaultKeys Config
config =
    Config
config { configUserKeys = newKeyConfig allEvents defaultBindings mempty }

defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config -> Config
addDefaultKeys (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$
    Config { configAbsPath :: Maybe String
configAbsPath                     = Maybe String
forall a. Maybe a
Nothing
           , configUser :: Maybe Text
configUser                        = Maybe Text
forall a. Maybe a
Nothing
           , configHost :: Maybe Text
configHost                        = Maybe Text
forall a. Maybe a
Nothing
           , configTeam :: Maybe Text
configTeam                        = Maybe Text
forall a. Maybe a
Nothing
           , configPort :: Int
configPort                        = Int
defaultPort
           , configUrlPath :: Maybe Text
configUrlPath                     = Maybe Text
forall a. Maybe a
Nothing
           , configPass :: Maybe PasswordSource
configPass                        = Maybe PasswordSource
forall a. Maybe a
Nothing
           , configToken :: Maybe TokenSource
configToken                       = Maybe TokenSource
forall a. Maybe a
Nothing
           , configOTPToken :: Maybe OTPTokenSource
configOTPToken                    = Maybe OTPTokenSource
forall a. Maybe a
Nothing
           , configTimeFormat :: Maybe Text
configTimeFormat                  = Maybe Text
forall a. Maybe a
Nothing
           , configDateFormat :: Maybe Text
configDateFormat                  = Maybe Text
forall a. Maybe a
Nothing
           , configTheme :: Maybe Text
configTheme                       = Maybe Text
forall a. Maybe a
Nothing
           , configThemeCustomizationFile :: Maybe Text
configThemeCustomizationFile      = Maybe Text
forall a. Maybe a
Nothing
           , configSmartBacktick :: Bool
configSmartBacktick               = Bool
True
           , configSmartEditing :: Bool
configSmartEditing                = Bool
True
           , configURLOpenCommand :: Maybe Text
configURLOpenCommand              = Maybe Text
forall a. Maybe a
Nothing
           , configURLOpenCommandInteractive :: Bool
configURLOpenCommandInteractive   = Bool
False
           , configActivityNotifyCommand :: Maybe Text
configActivityNotifyCommand       = Maybe Text
forall a. Maybe a
Nothing
           , configActivityNotifyVersion :: NotificationVersion
configActivityNotifyVersion       = NotificationVersion
NotifyV1
           , configActivityBell :: Bool
configActivityBell                = Bool
False
           , configTruncateVerbatimBlocks :: Maybe Int
configTruncateVerbatimBlocks      = Maybe Int
forall a. Maybe a
Nothing
           , configShowMessageTimestamps :: Bool
configShowMessageTimestamps       = Bool
True
           , configShowBackground :: BackgroundInfo
configShowBackground              = BackgroundInfo
Disabled
           , configShowMessagePreview :: Bool
configShowMessagePreview          = Bool
False
           , configShowChannelList :: Bool
configShowChannelList             = Bool
True
           , configShowExpandedChannelTopics :: Bool
configShowExpandedChannelTopics   = Bool
True
           , configEnableAspell :: Bool
configEnableAspell                = Bool
False
           , configAspellDictionary :: Maybe Text
configAspellDictionary            = Maybe Text
forall a. Maybe a
Nothing
           , configUnsafeUseHTTP :: Bool
configUnsafeUseHTTP               = Bool
False
           , configValidateServerCertificate :: Bool
configValidateServerCertificate   = Bool
True
           , configChannelListWidth :: ChannelListWidth
configChannelListWidth            = Int -> ChannelListWidth
ChannelListWidthFixed Int
22
           , configLogMaxBufferSize :: Int
configLogMaxBufferSize            = Int
200
           , configShowOlderEdits :: Bool
configShowOlderEdits              = Bool
True
           , configUserKeys :: KeyConfig KeyEvent
configUserKeys                    = KeyEvents KeyEvent
-> [(KeyEvent, [Binding])]
-> [(KeyEvent, BindingState)]
-> KeyConfig KeyEvent
forall k.
Ord k =>
KeyEvents k
-> [(k, [Binding])] -> [(k, BindingState)] -> KeyConfig k
newKeyConfig KeyEvents KeyEvent
allEvents [] []
           , configShowTypingIndicator :: Bool
configShowTypingIndicator         = Bool
False
           , configSendTypingNotifications :: Bool
configSendTypingNotifications     = Bool
False
           , configHyperlinkingMode :: Bool
configHyperlinkingMode            = Bool
True
           , configShowLastOpenThread :: Bool
configShowLastOpenThread          = Bool
False
           , configSyntaxDirs :: [String]
configSyntaxDirs                  = []
           , configDirectChannelExpirationDays :: Int
configDirectChannelExpirationDays = Int
7
           , configCpuUsagePolicy :: CPUUsagePolicy
configCpuUsagePolicy              = CPUUsagePolicy
MultipleCPUs
           , configDefaultAttachmentPath :: Maybe String
configDefaultAttachmentPath       = Maybe String
forall a. Maybe a
Nothing
           , configChannelListOrientation :: ChannelListOrientation
configChannelListOrientation      = ChannelListOrientation
ChannelListLeft
           , configThreadOrientation :: ThreadOrientation
configThreadOrientation           = ThreadOrientation
ThreadBelow
           , configMouseMode :: Bool
configMouseMode                   = Bool
False
           , configChannelListSorting :: ChannelListSorting
configChannelListSorting          = ChannelListSorting
ChannelListSortDefault
           , configTeamListSorting :: TeamListSorting
configTeamListSorting             = TeamListSorting
TeamListSortDefault
           }

findConfig :: Maybe FilePath -> IO (Either String ([String], Config))
findConfig :: Maybe String -> IO (Either String ([String], Config))
findConfig Maybe String
Nothing = ExceptT String IO ([String], Config)
-> IO (Either String ([String], Config))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO ([String], Config)
 -> IO (Either String ([String], Config)))
-> ExceptT String IO ([String], Config)
-> IO (Either String ([String], Config))
forall a b. (a -> b) -> a -> b
$ do
    Maybe String
cfg <- IO (Maybe String) -> ExceptT String IO (Maybe String)
forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe String) -> ExceptT String IO (Maybe String))
-> IO (Maybe String) -> ExceptT String IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
locateConfig String
configFileName
    ([String]
warns, Config
config) <-
      case Maybe String
cfg of
        Maybe String
Nothing -> ([String], Config) -> ExceptT String IO ([String], Config)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Config
defaultConfig)
        Just String
path -> String -> ExceptT String IO ([String], Config)
getConfig String
path
    Config
config' <- Config -> ExceptT String IO Config
fixupPaths Config
config
    ([String], Config) -> ExceptT String IO ([String], Config)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
warns, Config
config')
findConfig (Just String
path) =
    ExceptT String IO ([String], Config)
-> IO (Either String ([String], Config))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO ([String], Config)
 -> IO (Either String ([String], Config)))
-> ExceptT String IO ([String], Config)
-> IO (Either String ([String], Config))
forall a b. (a -> b) -> a -> b
$ do ([String]
warns, Config
config) <- String -> ExceptT String IO ([String], Config)
getConfig String
path
                    Config
config' <- Config -> ExceptT String IO Config
fixupPaths Config
config
                    ([String], Config) -> ExceptT String IO ([String], Config)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
warns, Config
config')

-- | Fix path references in the configuration:
--
-- * Rewrite the syntax directory path list with 'fixupSyntaxDirs'
-- * Expand "~" encountered in any setting that contains a path value
fixupPaths :: Config -> ExceptT String IO Config
fixupPaths :: Config -> ExceptT String IO Config
fixupPaths Config
initial = do
    Config
new <- Config -> ExceptT String IO Config
fixupSyntaxDirs Config
initial
    String
homeDir <- IO String -> ExceptT String IO String
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getHomeDirectory
    let fixP :: String -> String
fixP = String -> String -> String
expandTilde String
homeDir
        fixPText :: Text -> Text
fixPText = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
expandTilde String
homeDir (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
    Config -> ExceptT String IO Config
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> ExceptT String IO Config)
-> Config -> ExceptT String IO Config
forall a b. (a -> b) -> a -> b
$ Config
new { configThemeCustomizationFile = fixPText <$> configThemeCustomizationFile new
                 , configSyntaxDirs             = fixP <$> configSyntaxDirs new
                 , configURLOpenCommand         = fixPText <$> configURLOpenCommand new
                 , configActivityNotifyCommand  = fixPText <$> configActivityNotifyCommand new
                 , configDefaultAttachmentPath  = fixP <$> configDefaultAttachmentPath new
                 }

-- | If the configuration has no syntax directories specified (the
-- default if the user did not provide the setting), fill in the
-- list with the defaults. Otherwise replace any bundled directory
-- placeholders in the config's syntax path list.
fixupSyntaxDirs :: Config -> ExceptT String IO Config
fixupSyntaxDirs :: Config -> ExceptT String IO Config
fixupSyntaxDirs Config
c =
    if Config -> [String]
configSyntaxDirs Config
c [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== []
    then do
        [String]
dirs <- IO [String] -> ExceptT String IO [String]
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [String]
defaultSkylightingPaths
        Config -> ExceptT String IO Config
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> ExceptT String IO Config)
-> Config -> ExceptT String IO Config
forall a b. (a -> b) -> a -> b
$ Config
c { configSyntaxDirs = dirs }
    else do
        [String]
newDirs <- [String]
-> (String -> ExceptT String IO String)
-> ExceptT String IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Config -> [String]
configSyntaxDirs Config
c) ((String -> ExceptT String IO String)
 -> ExceptT String IO [String])
-> (String -> ExceptT String IO String)
-> ExceptT String IO [String]
forall a b. (a -> b) -> a -> b
$ \String
dir ->
            if | String
dir String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
bundledSyntaxPlaceholderName -> IO String -> ExceptT String IO String
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getBundledSyntaxPath
               | String
dir String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
userSyntaxPlaceholderName    -> IO String -> ExceptT String IO String
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
xdgSyntaxDir
               | Bool
otherwise                           -> String -> ExceptT String IO String
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
dir

        Config -> ExceptT String IO Config
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> ExceptT String IO Config)
-> Config -> ExceptT String IO Config
forall a b. (a -> b) -> a -> b
$ Config
c { configSyntaxDirs = newDirs }

keybindingsSectionName :: Text
keybindingsSectionName :: Text
keybindingsSectionName = Text
"keybindings"

getConfig :: FilePath -> ExceptT String IO ([String], Config)
getConfig :: String -> ExceptT String IO ([String], Config)
getConfig String
fp = do
    String
absPath <- IO String -> ExceptT String IO String
forall a. IO a -> ExceptT String IO a
convertIOException (IO String -> ExceptT String IO String)
-> IO String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
makeAbsolute String
fp
    Text
t <- (IO Text -> ExceptT String IO Text
forall a. IO a -> ExceptT String IO a
convertIOException (IO Text -> ExceptT String IO Text)
-> IO Text -> ExceptT String IO Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile String
absPath) ExceptT String IO Text
-> (String -> ExceptT String IO Text) -> ExceptT String IO Text
forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catchE`
         (\String
e -> String -> ExceptT String IO Text
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String IO Text)
-> String -> ExceptT String IO Text
forall a b. (a -> b) -> a -> b
$ String
"Could not read " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
absPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e)

    -- HACK ALERT FIXME:
    --
    -- The config parser library we use, config-ini (as of 0.2.4.0)
    -- cannot handle configuration files without trailing newlines.
    -- Since that's not a really good reason for this function to raise
    -- an exception (and is fixable on the fly), we have the following
    -- check. This check is admittedly not a great thing to have to do,
    -- and we should definitely get rid of it when config-ini fixes this
    -- issue.
    let t' :: Text
t' = if Text
"\n" Text -> Text -> Bool
`T.isSuffixOf` Text
t then Text
t else Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"

    case Text -> IniParser Config -> Either Fatal ([Warning], Config)
forall a. Text -> IniParser a -> Either Fatal ([Warning], a)
parseIniFile Text
t' IniParser Config
fromIni of
        Left Fatal
err -> do
            String -> ExceptT String IO ([String], Config)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String IO ([String], Config))
-> String -> ExceptT String IO ([String], Config)
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
absPath String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Fatal -> String
fatalString Fatal
err
        Right ([Warning]
warns, Config
confNoKeys) -> do
            let mKeys :: Maybe [(KeyEvent, BindingState)]
mKeys = (String -> Maybe [(KeyEvent, BindingState)])
-> (Maybe [(KeyEvent, BindingState)]
    -> Maybe [(KeyEvent, BindingState)])
-> Either String (Maybe [(KeyEvent, BindingState)])
-> Maybe [(KeyEvent, BindingState)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe [(KeyEvent, BindingState)]
-> String -> Maybe [(KeyEvent, BindingState)]
forall a b. a -> b -> a
const Maybe [(KeyEvent, BindingState)]
forall a. Maybe a
Nothing) Maybe [(KeyEvent, BindingState)]
-> Maybe [(KeyEvent, BindingState)]
forall a. a -> a
id (Either String (Maybe [(KeyEvent, BindingState)])
 -> Maybe [(KeyEvent, BindingState)])
-> Either String (Maybe [(KeyEvent, BindingState)])
-> Maybe [(KeyEvent, BindingState)]
forall a b. (a -> b) -> a -> b
$ KeyEvents KeyEvent
-> Text -> Text -> Either String (Maybe [(KeyEvent, BindingState)])
forall k.
KeyEvents k
-> Text -> Text -> Either String (Maybe [(k, BindingState)])
keybindingsFromIni KeyEvents KeyEvent
allEvents Text
keybindingsSectionName Text
t'
                kc :: KeyConfig KeyEvent
kc = KeyEvents KeyEvent
-> [(KeyEvent, [Binding])]
-> [(KeyEvent, BindingState)]
-> KeyConfig KeyEvent
forall k.
Ord k =>
KeyEvents k
-> [(k, [Binding])] -> [(k, BindingState)] -> KeyConfig k
newKeyConfig KeyEvents KeyEvent
allEvents [(KeyEvent, [Binding])]
defaultBindings ([(KeyEvent, BindingState)]
-> Maybe [(KeyEvent, BindingState)] -> [(KeyEvent, BindingState)]
forall a. a -> Maybe a -> a
fromMaybe [(KeyEvent, BindingState)]
forall a. Monoid a => a
mempty Maybe [(KeyEvent, BindingState)]
mKeys)
                conf :: Config
conf = Config
confNoKeys { configUserKeys = kc }

            Maybe Text
actualPass <- case Config -> Maybe PasswordSource
configPass Config
conf of
                Just (PasswordCommand Text
cmdString) -> do
                    let (String
cmd, [String]
rest) = case Text -> String
T.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.words Text
cmdString of
                            (String
a:[String]
as) -> (String
a, [String]
as)
                            [] -> String -> (String, [String])
forall a. HasCallStack => String -> a
error (String -> (String, [String])) -> String -> (String, [String])
forall a b. (a -> b) -> a -> b
$ String
"BUG: getConfig: got empty command string"
                    String
output <- IO String -> ExceptT String IO String
forall a. IO a -> ExceptT String IO a
convertIOException (String -> [String] -> String -> IO String
readProcess String
cmd [String]
rest String
"") ExceptT String IO String
-> (String -> ExceptT String IO String) -> ExceptT String IO String
forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catchE`
                              (\String
e -> String -> ExceptT String IO String
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String IO String)
-> String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String
"Could not execute password command: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e)
                    Maybe Text -> ExceptT String IO (Maybe Text)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ExceptT String IO (Maybe Text))
-> Maybe Text -> ExceptT String IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
output)
                Just (PasswordString Text
pass) -> Maybe Text -> ExceptT String IO (Maybe Text)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ExceptT String IO (Maybe Text))
-> Maybe Text -> ExceptT String IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pass
                Maybe PasswordSource
Nothing -> Maybe Text -> ExceptT String IO (Maybe Text)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing

            Maybe Text
actualToken <- case Config -> Maybe TokenSource
configToken Config
conf of
                Just (TokenCommand Text
cmdString) -> do
                    let (String
cmd, [String]
rest) = case Text -> String
T.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.words Text
cmdString of
                            (String
a:[String]
as) -> (String
a, [String]
as)
                            [] -> String -> (String, [String])
forall a. HasCallStack => String -> a
error (String -> (String, [String])) -> String -> (String, [String])
forall a b. (a -> b) -> a -> b
$ String
"BUG: getConfig: got empty command string"
                    String
output <- IO String -> ExceptT String IO String
forall a. IO a -> ExceptT String IO a
convertIOException (String -> [String] -> String -> IO String
readProcess String
cmd [String]
rest String
"") ExceptT String IO String
-> (String -> ExceptT String IO String) -> ExceptT String IO String
forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catchE`
                              (\String
e -> String -> ExceptT String IO String
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String IO String)
-> String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String
"Could not execute token command: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e)
                    Maybe Text -> ExceptT String IO (Maybe Text)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ExceptT String IO (Maybe Text))
-> Maybe Text -> ExceptT String IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
output)
                Just (TokenString Text
_) -> String -> ExceptT String IO (Maybe Text)
forall a. HasCallStack => String -> a
error (String -> ExceptT String IO (Maybe Text))
-> String -> ExceptT String IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ String
"BUG: getConfig: token in the Config was already a TokenString"
                Maybe TokenSource
Nothing -> Maybe Text -> ExceptT String IO (Maybe Text)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing

            Maybe Text
actualOTPToken <- case Config -> Maybe OTPTokenSource
configOTPToken Config
conf of
                Just (OTPTokenCommand Text
cmdString) -> do
                    let (String
cmd, [String]
rest) = case Text -> String
T.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.words Text
cmdString of
                            (String
a:[String]
as) -> (String
a, [String]
as)
                            [] -> String -> (String, [String])
forall a. HasCallStack => String -> a
error (String -> (String, [String])) -> String -> (String, [String])
forall a b. (a -> b) -> a -> b
$ String
"BUG: getConfig: got empty command string"
                    String
output <- IO String -> ExceptT String IO String
forall a. IO a -> ExceptT String IO a
convertIOException (String -> [String] -> String -> IO String
readProcess String
cmd [String]
rest String
"") ExceptT String IO String
-> (String -> ExceptT String IO String) -> ExceptT String IO String
forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catchE`
                              (\String
e -> String -> ExceptT String IO String
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String -> ExceptT String IO String)
-> String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String
"Could not execute OTP token command: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e)
                    Maybe Text -> ExceptT String IO (Maybe Text)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ExceptT String IO (Maybe Text))
-> Maybe Text -> ExceptT String IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
output)
                Just (OTPTokenString Text
_) -> String -> ExceptT String IO (Maybe Text)
forall a. HasCallStack => String -> a
error (String -> ExceptT String IO (Maybe Text))
-> String -> ExceptT String IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ String
"BUG: getConfig: otptoken in the Config was already a OTPTokenString"
                Maybe OTPTokenSource
Nothing -> Maybe Text -> ExceptT String IO (Maybe Text)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing

            let conf' :: Config
conf' = Config
conf
                  { configPass = PasswordString <$> actualPass
                  , configToken = TokenString <$> actualToken
                  , configOTPToken = OTPTokenString <$> actualOTPToken
                  , configAbsPath = Just absPath
                  }
            ([String], Config) -> ExceptT String IO ([String], Config)
forall a. a -> ExceptT String IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Warning -> String) -> [Warning] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Warning -> String
warningString [Warning]
warns, Config
conf')

configConnectionType :: Config -> ConnectionType
configConnectionType :: Config -> ConnectionType
configConnectionType Config
config
  | Config -> Bool
configUnsafeUseHTTP Config
config = ConnectionType
ConnectHTTP
  | Bool
otherwise = Bool -> ConnectionType
ConnectHTTPS (Config -> Bool
configValidateServerCertificate Config
config)