{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}
module Matterhorn.Login
( LoginAttempt(..)
, interactiveGetLoginSession
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick
import Brick.BChan
import Brick.Focus
import Brick.Forms
import Brick.Widgets.Border
import Brick.Widgets.Center
import Brick.Widgets.Edit
import Control.Concurrent ( forkIO, threadDelay )
import Control.Exception ( SomeException, catch, try )
import Data.Char (isHexDigit)
import Data.List (tails, inits)
import System.IO.Error ( catchIOError )
import qualified Data.Text as T
import Graphics.Vty hiding (mkVty)
import Lens.Micro.Platform ( (.~), Lens', makeLenses )
import qualified System.IO.Error as Err
import Network.URI ( URI(..), URIAuth(..), parseURI )
import Network.Mattermost ( ConnectionData )
import Network.Mattermost.Types.Internal ( Token(..) )
import Network.Mattermost.Types ( Session(..), User, Login(..), ConnectionPoolConfig(..)
, initConnectionData, ConnectionType(..), UserParam(..) )
import Network.Mattermost.Exceptions ( LoginFailureException(..) )
import Network.Mattermost.Endpoints ( mmGetUser, mmGetLimitedClientConfiguration, mmLogin )
import Matterhorn.Draw.RichText
import Matterhorn.Themes ( clientEmphAttr )
import Matterhorn.Types ( ConnectionInfo(..)
, ciPassword, ciUsername, ciHostname, ciUrlPath
, ciPort, ciType, AuthenticationException(..)
, LogManager, LogCategory(..), ioLogWithManager
, ciAccessToken, SemEq(..)
)
data Name =
Server
| Username
| Password
| AccessToken
deriving (Eq Name
Eq Name
-> (Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
$cp1Ord :: Eq Name
Ord, Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show)
instance SemEq Name where
semeq :: Name -> Name -> Bool
semeq = Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==)
data LoginAttempt =
AttemptFailed AuthenticationException
| AttemptSucceeded ConnectionInfo ConnectionData Session User (Maybe Text)
data LoginState =
Idle
| Connecting Bool Text
deriving (LoginState -> LoginState -> Bool
(LoginState -> LoginState -> Bool)
-> (LoginState -> LoginState -> Bool) -> Eq LoginState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoginState -> LoginState -> Bool
$c/= :: LoginState -> LoginState -> Bool
== :: LoginState -> LoginState -> Bool
$c== :: LoginState -> LoginState -> Bool
Eq)
data LoginRequest =
DoLogin Bool ConnectionInfo
data LoginEvent =
StartConnect Bool Text
| LoginResult LoginAttempt
| StartupTimeout
data State =
State { State -> Form ConnectionInfo LoginEvent Name
_loginForm :: Form ConnectionInfo LoginEvent Name
, State -> Maybe LoginAttempt
_lastAttempt :: Maybe LoginAttempt
, State -> LoginState
_currentState :: LoginState
, State -> BChan LoginRequest
_reqChan :: BChan LoginRequest
, State -> Bool
_timeoutFired :: Bool
}
makeLenses ''State
poolCfg :: ConnectionPoolConfig
poolCfg :: ConnectionPoolConfig
poolCfg = ConnectionPoolConfig :: Int -> NominalDiffTime -> Int -> ConnectionPoolConfig
ConnectionPoolConfig { cpIdleConnTimeout :: NominalDiffTime
cpIdleConnTimeout = NominalDiffTime
60
, cpStripesCount :: Int
cpStripesCount = Int
1
, cpMaxConnCount :: Int
cpMaxConnCount = Int
5
}
convertLoginExceptions :: IO a -> IO (Either AuthenticationException a)
convertLoginExceptions :: IO a -> IO (Either AuthenticationException a)
convertLoginExceptions IO a
act =
(a -> Either AuthenticationException a
forall a b. b -> Either a b
Right (a -> Either AuthenticationException a)
-> IO a -> IO (Either AuthenticationException a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
act)
IO (Either AuthenticationException a)
-> (HostNotResolved -> IO (Either AuthenticationException a))
-> IO (Either AuthenticationException a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\HostNotResolved
e -> Either AuthenticationException a
-> IO (Either AuthenticationException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AuthenticationException a
-> IO (Either AuthenticationException a))
-> Either AuthenticationException a
-> IO (Either AuthenticationException a)
forall a b. (a -> b) -> a -> b
$ AuthenticationException -> Either AuthenticationException a
forall a b. a -> Either a b
Left (AuthenticationException -> Either AuthenticationException a)
-> AuthenticationException -> Either AuthenticationException a
forall a b. (a -> b) -> a -> b
$ HostNotResolved -> AuthenticationException
ResolveError HostNotResolved
e)
IO (Either AuthenticationException a)
-> (HostCannotConnect -> IO (Either AuthenticationException a))
-> IO (Either AuthenticationException a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\HostCannotConnect
e -> Either AuthenticationException a
-> IO (Either AuthenticationException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AuthenticationException a
-> IO (Either AuthenticationException a))
-> Either AuthenticationException a
-> IO (Either AuthenticationException a)
forall a b. (a -> b) -> a -> b
$ AuthenticationException -> Either AuthenticationException a
forall a b. a -> Either a b
Left (AuthenticationException -> Either AuthenticationException a)
-> AuthenticationException -> Either AuthenticationException a
forall a b. (a -> b) -> a -> b
$ HostCannotConnect -> AuthenticationException
ConnectError HostCannotConnect
e)
IO (Either AuthenticationException a)
-> (IOError -> IO (Either AuthenticationException a))
-> IO (Either AuthenticationException a)
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` (\IOError
e -> Either AuthenticationException a
-> IO (Either AuthenticationException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AuthenticationException a
-> IO (Either AuthenticationException a))
-> Either AuthenticationException a
-> IO (Either AuthenticationException a)
forall a b. (a -> b) -> a -> b
$ AuthenticationException -> Either AuthenticationException a
forall a b. a -> Either a b
Left (AuthenticationException -> Either AuthenticationException a)
-> AuthenticationException -> Either AuthenticationException a
forall a b. (a -> b) -> a -> b
$ IOError -> AuthenticationException
AuthIOError IOError
e)
IO (Either AuthenticationException a)
-> (SomeException -> IO (Either AuthenticationException a))
-> IO (Either AuthenticationException a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\SomeException
e -> Either AuthenticationException a
-> IO (Either AuthenticationException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AuthenticationException a
-> IO (Either AuthenticationException a))
-> Either AuthenticationException a
-> IO (Either AuthenticationException a)
forall a b. (a -> b) -> a -> b
$ AuthenticationException -> Either AuthenticationException a
forall a b. a -> Either a b
Left (AuthenticationException -> Either AuthenticationException a)
-> AuthenticationException -> Either AuthenticationException a
forall a b. (a -> b) -> a -> b
$ SomeException -> AuthenticationException
OtherAuthError SomeException
e)
loginWorker :: (ConnectionData -> ConnectionData)
-> LogManager
-> BChan LoginRequest
-> BChan LoginEvent
-> IO ()
loginWorker :: (ConnectionData -> ConnectionData)
-> LogManager -> BChan LoginRequest -> BChan LoginEvent -> IO ()
loginWorker ConnectionData -> ConnectionData
setLogger LogManager
logMgr BChan LoginRequest
requestChan BChan LoginEvent
respChan = IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
LoginRequest
req <- BChan LoginRequest -> IO LoginRequest
forall a. BChan a -> IO a
readBChan BChan LoginRequest
requestChan
case LoginRequest
req of
DoLogin Bool
initial ConnectionInfo
connInfo -> do
BChan LoginEvent -> LoginEvent -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan (LoginEvent -> IO ()) -> LoginEvent -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> LoginEvent
StartConnect Bool
initial (Text -> LoginEvent) -> Text -> LoginEvent
forall a b. (a -> b) -> a -> b
$ ConnectionInfo
connInfoConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciHostname
let doLog :: Text -> IO ()
doLog = LogManager -> Maybe LogContext -> LogCategory -> Text -> IO ()
ioLogWithManager LogManager
logMgr Maybe LogContext
forall a. Maybe a
Nothing LogCategory
LogGeneral
Text -> IO ()
doLog (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Attempting authentication to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ConnectionInfo
connInfoConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciHostname
Either SomeException (ConnectionData, Maybe Text)
cdResult <- ConnectionInfo
-> IO (Either SomeException (ConnectionData, Maybe Text))
findConnectionData ConnectionInfo
connInfo
case Either SomeException (ConnectionData, Maybe Text)
cdResult of
Left SomeException
e ->
do BChan LoginEvent -> LoginEvent -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan (LoginEvent -> IO ()) -> LoginEvent -> IO ()
forall a b. (a -> b) -> a -> b
$ LoginAttempt -> LoginEvent
LoginResult (LoginAttempt -> LoginEvent) -> LoginAttempt -> LoginEvent
forall a b. (a -> b) -> a -> b
$ AuthenticationException -> LoginAttempt
AttemptFailed (AuthenticationException -> LoginAttempt)
-> AuthenticationException -> LoginAttempt
forall a b. (a -> b) -> a -> b
$ SomeException -> AuthenticationException
OtherAuthError SomeException
e
Right (ConnectionData
cd_, Maybe Text
mbTeam) -> do
let cd :: ConnectionData
cd = ConnectionData -> ConnectionData
setLogger ConnectionData
cd_
token :: Text
token = ConnectionInfo
connInfoConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciAccessToken
case Text -> Bool
T.null Text
token of
Bool
False -> do
let sess :: Session
sess = ConnectionData -> Token -> Session
Session ConnectionData
cd (Token -> Session) -> Token -> Session
forall a b. (a -> b) -> a -> b
$ String -> Token
Token (String -> Token) -> String -> Token
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
token
Either SomeException User
userResult <- IO User -> IO (Either SomeException User)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO User -> IO (Either SomeException User))
-> IO User -> IO (Either SomeException User)
forall a b. (a -> b) -> a -> b
$ UserParam -> Session -> IO User
mmGetUser UserParam
UserMe Session
sess
BChan LoginEvent -> LoginEvent -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan (LoginEvent -> IO ()) -> LoginEvent -> IO ()
forall a b. (a -> b) -> a -> b
$ case Either SomeException User
userResult of
Left (SomeException
e::SomeException) ->
LoginAttempt -> LoginEvent
LoginResult (LoginAttempt -> LoginEvent) -> LoginAttempt -> LoginEvent
forall a b. (a -> b) -> a -> b
$ AuthenticationException -> LoginAttempt
AttemptFailed (AuthenticationException -> LoginAttempt)
-> AuthenticationException -> LoginAttempt
forall a b. (a -> b) -> a -> b
$ SomeException -> AuthenticationException
OtherAuthError SomeException
e
Right User
user ->
LoginAttempt -> LoginEvent
LoginResult (LoginAttempt -> LoginEvent) -> LoginAttempt -> LoginEvent
forall a b. (a -> b) -> a -> b
$ ConnectionInfo
-> ConnectionData -> Session -> User -> Maybe Text -> LoginAttempt
AttemptSucceeded ConnectionInfo
connInfo ConnectionData
cd Session
sess User
user Maybe Text
mbTeam
Bool
True -> do
let login :: Login
login = Login :: Text -> Text -> Login
Login { username :: Text
username = ConnectionInfo
connInfoConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciUsername
, password :: Text
password = ConnectionInfo
connInfoConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciPassword
}
Either
AuthenticationException
(Either LoginFailureException (Session, User))
result <- IO (Either LoginFailureException (Session, User))
-> IO
(Either
AuthenticationException
(Either LoginFailureException (Session, User)))
forall a. IO a -> IO (Either AuthenticationException a)
convertLoginExceptions (IO (Either LoginFailureException (Session, User))
-> IO
(Either
AuthenticationException
(Either LoginFailureException (Session, User))))
-> IO (Either LoginFailureException (Session, User))
-> IO
(Either
AuthenticationException
(Either LoginFailureException (Session, User)))
forall a b. (a -> b) -> a -> b
$ ConnectionData
-> Login -> IO (Either LoginFailureException (Session, User))
mmLogin ConnectionData
cd Login
login
case Either
AuthenticationException
(Either LoginFailureException (Session, User))
result of
Left AuthenticationException
e -> do
Text -> IO ()
doLog (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Error authenticating to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ConnectionInfo
connInfoConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciHostname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ AuthenticationException -> String
forall a. Show a => a -> String
show AuthenticationException
e)
BChan LoginEvent -> LoginEvent -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan (LoginEvent -> IO ()) -> LoginEvent -> IO ()
forall a b. (a -> b) -> a -> b
$ LoginAttempt -> LoginEvent
LoginResult (LoginAttempt -> LoginEvent) -> LoginAttempt -> LoginEvent
forall a b. (a -> b) -> a -> b
$ AuthenticationException -> LoginAttempt
AttemptFailed AuthenticationException
e
Right (Left LoginFailureException
e) -> do
Text -> IO ()
doLog (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Error authenticating to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ConnectionInfo
connInfoConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciHostname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ LoginFailureException -> String
forall a. Show a => a -> String
show LoginFailureException
e)
BChan LoginEvent -> LoginEvent -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan (LoginEvent -> IO ()) -> LoginEvent -> IO ()
forall a b. (a -> b) -> a -> b
$ LoginAttempt -> LoginEvent
LoginResult (LoginAttempt -> LoginEvent) -> LoginAttempt -> LoginEvent
forall a b. (a -> b) -> a -> b
$ AuthenticationException -> LoginAttempt
AttemptFailed (AuthenticationException -> LoginAttempt)
-> AuthenticationException -> LoginAttempt
forall a b. (a -> b) -> a -> b
$ LoginFailureException -> AuthenticationException
LoginError LoginFailureException
e
Right (Right (Session
sess, User
user)) -> do
Text -> IO ()
doLog (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Authenticated successfully to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ConnectionInfo
connInfoConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciHostname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ConnectionInfo
connInfoConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciUsername
BChan LoginEvent -> LoginEvent -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan (LoginEvent -> IO ()) -> LoginEvent -> IO ()
forall a b. (a -> b) -> a -> b
$ LoginAttempt -> LoginEvent
LoginResult (LoginAttempt -> LoginEvent) -> LoginAttempt -> LoginEvent
forall a b. (a -> b) -> a -> b
$ ConnectionInfo
-> ConnectionData -> Session -> User -> Maybe Text -> LoginAttempt
AttemptSucceeded ConnectionInfo
connInfo ConnectionData
cd Session
sess User
user Maybe Text
mbTeam
findConnectionData :: ConnectionInfo -> IO (Either SomeException (ConnectionData, Maybe Text))
findConnectionData :: ConnectionInfo
-> IO (Either SomeException (ConnectionData, Maybe Text))
findConnectionData ConnectionInfo
connInfo = IO (Either SomeException (ConnectionData, Maybe Text))
startSearch
where
components :: [Text]
components = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ((Char -> Bool) -> Text -> [Text]
T.split (Char
'/'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (ConnectionInfo
connInfoConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciUrlPath))
(Text, Maybe Text)
primary:[(Text, Maybe Text)]
alternatives =
[(Text, Maybe Text)] -> [(Text, Maybe Text)]
forall a. [a] -> [a]
reverse
[ (Text -> [Text] -> Text
T.intercalate Text
"/" [Text]
l, [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
r)
| ([Text]
l,[Text]
r) <- [[Text]] -> [[Text]] -> [([Text], [Text])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Text] -> [[Text]]
forall a. [a] -> [[a]]
inits [Text]
components) ([Text] -> [[Text]]
forall a. [a] -> [[a]]
tails [Text]
components)
]
tryCandidate :: (Text, Maybe Text)
-> IO (Either SomeException (ConnectionData, Maybe Text))
tryCandidate :: (Text, Maybe Text)
-> IO (Either SomeException (ConnectionData, Maybe Text))
tryCandidate (Text
path, Maybe Text
team) =
do ConnectionData
cd <- Text
-> Int
-> Text
-> ConnectionType
-> ConnectionPoolConfig
-> IO ConnectionData
initConnectionData (ConnectionInfo
connInfoConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciHostname)
(Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConnectionInfo
connInfoConnectionInfo -> Getting Int ConnectionInfo Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int ConnectionInfo Int
Lens' ConnectionInfo Int
ciPort))
Text
path (ConnectionInfo
connInfoConnectionInfo
-> Getting ConnectionType ConnectionInfo ConnectionType
-> ConnectionType
forall s a. s -> Getting a s a -> a
^.Getting ConnectionType ConnectionInfo ConnectionType
Lens' ConnectionInfo ConnectionType
ciType) ConnectionPoolConfig
poolCfg
Either SomeException LimitedClientConfig
res <- IO LimitedClientConfig
-> IO (Either SomeException LimitedClientConfig)
forall e a. Exception e => IO a -> IO (Either e a)
try (ConnectionData -> IO LimitedClientConfig
mmGetLimitedClientConfiguration ConnectionData
cd)
Either SomeException (ConnectionData, Maybe Text)
-> IO (Either SomeException (ConnectionData, Maybe Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (ConnectionData, Maybe Text)
-> IO (Either SomeException (ConnectionData, Maybe Text)))
-> Either SomeException (ConnectionData, Maybe Text)
-> IO (Either SomeException (ConnectionData, Maybe Text))
forall a b. (a -> b) -> a -> b
$! case Either SomeException LimitedClientConfig
res of
Left SomeException
e -> SomeException -> Either SomeException (ConnectionData, Maybe Text)
forall a b. a -> Either a b
Left SomeException
e
Right{} -> (ConnectionData, Maybe Text)
-> Either SomeException (ConnectionData, Maybe Text)
forall a b. b -> Either a b
Right (ConnectionData
cd, Maybe Text
team)
startSearch :: IO (Either SomeException (ConnectionData, Maybe Text))
startSearch =
do Either SomeException (ConnectionData, Maybe Text)
res1 <- (Text, Maybe Text)
-> IO (Either SomeException (ConnectionData, Maybe Text))
tryCandidate (Text, Maybe Text)
primary
case Either SomeException (ConnectionData, Maybe Text)
res1 of
Left SomeException
e -> SomeException
-> [(Text, Maybe Text)]
-> IO (Either SomeException (ConnectionData, Maybe Text))
forall t.
t
-> [(Text, Maybe Text)]
-> IO (Either t (ConnectionData, Maybe Text))
search SomeException
e [(Text, Maybe Text)]
alternatives
Right (ConnectionData, Maybe Text)
cd -> Either SomeException (ConnectionData, Maybe Text)
-> IO (Either SomeException (ConnectionData, Maybe Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ConnectionData, Maybe Text)
-> Either SomeException (ConnectionData, Maybe Text)
forall a b. b -> Either a b
Right (ConnectionData, Maybe Text)
cd)
search :: t
-> [(Text, Maybe Text)]
-> IO (Either t (ConnectionData, Maybe Text))
search t
e [] = Either t (ConnectionData, Maybe Text)
-> IO (Either t (ConnectionData, Maybe Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Either t (ConnectionData, Maybe Text)
forall a b. a -> Either a b
Left t
e)
search t
e ((Text, Maybe Text)
x:[(Text, Maybe Text)]
xs) =
do Either SomeException (ConnectionData, Maybe Text)
res <- (Text, Maybe Text)
-> IO (Either SomeException (ConnectionData, Maybe Text))
tryCandidate (Text, Maybe Text)
x
case Either SomeException (ConnectionData, Maybe Text)
res of
Left {} -> t
-> [(Text, Maybe Text)]
-> IO (Either t (ConnectionData, Maybe Text))
search t
e [(Text, Maybe Text)]
xs
Right (ConnectionData, Maybe Text)
cd -> Either t (ConnectionData, Maybe Text)
-> IO (Either t (ConnectionData, Maybe Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ConnectionData, Maybe Text)
-> Either t (ConnectionData, Maybe Text)
forall a b. b -> Either a b
Right (ConnectionData, Maybe Text)
cd)
startupTimerMilliseconds :: Int
startupTimerMilliseconds :: Int
startupTimerMilliseconds = Int
750
startupTimer :: BChan LoginEvent -> IO ()
startupTimer :: BChan LoginEvent -> IO ()
startupTimer BChan LoginEvent
respChan = do
Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
startupTimerMilliseconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000
BChan LoginEvent -> LoginEvent -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan LoginEvent
StartupTimeout
interactiveGetLoginSession :: Vty
-> IO Vty
-> (ConnectionData -> ConnectionData)
-> LogManager
-> ConnectionInfo
-> IO (Maybe LoginAttempt, Vty)
interactiveGetLoginSession :: Vty
-> IO Vty
-> (ConnectionData -> ConnectionData)
-> LogManager
-> ConnectionInfo
-> IO (Maybe LoginAttempt, Vty)
interactiveGetLoginSession Vty
vty IO Vty
mkVty ConnectionData -> ConnectionData
setLogger LogManager
logMgr ConnectionInfo
initialConfig = do
BChan LoginRequest
requestChan <- Int -> IO (BChan LoginRequest)
forall a. Int -> IO (BChan a)
newBChan Int
10
BChan LoginEvent
respChan <- Int -> IO (BChan LoginEvent)
forall a. Int -> IO (BChan a)
newBChan Int
10
IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ (ConnectionData -> ConnectionData)
-> LogManager -> BChan LoginRequest -> BChan LoginEvent -> IO ()
loginWorker ConnectionData -> ConnectionData
setLogger LogManager
logMgr BChan LoginRequest
requestChan BChan LoginEvent
respChan
IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ BChan LoginEvent -> IO ()
startupTimer BChan LoginEvent
respChan
let initialState :: State
initialState = ConnectionInfo -> BChan LoginRequest -> State
mkState ConnectionInfo
initialConfig BChan LoginRequest
requestChan
State
startState <- case (ConnectionInfo -> Bool
populatedConnectionInfo ConnectionInfo
initialConfig) of
Bool
True -> do
BChan LoginRequest -> LoginRequest -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginRequest
requestChan (LoginRequest -> IO ()) -> LoginRequest -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> ConnectionInfo -> LoginRequest
DoLogin Bool
True ConnectionInfo
initialConfig
State -> IO State
forall (m :: * -> *) a. Monad m => a -> m a
return (State -> IO State) -> State -> IO State
forall a b. (a -> b) -> a -> b
$ State
initialState State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& (LoginState -> Identity LoginState) -> State -> Identity State
Lens' State LoginState
currentState ((LoginState -> Identity LoginState) -> State -> Identity State)
-> LoginState -> State -> State
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> Text -> LoginState
Connecting Bool
True (ConnectionInfo
initialConfigConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciHostname)
Bool
False -> do
State -> IO State
forall (m :: * -> *) a. Monad m => a -> m a
return State
initialState
(State
finalSt, Vty
finalVty) <- Vty
-> IO Vty
-> Maybe (BChan LoginEvent)
-> App State LoginEvent Name
-> State
-> IO (State, Vty)
forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO (s, Vty)
customMainWithVty Vty
vty IO Vty
mkVty (BChan LoginEvent -> Maybe (BChan LoginEvent)
forall a. a -> Maybe a
Just BChan LoginEvent
respChan) App State LoginEvent Name
app State
startState
(Maybe LoginAttempt, Vty) -> IO (Maybe LoginAttempt, Vty)
forall (m :: * -> *) a. Monad m => a -> m a
return (State
finalStState
-> Getting (Maybe LoginAttempt) State (Maybe LoginAttempt)
-> Maybe LoginAttempt
forall s a. s -> Getting a s a -> a
^.Getting (Maybe LoginAttempt) State (Maybe LoginAttempt)
Lens' State (Maybe LoginAttempt)
lastAttempt, Vty
finalVty)
populatedConnectionInfo :: ConnectionInfo -> Bool
populatedConnectionInfo :: ConnectionInfo -> Bool
populatedConnectionInfo ConnectionInfo
ci =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ ConnectionInfo
ciConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciHostname
, [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ ConnectionInfo
ciConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciUsername
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ ConnectionInfo
ciConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciPassword
]
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ ConnectionInfo
ciConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciAccessToken
]
, ConnectionInfo
ciConnectionInfo -> Getting Int ConnectionInfo Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int ConnectionInfo Int
Lens' ConnectionInfo Int
ciPort Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
]
mkState :: ConnectionInfo -> BChan LoginRequest -> State
mkState :: ConnectionInfo -> BChan LoginRequest -> State
mkState ConnectionInfo
cInfo BChan LoginRequest
chan = State
state
where
state :: State
state = State :: Form ConnectionInfo LoginEvent Name
-> Maybe LoginAttempt
-> LoginState
-> BChan LoginRequest
-> Bool
-> State
State { _loginForm :: Form ConnectionInfo LoginEvent Name
_loginForm = Form ConnectionInfo LoginEvent Name
forall e. Form ConnectionInfo e Name
form { formFocus :: FocusRing Name
formFocus = Name -> FocusRing Name -> FocusRing Name
forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent Name
initialFocus (Form ConnectionInfo Any Name -> FocusRing Name
forall s e n. Form s e n -> FocusRing n
formFocus Form ConnectionInfo Any Name
forall e. Form ConnectionInfo e Name
form)
}
, _currentState :: LoginState
_currentState = LoginState
Idle
, _lastAttempt :: Maybe LoginAttempt
_lastAttempt = Maybe LoginAttempt
forall a. Maybe a
Nothing
, _reqChan :: BChan LoginRequest
_reqChan = BChan LoginRequest
chan
, _timeoutFired :: Bool
_timeoutFired = Bool
False
}
form :: Form ConnectionInfo e Name
form = ConnectionInfo -> Form ConnectionInfo e Name
forall e. ConnectionInfo -> Form ConnectionInfo e Name
mkForm ConnectionInfo
cInfo
initialFocus :: Name
initialFocus = if | Text -> Bool
T.null (ConnectionInfo
cInfoConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciHostname) -> Name
Server
| Text -> Bool
T.null (ConnectionInfo
cInfoConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciUsername) -> Name
Username
| Text -> Bool
T.null (ConnectionInfo
cInfoConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciPassword) -> Name
Password
| Bool
otherwise -> Name
Server
app :: App State LoginEvent Name
app :: App State LoginEvent Name
app = App :: forall s e n.
(s -> [Widget n])
-> (s -> [CursorLocation n] -> Maybe (CursorLocation n))
-> (s -> BrickEvent n e -> EventM n (Next s))
-> (s -> EventM n s)
-> (s -> AttrMap)
-> App s e n
App
{ appDraw :: State -> [Widget Name]
appDraw = State -> [Widget Name]
credsDraw
, appChooseCursor :: State -> [CursorLocation Name] -> Maybe (CursorLocation Name)
appChooseCursor = State -> [CursorLocation Name] -> Maybe (CursorLocation Name)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor
, appHandleEvent :: State -> BrickEvent Name LoginEvent -> EventM Name (Next State)
appHandleEvent = State -> BrickEvent Name LoginEvent -> EventM Name (Next State)
onEvent
, appStartEvent :: State -> EventM Name State
appStartEvent = State -> EventM Name State
forall (m :: * -> *) a. Monad m => a -> m a
return
, appAttrMap :: State -> AttrMap
appAttrMap = AttrMap -> State -> AttrMap
forall a b. a -> b -> a
const AttrMap
colorTheme
}
onEvent :: State -> BrickEvent Name LoginEvent -> EventM Name (Next State)
onEvent :: State -> BrickEvent Name LoginEvent -> EventM Name (Next State)
onEvent State
st (VtyEvent (EvKey Key
KEsc [])) = do
State -> EventM Name (Next State)
forall s n. s -> EventM n (Next s)
halt (State -> EventM Name (Next State))
-> State -> EventM Name (Next State)
forall a b. (a -> b) -> a -> b
$ State
st State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& (Maybe LoginAttempt -> Identity (Maybe LoginAttempt))
-> State -> Identity State
Lens' State (Maybe LoginAttempt)
lastAttempt ((Maybe LoginAttempt -> Identity (Maybe LoginAttempt))
-> State -> Identity State)
-> Maybe LoginAttempt -> State -> State
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe LoginAttempt
forall a. Maybe a
Nothing
onEvent State
st (AppEvent (StartConnect Bool
initial Text
host)) = do
State -> EventM Name (Next State)
forall s n. s -> EventM n (Next s)
continue (State -> EventM Name (Next State))
-> State -> EventM Name (Next State)
forall a b. (a -> b) -> a -> b
$ State
st State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& (LoginState -> Identity LoginState) -> State -> Identity State
Lens' State LoginState
currentState ((LoginState -> Identity LoginState) -> State -> Identity State)
-> LoginState -> State -> State
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> Text -> LoginState
Connecting Bool
initial Text
host
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& (Maybe LoginAttempt -> Identity (Maybe LoginAttempt))
-> State -> Identity State
Lens' State (Maybe LoginAttempt)
lastAttempt ((Maybe LoginAttempt -> Identity (Maybe LoginAttempt))
-> State -> Identity State)
-> Maybe LoginAttempt -> State -> State
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe LoginAttempt
forall a. Maybe a
Nothing
onEvent State
st (AppEvent LoginEvent
StartupTimeout) = do
case State
stState
-> Getting (Maybe LoginAttempt) State (Maybe LoginAttempt)
-> Maybe LoginAttempt
forall s a. s -> Getting a s a -> a
^.Getting (Maybe LoginAttempt) State (Maybe LoginAttempt)
Lens' State (Maybe LoginAttempt)
lastAttempt of
Just (AttemptSucceeded {}) -> State -> EventM Name (Next State)
forall s n. s -> EventM n (Next s)
halt State
st
Maybe LoginAttempt
_ -> State -> EventM Name (Next State)
forall s n. s -> EventM n (Next s)
continue (State -> EventM Name (Next State))
-> State -> EventM Name (Next State)
forall a b. (a -> b) -> a -> b
$ State
st State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> State -> Identity State
Lens' State Bool
timeoutFired ((Bool -> Identity Bool) -> State -> Identity State)
-> Bool -> State -> State
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
onEvent State
st (AppEvent (LoginResult LoginAttempt
attempt)) = do
let st' :: State
st' = State
st State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& (Maybe LoginAttempt -> Identity (Maybe LoginAttempt))
-> State -> Identity State
Lens' State (Maybe LoginAttempt)
lastAttempt ((Maybe LoginAttempt -> Identity (Maybe LoginAttempt))
-> State -> Identity State)
-> Maybe LoginAttempt -> State -> State
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LoginAttempt -> Maybe LoginAttempt
forall a. a -> Maybe a
Just LoginAttempt
attempt
State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& (LoginState -> Identity LoginState) -> State -> Identity State
Lens' State LoginState
currentState ((LoginState -> Identity LoginState) -> State -> Identity State)
-> LoginState -> State -> State
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LoginState
Idle
case LoginAttempt
attempt of
AttemptSucceeded {} -> do
case State
stState -> Getting Bool State Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool State Bool
Lens' State Bool
timeoutFired of
Bool
True -> State -> EventM Name (Next State)
forall s n. s -> EventM n (Next s)
halt State
st'
Bool
False -> State -> EventM Name (Next State)
forall s n. s -> EventM n (Next s)
continue State
st'
AttemptFailed {} -> State -> EventM Name (Next State)
forall s n. s -> EventM n (Next s)
continue State
st'
onEvent State
st (VtyEvent (EvKey Key
KEnter [])) = do
case State
stState -> Getting LoginState State LoginState -> LoginState
forall s a. s -> Getting a s a -> a
^.Getting LoginState State LoginState
Lens' State LoginState
currentState of
Connecting {} -> () -> EventM Name ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
LoginState
Idle ->
case State
stState
-> Getting (Maybe LoginAttempt) State (Maybe LoginAttempt)
-> Maybe LoginAttempt
forall s a. s -> Getting a s a -> a
^.Getting (Maybe LoginAttempt) State (Maybe LoginAttempt)
Lens' State (Maybe LoginAttempt)
lastAttempt of
Just (AttemptSucceeded {}) -> () -> EventM Name ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe LoginAttempt
_ -> do
let ci :: ConnectionInfo
ci = Form ConnectionInfo LoginEvent Name -> ConnectionInfo
forall s e n. Form s e n -> s
formState (Form ConnectionInfo LoginEvent Name -> ConnectionInfo)
-> Form ConnectionInfo LoginEvent Name -> ConnectionInfo
forall a b. (a -> b) -> a -> b
$ State
stState
-> Getting
(Form ConnectionInfo LoginEvent Name)
State
(Form ConnectionInfo LoginEvent Name)
-> Form ConnectionInfo LoginEvent Name
forall s a. s -> Getting a s a -> a
^.Getting
(Form ConnectionInfo LoginEvent Name)
State
(Form ConnectionInfo LoginEvent Name)
Lens' State (Form ConnectionInfo LoginEvent Name)
loginForm
Bool -> EventM Name () -> EventM Name ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConnectionInfo -> Bool
populatedConnectionInfo ConnectionInfo
ci) (EventM Name () -> EventM Name ())
-> EventM Name () -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> EventM Name ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Name ()) -> IO () -> EventM Name ()
forall a b. (a -> b) -> a -> b
$ BChan LoginRequest -> LoginRequest -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan (State
stState
-> Getting (BChan LoginRequest) State (BChan LoginRequest)
-> BChan LoginRequest
forall s a. s -> Getting a s a -> a
^.Getting (BChan LoginRequest) State (BChan LoginRequest)
Lens' State (BChan LoginRequest)
reqChan) (LoginRequest -> IO ()) -> LoginRequest -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> ConnectionInfo -> LoginRequest
DoLogin Bool
False ConnectionInfo
ci
State -> EventM Name (Next State)
forall s n. s -> EventM n (Next s)
continue State
st
onEvent State
st BrickEvent Name LoginEvent
e = do
Form ConnectionInfo LoginEvent Name
f' <- BrickEvent Name LoginEvent
-> Form ConnectionInfo LoginEvent Name
-> EventM Name (Form ConnectionInfo LoginEvent Name)
forall n e s.
Eq n =>
BrickEvent n e -> Form s e n -> EventM n (Form s e n)
handleFormEvent BrickEvent Name LoginEvent
e (State
stState
-> Getting
(Form ConnectionInfo LoginEvent Name)
State
(Form ConnectionInfo LoginEvent Name)
-> Form ConnectionInfo LoginEvent Name
forall s a. s -> Getting a s a -> a
^.Getting
(Form ConnectionInfo LoginEvent Name)
State
(Form ConnectionInfo LoginEvent Name)
Lens' State (Form ConnectionInfo LoginEvent Name)
loginForm)
State -> EventM Name (Next State)
forall s n. s -> EventM n (Next s)
continue (State -> EventM Name (Next State))
-> State -> EventM Name (Next State)
forall a b. (a -> b) -> a -> b
$ State
st State -> (State -> State) -> State
forall a b. a -> (a -> b) -> b
& (Form ConnectionInfo LoginEvent Name
-> Identity (Form ConnectionInfo LoginEvent Name))
-> State -> Identity State
Lens' State (Form ConnectionInfo LoginEvent Name)
loginForm ((Form ConnectionInfo LoginEvent Name
-> Identity (Form ConnectionInfo LoginEvent Name))
-> State -> Identity State)
-> Form ConnectionInfo LoginEvent Name -> State -> State
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Form ConnectionInfo LoginEvent Name
f'
mkForm :: ConnectionInfo -> Form ConnectionInfo e Name
mkForm :: ConnectionInfo -> Form ConnectionInfo e Name
mkForm =
let label :: String -> Widget n -> Widget n
label String
s Widget n
w = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
(Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
22 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
s Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Char -> Widget n
forall n. Char -> Widget n
fill Char
' ') Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
w
above :: String -> Widget n -> Widget n
above String
s Widget n
w = Widget n -> Widget n
forall n. Widget n -> Widget n
hCenter (String -> Widget n
forall n. String -> Widget n
str String
s) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
w
in [ConnectionInfo -> FormFieldState ConnectionInfo e Name]
-> ConnectionInfo -> Form ConnectionInfo e Name
forall s e n. [s -> FormFieldState s e n] -> s -> Form s e n
newForm [ String -> Widget Name -> Widget Name
forall n. String -> Widget n -> Widget n
label String
"Server URL:" (Widget Name -> Widget Name)
-> (ConnectionInfo -> FormFieldState ConnectionInfo e Name)
-> ConnectionInfo
-> FormFieldState ConnectionInfo e Name
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= ConnectionInfo -> FormFieldState ConnectionInfo e Name
forall e. ConnectionInfo -> FormFieldState ConnectionInfo e Name
editServer
, (String -> Widget Name -> Widget Name
forall n. String -> Widget n -> Widget n
above String
"Provide a username and password:" (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Widget Name -> Widget Name
forall n. String -> Widget n -> Widget n
label String
"Username:") (Widget Name -> Widget Name)
-> (ConnectionInfo -> FormFieldState ConnectionInfo e Name)
-> ConnectionInfo
-> FormFieldState ConnectionInfo e Name
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' ConnectionInfo Text
-> Name
-> Maybe Int
-> ConnectionInfo
-> FormFieldState ConnectionInfo e Name
forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> Maybe Int -> s -> FormFieldState s e n
editTextField Lens' ConnectionInfo Text
ciUsername Name
Username (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
, String -> Widget Name -> Widget Name
forall n. String -> Widget n -> Widget n
label String
"Password:" (Widget Name -> Widget Name)
-> (ConnectionInfo -> FormFieldState ConnectionInfo e Name)
-> ConnectionInfo
-> FormFieldState ConnectionInfo e Name
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' ConnectionInfo Text
-> Name -> ConnectionInfo -> FormFieldState ConnectionInfo e Name
forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> s -> FormFieldState s e n
editPasswordField Lens' ConnectionInfo Text
ciPassword Name
Password
, (String -> Widget Name -> Widget Name
forall n. String -> Widget n -> Widget n
above String
"Or provide a Session or Personal Access Token:" (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Widget Name -> Widget Name
forall n. String -> Widget n -> Widget n
label String
"Access Token:") (Widget Name -> Widget Name)
-> (ConnectionInfo -> FormFieldState ConnectionInfo e Name)
-> ConnectionInfo
-> FormFieldState ConnectionInfo e Name
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' ConnectionInfo Text
-> Name -> ConnectionInfo -> FormFieldState ConnectionInfo e Name
forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> s -> FormFieldState s e n
editPasswordField Lens' ConnectionInfo Text
ciAccessToken Name
AccessToken
]
serverLens :: Lens' ConnectionInfo (Text, Int, Text, ConnectionType)
serverLens :: ((Text, Int, Text, ConnectionType)
-> f (Text, Int, Text, ConnectionType))
-> ConnectionInfo -> f ConnectionInfo
serverLens (Text, Int, Text, ConnectionType)
-> f (Text, Int, Text, ConnectionType)
f ConnectionInfo
ci = ((Text, Int, Text, ConnectionType) -> ConnectionInfo)
-> f (Text, Int, Text, ConnectionType) -> f ConnectionInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
x,Int
y,Text
z,ConnectionType
w) -> ConnectionInfo
ci { _ciHostname :: Text
_ciHostname = Text
x, _ciPort :: Int
_ciPort = Int
y, _ciUrlPath :: Text
_ciUrlPath = Text
z, _ciType :: ConnectionType
_ciType = ConnectionType
w})
((Text, Int, Text, ConnectionType)
-> f (Text, Int, Text, ConnectionType)
f (ConnectionInfo
ciConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciHostname, ConnectionInfo
ciConnectionInfo -> Getting Int ConnectionInfo Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int ConnectionInfo Int
Lens' ConnectionInfo Int
ciPort, ConnectionInfo
ciConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciUrlPath, ConnectionInfo
ciConnectionInfo
-> Getting ConnectionType ConnectionInfo ConnectionType
-> ConnectionType
forall s a. s -> Getting a s a -> a
^.Getting ConnectionType ConnectionInfo ConnectionType
Lens' ConnectionInfo ConnectionType
ciType))
validServer :: [Text] -> Either String (Text, Int, Text, ConnectionType)
validServer :: [Text] -> Either String (Text, Int, Text, ConnectionType)
validServer [Text]
ts =
do Text
t <- case [Text]
ts of
[] -> String -> Either String Text
forall a b. a -> Either a b
Left String
"No input"
[Text
t] -> Text -> Either String Text
forall a b. b -> Either a b
Right Text
t
[Text]
_ -> String -> Either String Text
forall a b. a -> Either a b
Left String
"Too many lines"
let inputWithScheme :: Text
inputWithScheme
| Text
"://" Text -> Text -> Bool
`T.isInfixOf` Text
t = Text
t
| Bool
otherwise = Text
"https://" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
URI
uri <- case String -> Maybe URI
parseURI (Text -> String
T.unpack Text
inputWithScheme) of
Maybe URI
Nothing -> String -> Either String URI
forall a b. a -> Either a b
Left String
"Unable to parse URI"
Just URI
uri -> URI -> Either String URI
forall a b. b -> Either a b
Right URI
uri
URIAuth
auth <- case URI -> Maybe URIAuth
uriAuthority URI
uri of
Maybe URIAuth
Nothing -> String -> Either String URIAuth
forall a b. a -> Either a b
Left String
"Missing authority part"
Just URIAuth
auth -> URIAuth -> Either String URIAuth
forall a b. b -> Either a b
Right URIAuth
auth
ConnectionType
ty <- case URI -> String
uriScheme URI
uri of
String
"http:" -> ConnectionType -> Either String ConnectionType
forall a b. b -> Either a b
Right ConnectionType
ConnectHTTP
String
"https:" -> ConnectionType -> Either String ConnectionType
forall a b. b -> Either a b
Right (Bool -> ConnectionType
ConnectHTTPS Bool
True)
String
"https-insecure:" -> ConnectionType -> Either String ConnectionType
forall a b. b -> Either a b
Right (Bool -> ConnectionType
ConnectHTTPS Bool
False)
String
_ -> String -> Either String ConnectionType
forall a b. a -> Either a b
Left String
"Unknown scheme"
Int
port <- case (ConnectionType
ty, URIAuth -> String
uriPort URIAuth
auth) of
(ConnectionType
ConnectHTTP , String
"") -> Int -> Either String Int
forall a b. b -> Either a b
Right Int
80
(ConnectHTTPS{}, String
"") -> Int -> Either String Int
forall a b. b -> Either a b
Right Int
443
(ConnectionType
_, Char
':':String
portStr)
| Just Int
port <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
portStr -> Int -> Either String Int
forall a b. b -> Either a b
Right Int
port
(ConnectionType, String)
_ -> String -> Either String Int
forall a b. a -> Either a b
Left String
"Invalid port"
let host :: String
host
| Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URIAuth -> String
uriRegName URIAuth
auth))
, Char
'[' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Char
forall a. [a] -> a
head (URIAuth -> String
uriRegName URIAuth
auth)
, Char
']' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Char
forall a. [a] -> a
last (URIAuth -> String
uriRegName URIAuth
auth)
= ShowS
forall a. [a] -> [a]
init (ShowS
forall a. [a] -> [a]
tail (URIAuth -> String
uriRegName URIAuth
auth))
| Bool
otherwise = URIAuth -> String
uriRegName URIAuth
auth
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URIAuth -> String
uriRegName URIAuth
auth) then String -> Either String ()
forall a b. a -> Either a b
Left String
"Missing server name" else () -> Either String ()
forall a b. b -> Either a b
Right ()
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URI -> String
uriQuery URI
uri) then () -> Either String ()
forall a b. b -> Either a b
Right () else String -> Either String ()
forall a b. a -> Either a b
Left String
"Unexpected URI query"
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URI -> String
uriFragment URI
uri) then () -> Either String ()
forall a b. b -> Either a b
Right () else String -> Either String ()
forall a b. a -> Either a b
Left String
"Unexpected URI fragment"
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URIAuth -> String
uriUserInfo URIAuth
auth) then () -> Either String ()
forall a b. b -> Either a b
Right () else String -> Either String ()
forall a b. a -> Either a b
Left String
"Unexpected credentials"
(Text, Int, Text, ConnectionType)
-> Either String (Text, Int, Text, ConnectionType)
forall a b. b -> Either a b
Right (String -> Text
T.pack String
host, Int
port, String -> Text
T.pack (URI -> String
uriPath URI
uri), ConnectionType
ty)
renderServer :: (Text, Int, Text, ConnectionType) -> Text
renderServer :: (Text, Int, Text, ConnectionType) -> Text
renderServer (Text
h,Int
p,Text
u,ConnectionType
t) = Text
scheme Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hStr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
portStr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
uStr
where
hStr :: Text
hStr
| (Char -> Bool) -> Text -> Bool
T.all (\Char
x -> Char -> Bool
isHexDigit Char
x Bool -> Bool -> Bool
|| Char
':'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
x) Text
h
, (Char -> Bool) -> Text -> Bool
T.any (Char
':'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
h = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
| Bool
otherwise = Text
h
scheme :: Text
scheme =
case ConnectionType
t of
ConnectionType
ConnectHTTP -> Text
"http://"
ConnectHTTPS Bool
True -> Text
""
ConnectHTTPS Bool
False -> Text
"https-insecure://"
uStr :: Text
uStr
| Text -> Bool
T.null Text
u = Text
u
| Bool
otherwise = Char -> Text -> Text
T.cons Char
'/' ((Char -> Bool) -> Text -> Text
T.dropWhile (Char
'/'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) Text
u)
portStr :: Text
portStr =
case ConnectionType
t of
ConnectionType
ConnectHTTP | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
80 -> Text
T.empty
ConnectHTTPS{} | Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
443 -> Text
T.empty
ConnectionType
_ -> String -> Text
T.pack (Char
':'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show Int
p)
editServer :: ConnectionInfo -> FormFieldState ConnectionInfo e Name
editServer :: ConnectionInfo -> FormFieldState ConnectionInfo e Name
editServer =
let val :: [Text] -> Maybe (Text, Int, Text, ConnectionType)
val [Text]
ts = case [Text] -> Either String (Text, Int, Text, ConnectionType)
validServer [Text]
ts of
Left{} -> Maybe (Text, Int, Text, ConnectionType)
forall a. Maybe a
Nothing
Right (Text, Int, Text, ConnectionType)
x-> (Text, Int, Text, ConnectionType)
-> Maybe (Text, Int, Text, ConnectionType)
forall a. a -> Maybe a
Just (Text, Int, Text, ConnectionType)
x
limit :: Maybe Int
limit = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
renderTxt :: [Text] -> Widget n
renderTxt [Text
""] = String -> Widget n
forall n. String -> Widget n
str String
"(Paste your Mattermost URL here)"
renderTxt [Text]
ts = Text -> Widget n
forall n. Text -> Widget n
txt ([Text] -> Text
T.unlines [Text]
ts)
in Lens' ConnectionInfo (Text, Int, Text, ConnectionType)
-> Name
-> Maybe Int
-> ((Text, Int, Text, ConnectionType) -> Text)
-> ([Text] -> Maybe (Text, Int, Text, ConnectionType))
-> ([Text] -> Widget Name)
-> (Widget Name -> Widget Name)
-> ConnectionInfo
-> FormFieldState ConnectionInfo e Name
forall n s a e.
(Ord n, Show n) =>
Lens' s a
-> n
-> Maybe Int
-> (a -> Text)
-> ([Text] -> Maybe a)
-> ([Text] -> Widget n)
-> (Widget n -> Widget n)
-> s
-> FormFieldState s e n
editField Lens' ConnectionInfo (Text, Int, Text, ConnectionType)
serverLens Name
Server Maybe Int
limit (Text, Int, Text, ConnectionType) -> Text
renderServer [Text] -> Maybe (Text, Int, Text, ConnectionType)
val [Text] -> Widget Name
forall n. [Text] -> Widget n
renderTxt Widget Name -> Widget Name
forall a. a -> a
id
errorAttr :: AttrName
errorAttr :: AttrName
errorAttr = AttrName
"errorMessage"
colorTheme :: AttrMap
colorTheme :: AttrMap
colorTheme = Attr -> [(AttrName, Attr)] -> AttrMap
attrMap Attr
defAttr
[ (AttrName
editAttr, Color
black Color -> Color -> Attr
`on` Color
white)
, (AttrName
editFocusedAttr, Color
black Color -> Color -> Attr
`on` Color
yellow)
, (AttrName
errorAttr, Color -> Attr
fg Color
red)
, (AttrName
focusedFormInputAttr, Color
black Color -> Color -> Attr
`on` Color
yellow)
, (AttrName
invalidFormInputAttr, Color
white Color -> Color -> Attr
`on` Color
red)
, (AttrName
clientEmphAttr, Color -> Attr
fg Color
white Attr -> Style -> Attr
`withStyle` Style
bold)
]
credsDraw :: State -> [Widget Name]
credsDraw :: State -> [Widget Name]
credsDraw State
st =
[ Widget Name -> Widget Name
forall n. Widget n -> Widget n
center (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [ if State -> Bool
shouldShowForm State
st then State -> Widget Name
credentialsForm State
st else Widget Name
forall n. Widget n
emptyWidget
, State -> Widget Name
currentStateDisplay State
st
, Maybe LoginAttempt -> Widget Name
lastAttemptDisplay (State
stState
-> Getting (Maybe LoginAttempt) State (Maybe LoginAttempt)
-> Maybe LoginAttempt
forall s a. s -> Getting a s a -> a
^.Getting (Maybe LoginAttempt) State (Maybe LoginAttempt)
Lens' State (Maybe LoginAttempt)
lastAttempt)
]
]
shouldShowForm :: State -> Bool
shouldShowForm :: State -> Bool
shouldShowForm State
st =
case State
stState -> Getting LoginState State LoginState -> LoginState
forall s a. s -> Getting a s a -> a
^.Getting LoginState State LoginState
Lens' State LoginState
currentState of
Connecting Bool
initial Text
_ -> Bool -> Bool
not Bool
initial
LoginState
Idle -> case State
stState
-> Getting (Maybe LoginAttempt) State (Maybe LoginAttempt)
-> Maybe LoginAttempt
forall s a. s -> Getting a s a -> a
^.Getting (Maybe LoginAttempt) State (Maybe LoginAttempt)
Lens' State (Maybe LoginAttempt)
lastAttempt of
Just (AttemptSucceeded {}) -> State
stState -> Getting Bool State Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool State Bool
Lens' State Bool
timeoutFired
Maybe LoginAttempt
_ -> Bool
True
currentStateDisplay :: State -> Widget Name
currentStateDisplay :: State -> Widget Name
currentStateDisplay State
st =
let msg :: Text -> Widget n
msg Text
host = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
forall n. Widget n -> Widget n
hCenter (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Text -> Widget n
forall n. Text -> Widget n
txt Text
"Connecting to " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (Text -> Widget n
forall n. Text -> Widget n
txt Text
host) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget n
forall n. Text -> Widget n
txt Text
"..."
in case State
stState -> Getting LoginState State LoginState -> LoginState
forall s a. s -> Getting a s a -> a
^.Getting LoginState State LoginState
Lens' State LoginState
currentState of
LoginState
Idle -> case State
stState
-> Getting (Maybe LoginAttempt) State (Maybe LoginAttempt)
-> Maybe LoginAttempt
forall s a. s -> Getting a s a -> a
^.Getting (Maybe LoginAttempt) State (Maybe LoginAttempt)
Lens' State (Maybe LoginAttempt)
lastAttempt of
Just (AttemptSucceeded ConnectionInfo
ci ConnectionData
_ Session
_ User
_ Maybe Text
_) -> Text -> Widget Name
forall n. Text -> Widget n
msg (ConnectionInfo
ciConnectionInfo -> Getting Text ConnectionInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ConnectionInfo Text
Lens' ConnectionInfo Text
ciHostname)
Maybe LoginAttempt
_ -> Widget Name
forall n. Widget n
emptyWidget
(Connecting Bool
_ Text
host) -> Text -> Widget Name
forall n. Text -> Widget n
msg Text
host
lastAttemptDisplay :: Maybe LoginAttempt -> Widget Name
lastAttemptDisplay :: Maybe LoginAttempt -> Widget Name
lastAttemptDisplay Maybe LoginAttempt
Nothing = Widget Name
forall n. Widget n
emptyWidget
lastAttemptDisplay (Just (AttemptSucceeded {})) = Widget Name
forall n. Widget n
emptyWidget
lastAttemptDisplay (Just (AttemptFailed AuthenticationException
e)) =
Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
uiWidth (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name
forall n. Widget n -> Widget n
renderError (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall a. SemEq a => Text -> Widget a
renderText (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$
Text
"Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AuthenticationException -> Text
renderAuthError AuthenticationException
e
renderAuthError :: AuthenticationException -> Text
renderAuthError :: AuthenticationException -> Text
renderAuthError (ConnectError HostCannotConnect
_) =
Text
"Could not connect to server"
renderAuthError (ResolveError HostNotResolved
_) =
Text
"Could not resolve server hostname"
renderAuthError (AuthIOError IOError
err)
| IOErrorType -> Bool
Err.isDoesNotExistErrorType (IOError -> IOErrorType
Err.ioeGetErrorType IOError
err) =
Text
"Unable to connect to the network"
| Bool
otherwise = Text
"GetAddrInfo: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (IOError -> String
Err.ioeGetErrorString IOError
err)
renderAuthError (OtherAuthError SomeException
e) =
String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
renderAuthError (LoginError (LoginFailureException String
msg)) =
String -> Text
T.pack String
msg
renderError :: Widget a -> Widget a
renderError :: Widget a -> Widget a
renderError = AttrName -> Widget a -> Widget a
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
errorAttr
uiWidth :: Int
uiWidth :: Int
uiWidth = Int
60
credentialsForm :: State -> Widget Name
credentialsForm :: State -> Widget Name
credentialsForm State
st =
Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
uiWidth (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
15 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Widget Name -> Widget Name
forall n. Widget n -> Widget n
border (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [ Text -> Widget Name
forall a. SemEq a => Text -> Widget a
renderText Text
"Please enter your Mattermost credentials to log in."
, Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Form ConnectionInfo LoginEvent Name -> Widget Name
forall n s e. Eq n => Form s e n -> Widget n
renderForm (State
stState
-> Getting
(Form ConnectionInfo LoginEvent Name)
State
(Form ConnectionInfo LoginEvent Name)
-> Form ConnectionInfo LoginEvent Name
forall s a. s -> Getting a s a -> a
^.Getting
(Form ConnectionInfo LoginEvent Name)
State
(Form ConnectionInfo LoginEvent Name)
Lens' State (Form ConnectionInfo LoginEvent Name)
loginForm)
, Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall a. SemEq a => Text -> Widget a
renderText Text
"Press Enter to log in or Esc to exit."
]