{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}
module Matterhorn.Login
( LoginSuccess(..)
, 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(..), MattermostError(..) )
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, ciOTPToken, SemEq(..)
)
data Name =
Server
| Username
| Password
| OTPToken
| AccessToken
deriving (Eq 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
Ord, Name -> Name -> Bool
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
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 = forall a. Eq a => a -> a -> Bool
(==)
data LoginAttempt =
AttemptFailed AuthenticationException
| MFATokenRequired ConnectionInfo
| AttemptSucceeded ConnectionInfo ConnectionData Session User (Maybe Text)
data LoginSuccess =
LoginSuccess ConnectionData Session User (Maybe Text)
data LoginState =
Idle
| Connecting Bool Text
deriving (LoginState -> LoginState -> Bool
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 { cpIdleConnTimeout :: NominalDiffTime
cpIdleConnTimeout = NominalDiffTime
60
, cpStripesCount :: Int
cpStripesCount = Int
1
, cpMaxConnCount :: Int
cpMaxConnCount = Int
5
}
invalidMFATokenError :: T.Text
invalidMFATokenError :: Text
invalidMFATokenError = Text
"mfa.validate_token.authenticate.app_error"
convertLoginExceptions :: IO a -> IO (Either AuthenticationException a)
convertLoginExceptions :: forall a. IO a -> IO (Either AuthenticationException a)
convertLoginExceptions IO a
act =
(forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
act)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\HostNotResolved
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ HostNotResolved -> AuthenticationException
ResolveError HostNotResolved
e)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\HostCannotConnect
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ HostCannotConnect -> AuthenticationException
ConnectError HostCannotConnect
e)
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` (\IOError
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ IOError -> AuthenticationException
AuthIOError IOError
e)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\MattermostError
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ MattermostError -> AuthenticationException
MattermostServerError MattermostError
e)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\SomeException
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left 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 = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
LoginRequest
req <- forall a. BChan a -> IO a
readBChan BChan LoginRequest
requestChan
case LoginRequest
req of
DoLogin Bool
initial ConnectionInfo
connInfo -> do
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan forall a b. (a -> b) -> a -> b
$ Bool -> Text -> LoginEvent
StartConnect Bool
initial forall a b. (a -> b) -> a -> b
$ ConnectionInfo
connInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciHostname
let doLog :: Text -> IO ()
doLog = LogManager -> Maybe LogContext -> LogCategory -> Text -> IO ()
ioLogWithManager LogManager
logMgr forall a. Maybe a
Nothing LogCategory
LogGeneral
Text -> IO ()
doLog forall a b. (a -> b) -> a -> b
$ Text
"Attempting authentication to " forall a. Semigroup a => a -> a -> a
<> ConnectionInfo
connInfoforall s a. s -> Getting a s a -> a
^.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 forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan forall a b. (a -> b) -> a -> b
$ LoginAttempt -> LoginEvent
LoginResult forall a b. (a -> b) -> a -> b
$ AuthenticationException -> LoginAttempt
AttemptFailed 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_
accessToken :: Text
accessToken = ConnectionInfo
connInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciAccessToken
case Text -> Bool
T.null Text
accessToken of
Bool
False -> do
let sess :: Session
sess = ConnectionData -> Token -> Session
Session ConnectionData
cd forall a b. (a -> b) -> a -> b
$ String -> Token
Token forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
accessToken
Either SomeException User
userResult <- forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$ UserParam -> Session -> IO User
mmGetUser UserParam
UserMe Session
sess
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan forall a b. (a -> b) -> a -> b
$ case Either SomeException User
userResult of
Left (SomeException
e::SomeException) ->
LoginAttempt -> LoginEvent
LoginResult forall a b. (a -> b) -> a -> b
$ AuthenticationException -> LoginAttempt
AttemptFailed forall a b. (a -> b) -> a -> b
$ SomeException -> AuthenticationException
OtherAuthError SomeException
e
Right User
user ->
LoginAttempt -> LoginEvent
LoginResult 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 { username :: Text
username = ConnectionInfo
connInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciUsername
, otpToken :: Maybe Text
otpToken = ConnectionInfo
connInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo (Maybe Text)
ciOTPToken
, password :: Text
password = ConnectionInfo
connInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciPassword
}
Either
AuthenticationException
(Either LoginFailureException (Session, User))
result <- forall a. IO a -> IO (Either AuthenticationException a)
convertLoginExceptions 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 (MattermostServerError (MattermostError {mattermostErrorId :: MattermostError -> Text
mattermostErrorId = Text
errorId})) | Text
errorId forall a. Eq a => a -> a -> Bool
== Text
invalidMFATokenError -> do
Text -> IO ()
doLog forall a b. (a -> b) -> a -> b
$ Text
"Authenticated successfully to " forall a. Semigroup a => a -> a -> a
<> ConnectionInfo
connInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciHostname forall a. Semigroup a => a -> a -> a
<> Text
" but MFA token is required"
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan forall a b. (a -> b) -> a -> b
$ LoginAttempt -> LoginEvent
LoginResult forall a b. (a -> b) -> a -> b
$ ConnectionInfo -> LoginAttempt
MFATokenRequired ConnectionInfo
connInfo
Left AuthenticationException
e -> do
Text -> IO ()
doLog forall a b. (a -> b) -> a -> b
$ Text
"Error authenticating to " forall a. Semigroup a => a -> a -> a
<> ConnectionInfo
connInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciHostname forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show AuthenticationException
e)
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan forall a b. (a -> b) -> a -> b
$ LoginAttempt -> LoginEvent
LoginResult forall a b. (a -> b) -> a -> b
$ AuthenticationException -> LoginAttempt
AttemptFailed AuthenticationException
e
Right (Left LoginFailureException
e) -> do
Text -> IO ()
doLog forall a b. (a -> b) -> a -> b
$ Text
"Error authenticating to " forall a. Semigroup a => a -> a -> a
<> ConnectionInfo
connInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciHostname forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show LoginFailureException
e)
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan forall a b. (a -> b) -> a -> b
$ LoginAttempt -> LoginEvent
LoginResult forall a b. (a -> b) -> a -> b
$ AuthenticationException -> LoginAttempt
AttemptFailed forall a b. (a -> b) -> a -> b
$ LoginFailureException -> AuthenticationException
LoginError LoginFailureException
e
Right (Right (Session
sess, User
user)) -> do
Text -> IO ()
doLog forall a b. (a -> b) -> a -> b
$ Text
"Authenticated successfully to " forall a. Semigroup a => a -> a -> a
<> ConnectionInfo
connInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciHostname forall a. Semigroup a => a -> a -> a
<> Text
" as " forall a. Semigroup a => a -> a -> a
<> ConnectionInfo
connInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciUsername
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan forall a b. (a -> b) -> a -> b
$ LoginAttempt -> LoginEvent
LoginResult 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 = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ((Char -> Bool) -> Text -> [Text]
T.split (Char
'/'forall a. Eq a => a -> a -> Bool
==) (ConnectionInfo
connInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciUrlPath))
((Text, Maybe Text)
primary, [(Text, Maybe Text)]
alternatives) = case [(Text, Maybe Text)]
componentList of
((Text, Maybe Text)
p:[(Text, Maybe Text)]
as) -> ((Text, Maybe Text)
p, [(Text, Maybe Text)]
as)
[(Text, Maybe Text)]
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"BUG: findConnectionData: got failed pattern match on component list: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [(Text, Maybe Text)]
componentList
componentList :: [(Text, Maybe Text)]
componentList =
forall a. [a] -> [a]
reverse
[ (Text -> [Text] -> Text
T.intercalate Text
"/" [Text]
l, forall a. [a] -> Maybe a
listToMaybe [Text]
r)
| ([Text]
l,[Text]
r) <- forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [[a]]
inits [Text]
components) (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
connInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciHostname)
(forall a b. (Integral a, Num b) => a -> b
fromIntegral (ConnectionInfo
connInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Int
ciPort))
Text
path (ConnectionInfo
connInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo ConnectionType
ciType) ConnectionPoolConfig
poolCfg
Either SomeException LimitedClientConfig
res <- forall e a. Exception e => IO a -> IO (Either e a)
try (ConnectionData -> IO LimitedClientConfig
mmGetLimitedClientConfiguration ConnectionData
cd)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! case Either SomeException LimitedClientConfig
res of
Left SomeException
e -> forall a b. a -> Either a b
Left SomeException
e
Right{} -> 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 -> forall {t}.
t
-> [(Text, Maybe Text)]
-> IO (Either t (ConnectionData, Maybe Text))
search SomeException
e [(Text, Maybe Text)]
alternatives
Right (ConnectionData, Maybe Text)
cd -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 forall a b. (a -> b) -> a -> b
$ Int
startupTimerMilliseconds forall a. Num a => a -> a -> a
* Int
1000
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginEvent
respChan LoginEvent
StartupTimeout
interactiveGetLoginSession :: Vty
-> IO Vty
-> (ConnectionData -> ConnectionData)
-> LogManager
-> ConnectionInfo
-> IO (Maybe LoginSuccess, Vty)
interactiveGetLoginSession :: Vty
-> IO Vty
-> (ConnectionData -> ConnectionData)
-> LogManager
-> ConnectionInfo
-> IO (Maybe LoginSuccess, Vty)
interactiveGetLoginSession Vty
vty IO Vty
mkVty ConnectionData -> ConnectionData
setLogger LogManager
logMgr ConnectionInfo
initialConfig = do
BChan LoginRequest
requestChan <- forall a. Int -> IO (BChan a)
newBChan Int
10
BChan LoginEvent
respChan <- forall a. Int -> IO (BChan a)
newBChan Int
10
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO 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
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO 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
forall a. BChan a -> a -> IO ()
writeBChan BChan LoginRequest
requestChan forall a b. (a -> b) -> a -> b
$ Bool -> ConnectionInfo -> LoginRequest
DoLogin Bool
True ConnectionInfo
initialConfig
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ State
initialState forall a b. a -> (a -> b) -> b
& Lens' State LoginState
currentState forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> Text -> LoginState
Connecting Bool
True (ConnectionInfo
initialConfigforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciHostname)
Bool
False -> do
forall (m :: * -> *) a. Monad m => a -> m a
return State
initialState
(State
finalSt, Vty
finalVty) <- 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 (forall a. a -> Maybe a
Just BChan LoginEvent
respChan) App State LoginEvent Name
app State
startState
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case State
finalStforall s a. s -> Getting a s a -> a
^.Lens' State (Maybe LoginAttempt)
lastAttempt of
Just (AttemptSucceeded ConnectionInfo
_ ConnectionData
cd Session
sess User
user Maybe Text
mbTeam) -> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ConnectionData -> Session -> User -> Maybe Text -> LoginSuccess
LoginSuccess ConnectionData
cd Session
sess User
user Maybe Text
mbTeam, Vty
finalVty)
Maybe LoginAttempt
_ -> (forall a. Maybe a
Nothing, Vty
finalVty)
populatedConnectionInfo :: ConnectionInfo -> Bool
populatedConnectionInfo :: ConnectionInfo -> Bool
populatedConnectionInfo ConnectionInfo
ci =
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ ConnectionInfo
ciforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciHostname
, forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ ConnectionInfo
ciforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciUsername
, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ ConnectionInfo
ciforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciPassword
]
, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ ConnectionInfo
ciforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciAccessToken
]
, ConnectionInfo
ciforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Int
ciPort 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 { _loginForm :: Form ConnectionInfo LoginEvent Name
_loginForm = forall {e}. Form ConnectionInfo e Name
form { formFocus :: FocusRing Name
formFocus = forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent Name
initialFocus (forall s e n. Form s e n -> FocusRing n
formFocus forall {e}. Form ConnectionInfo e Name
form)
}
, _currentState :: LoginState
_currentState = LoginState
Idle
, _lastAttempt :: Maybe LoginAttempt
_lastAttempt = forall a. Maybe a
Nothing
, _reqChan :: BChan LoginRequest
_reqChan = BChan LoginRequest
chan
, _timeoutFired :: Bool
_timeoutFired = Bool
False
}
form :: Form ConnectionInfo e Name
form = forall e. ConnectionInfo -> Form ConnectionInfo e Name
mkForm ConnectionInfo
cInfo
initialFocus :: Name
initialFocus = if | Text -> Bool
T.null (ConnectionInfo
cInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciHostname) -> Name
Server
| Text -> Bool
T.null (ConnectionInfo
cInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciUsername) -> Name
Username
| Text -> Bool
T.null (ConnectionInfo
cInfoforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciPassword) -> Name
Password
| Bool
otherwise -> Name
Server
app :: App State LoginEvent Name
app :: App State LoginEvent Name
app = App
{ appDraw :: State -> [Widget Name]
appDraw = State -> [Widget Name]
credsDraw
, appChooseCursor :: State -> [CursorLocation Name] -> Maybe (CursorLocation Name)
appChooseCursor = forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor
, appHandleEvent :: BrickEvent Name LoginEvent -> EventM Name State ()
appHandleEvent = BrickEvent Name LoginEvent -> EventM Name State ()
onEvent
, appStartEvent :: EventM Name State ()
appStartEvent = forall (m :: * -> *) a. Monad m => a -> m a
return ()
, appAttrMap :: State -> AttrMap
appAttrMap = forall a b. a -> b -> a
const AttrMap
colorTheme
}
onEvent :: BrickEvent Name LoginEvent -> EventM Name State ()
onEvent :: BrickEvent Name LoginEvent -> EventM Name State ()
onEvent (VtyEvent (EvKey Key
KEsc [])) = do
Lens' State (Maybe LoginAttempt)
lastAttempt forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
forall n s. EventM n s ()
halt
onEvent (AppEvent (StartConnect Bool
initial Text
host)) = do
Lens' State LoginState
currentState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool -> Text -> LoginState
Connecting Bool
initial Text
host
Lens' State (Maybe LoginAttempt)
lastAttempt forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
onEvent (AppEvent LoginEvent
StartupTimeout) = do
Maybe LoginAttempt
a <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' State (Maybe LoginAttempt)
lastAttempt
case Maybe LoginAttempt
a of
Just (AttemptSucceeded {}) -> forall n s. EventM n s ()
halt
Maybe LoginAttempt
_ -> Lens' State Bool
timeoutFired forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
onEvent (AppEvent (LoginResult LoginAttempt
attempt)) = do
Lens' State (Maybe LoginAttempt)
lastAttempt forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just LoginAttempt
attempt
Lens' State LoginState
currentState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= LoginState
Idle
case LoginAttempt
attempt of
AttemptSucceeded {} -> do
Bool
fired <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' State Bool
timeoutFired
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
fired forall n s. EventM n s ()
halt
AttemptFailed {} -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
MFATokenRequired ConnectionInfo
connInfo ->
Lens' State (Form ConnectionInfo LoginEvent Name)
loginForm forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (forall e. ConnectionInfo -> Form ConnectionInfo e Name
mkOTPForm ConnectionInfo
connInfo)
onEvent (VtyEvent (EvKey Key
KEnter [])) = do
LoginState
s <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' State LoginState
currentState
case LoginState
s of
Connecting {} -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
LoginState
Idle -> do
Maybe LoginAttempt
a <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' State (Maybe LoginAttempt)
lastAttempt
case Maybe LoginAttempt
a of
Just (AttemptSucceeded {}) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe LoginAttempt
_ -> do
ConnectionInfo
ci <- forall s e n. Form s e n -> s
formState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' State (Form ConnectionInfo LoginEvent Name)
loginForm
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ConnectionInfo -> Bool
populatedConnectionInfo ConnectionInfo
ci) forall a b. (a -> b) -> a -> b
$ do
BChan LoginRequest
chan <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' State (BChan LoginRequest)
reqChan
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. BChan a -> a -> IO ()
writeBChan BChan LoginRequest
chan forall a b. (a -> b) -> a -> b
$ Bool -> ConnectionInfo -> LoginRequest
DoLogin Bool
False ConnectionInfo
ci
onEvent BrickEvent Name LoginEvent
e = do
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' State (Form ConnectionInfo LoginEvent Name)
loginForm (forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent BrickEvent Name LoginEvent
e)
mkForm :: ConnectionInfo -> Form ConnectionInfo e Name
mkForm :: forall e. ConnectionInfo -> Form ConnectionInfo e Name
mkForm =
let label :: String -> Widget n -> Widget n
label String
s Widget n
w = forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$
(forall n. Int -> Widget n -> Widget n
vLimit Int
1 forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit Int
22 forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
s forall n. Widget n -> Widget n -> Widget n
<+> forall n. Char -> Widget n
fill Char
' ') forall n. Widget n -> Widget n -> Widget n
<+> Widget n
w
above :: String -> Widget n -> Widget n
above String
s Widget n
w = forall n. Widget n -> Widget n
hCenter (forall n. String -> Widget n
str String
s) forall n. Widget n -> Widget n -> Widget n
<=> Widget n
w
in forall s e n. [s -> FormFieldState s e n] -> s -> Form s e n
newForm [ forall {n}. String -> Widget n -> Widget n
label String
"Server URL:" forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= forall e. ConnectionInfo -> FormFieldState ConnectionInfo e Name
editServer
, (forall {n}. String -> Widget n -> Widget n
above String
"Provide a username and password:" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {n}. String -> Widget n -> Widget n
label String
"Username:") forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= 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 (forall a. a -> Maybe a
Just Int
1)
, forall {n}. String -> Widget n -> Widget n
label String
"Password:" forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> s -> FormFieldState s e n
editPasswordField Lens' ConnectionInfo Text
ciPassword Name
Password
, (forall {n}. String -> Widget n -> Widget n
above String
"Or provide a Session or Personal Access Token:" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {n}. String -> Widget n -> Widget n
label String
"Access Token:") forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> s -> FormFieldState s e n
editPasswordField Lens' ConnectionInfo Text
ciAccessToken Name
AccessToken
]
mkOTPForm :: ConnectionInfo -> Form ConnectionInfo e Name
mkOTPForm :: forall e. ConnectionInfo -> Form ConnectionInfo e Name
mkOTPForm =
let label :: String -> Widget n -> Widget n
label String
s Widget n
w = forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$
(forall n. Int -> Widget n -> Widget n
vLimit Int
1 forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit Int
10 forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
s forall n. Widget n -> Widget n -> Widget n
<+> forall n. Char -> Widget n
fill Char
' ') forall n. Widget n -> Widget n -> Widget n
<+> Widget n
w
in forall s e n. [s -> FormFieldState s e n] -> s -> Form s e n
newForm [forall {n}. String -> Widget n -> Widget n
label String
"OTP Token:" forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= forall n s e.
(Show n, Ord n) =>
Lens' s (Maybe Text) -> n -> s -> FormFieldState s e n
editOptionalTextField Lens' ConnectionInfo (Maybe Text)
ciOTPToken Name
OTPToken]
serverLens :: Lens' ConnectionInfo (Text, Int, Text, ConnectionType)
serverLens :: Lens' ConnectionInfo (Text, Int, Text, ConnectionType)
serverLens (Text, Int, Text, ConnectionType)
-> f (Text, Int, Text, ConnectionType)
f ConnectionInfo
ci = 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
ciforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciHostname, ConnectionInfo
ciforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Int
ciPort, ConnectionInfo
ciforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciUrlPath, ConnectionInfo
ciforall s a. s -> Getting a s a -> a
^.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
[] -> forall a b. a -> Either a b
Left String
"No input"
[Text
t] -> forall a b. b -> Either a b
Right Text
t
[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://" 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 -> forall a b. a -> Either a b
Left String
"Unable to parse URI"
Just URI
uri -> forall a b. b -> Either a b
Right URI
uri
URIAuth
auth <- case URI -> Maybe URIAuth
uriAuthority URI
uri of
Maybe URIAuth
Nothing -> forall a b. a -> Either a b
Left String
"Missing authority part"
Just URIAuth
auth -> forall a b. b -> Either a b
Right URIAuth
auth
ConnectionType
ty <- case URI -> String
uriScheme URI
uri of
String
"http:" -> forall a b. b -> Either a b
Right ConnectionType
ConnectHTTP
String
"https:" -> forall a b. b -> Either a b
Right (Bool -> ConnectionType
ConnectHTTPS Bool
True)
String
"https-insecure:" -> forall a b. b -> Either a b
Right (Bool -> ConnectionType
ConnectHTTPS Bool
False)
String
_ -> 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
"") -> forall a b. b -> Either a b
Right Int
80
(ConnectHTTPS{}, String
"") -> forall a b. b -> Either a b
Right Int
443
(ConnectionType
_, Char
':':String
portStr)
| Just Int
port <- forall a. Read a => String -> Maybe a
readMaybe String
portStr -> forall a b. b -> Either a b
Right Int
port
(ConnectionType, String)
_ -> forall a b. a -> Either a b
Left String
"Invalid port"
let host :: String
host
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URIAuth -> String
uriRegName URIAuth
auth))
, Char
'[' forall a. Eq a => a -> a -> Bool
== forall a. [a] -> a
head (URIAuth -> String
uriRegName URIAuth
auth)
, Char
']' forall a. Eq a => a -> a -> Bool
== forall a. [a] -> a
last (URIAuth -> String
uriRegName URIAuth
auth)
= forall a. [a] -> [a]
init (forall a. [a] -> [a]
tail (URIAuth -> String
uriRegName URIAuth
auth))
| Bool
otherwise = URIAuth -> String
uriRegName URIAuth
auth
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URIAuth -> String
uriRegName URIAuth
auth) then forall a b. a -> Either a b
Left String
"Missing server name" else forall a b. b -> Either a b
Right ()
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URI -> String
uriQuery URI
uri) then forall a b. b -> Either a b
Right () else forall a b. a -> Either a b
Left String
"Unexpected URI query"
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URI -> String
uriFragment URI
uri) then forall a b. b -> Either a b
Right () else forall a b. a -> Either a b
Left String
"Unexpected URI fragment"
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URIAuth -> String
uriUserInfo URIAuth
auth) then forall a b. b -> Either a b
Right () else forall a b. a -> Either a b
Left String
"Unexpected credentials"
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 forall a. Semigroup a => a -> a -> a
<> Text
hStr forall a. Semigroup a => a -> a -> a
<> Text
portStr 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
':'forall a. Eq a => a -> a -> Bool
==Char
x) Text
h
, (Char -> Bool) -> Text -> Bool
T.any (Char
':'forall a. Eq a => a -> a -> Bool
==) Text
h = Text
"[" forall a. Semigroup a => a -> a -> a
<> Text
h 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
'/'forall a. Eq a => a -> a -> Bool
==) Text
u)
portStr :: Text
portStr =
case ConnectionType
t of
ConnectionType
ConnectHTTP | Int
p forall a. Eq a => a -> a -> Bool
== Int
80 -> Text
T.empty
ConnectHTTPS{} | Int
p forall a. Eq a => a -> a -> Bool
== Int
443 -> Text
T.empty
ConnectionType
_ -> String -> Text
T.pack (Char
':'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Int
p)
editServer :: ConnectionInfo -> FormFieldState ConnectionInfo e Name
editServer :: forall e. 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{} -> forall a. Maybe a
Nothing
Right (Text, Int, Text, ConnectionType)
x-> forall a. a -> Maybe a
Just (Text, Int, Text, ConnectionType)
x
limit :: Maybe Int
limit = forall a. a -> Maybe a
Just Int
1
renderTxt :: [Text] -> Widget n
renderTxt [Text
""] = forall n. String -> Widget n
str String
"(Paste your Mattermost URL here)"
renderTxt [Text]
ts = forall n. Text -> Widget n
txt ([Text] -> Text
T.unlines [Text]
ts)
in 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 forall {n}. [Text] -> Widget n
renderTxt forall a. a -> a
id
editOptionalTextField :: (Show n, Ord n) => Lens' s (Maybe T.Text) -> n -> s -> FormFieldState s e n
editOptionalTextField :: forall n s e.
(Show n, Ord n) =>
Lens' s (Maybe Text) -> n -> s -> FormFieldState s e n
editOptionalTextField Lens' s (Maybe Text)
stLens n
n =
let ini :: Maybe a -> a
ini Maybe a
Nothing = a
""
ini (Just a
t) = a
t
val :: [Text] -> Maybe (Maybe Text)
val [Text]
ls =
let stripped :: Text
stripped = Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
ls
in if Text -> Bool
T.null Text
stripped
then forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
stripped
renderTxt :: [Text] -> Widget n
renderTxt [Text]
ts = forall n. Text -> Widget n
txt ([Text] -> Text
T.unlines [Text]
ts)
in 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' s (Maybe Text)
stLens n
n (forall a. a -> Maybe a
Just Int
1) forall {a}. IsString a => Maybe a -> a
ini [Text] -> Maybe (Maybe Text)
val forall {n}. [Text] -> Widget n
renderTxt forall a. a -> a
id
errorAttr :: AttrName
errorAttr :: AttrName
errorAttr = String -> AttrName
attrName String
"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 =
[ forall n. Widget n -> Widget n
center forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox [ if State -> Bool
shouldShowForm State
st then State -> Widget Name
credentialsForm State
st else forall n. Widget n
emptyWidget
, State -> Widget Name
currentStateDisplay State
st
, Maybe LoginAttempt -> Widget Name
lastAttemptDisplay (State
stforall s a. s -> Getting a s a -> a
^.Lens' State (Maybe LoginAttempt)
lastAttempt)
]
]
shouldShowForm :: State -> Bool
shouldShowForm :: State -> Bool
shouldShowForm State
st =
case State
stforall s a. s -> Getting a s a -> a
^.Lens' State LoginState
currentState of
Connecting Bool
initial Text
_ -> Bool -> Bool
not Bool
initial
LoginState
Idle -> case State
stforall s a. s -> Getting a s a -> a
^.Lens' State (Maybe LoginAttempt)
lastAttempt of
Just (AttemptSucceeded {}) -> State
stforall s a. s -> Getting a s a -> a
^.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 = forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$
forall n. Text -> Widget n
txt Text
"Connecting to " forall n. Widget n -> Widget n -> Widget n
<+> forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (forall n. Text -> Widget n
txt Text
host) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
"..."
in case State
stforall s a. s -> Getting a s a -> a
^.Lens' State LoginState
currentState of
LoginState
Idle -> case State
stforall s a. s -> Getting a s a -> a
^.Lens' State (Maybe LoginAttempt)
lastAttempt of
Just (AttemptSucceeded ConnectionInfo
ci ConnectionData
_ Session
_ User
_ Maybe Text
_) -> forall n. Text -> Widget n
msg (ConnectionInfo
ciforall s a. s -> Getting a s a -> a
^.Lens' ConnectionInfo Text
ciHostname)
Maybe LoginAttempt
_ -> forall n. Widget n
emptyWidget
(Connecting Bool
_ Text
host) -> forall n. Text -> Widget n
msg Text
host
lastAttemptDisplay :: Maybe LoginAttempt -> Widget Name
lastAttemptDisplay :: Maybe LoginAttempt -> Widget Name
lastAttemptDisplay Maybe LoginAttempt
Nothing = forall n. Widget n
emptyWidget
lastAttemptDisplay (Just (AttemptSucceeded {})) = forall n. Widget n
emptyWidget
lastAttemptDisplay (Just (MFATokenRequired ConnectionInfo
_)) = forall n. Widget n
emptyWidget
lastAttemptDisplay (Just (AttemptFailed AuthenticationException
e)) =
forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit Int
uiWidth forall a b. (a -> b) -> a -> b
$
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
renderError forall a b. (a -> b) -> a -> b
$ forall a. SemEq a => Text -> Widget a
renderText forall a b. (a -> b) -> a -> b
$
Text
"Error: " 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 (MattermostServerError MattermostError
e) =
MattermostError -> Text
mattermostErrorMessage MattermostError
e
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: " 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 forall a b. (a -> b) -> a -> b
$ 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 :: forall n. Widget n -> Widget n
renderError = 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 =
forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit Int
uiWidth forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit Int
15 forall a b. (a -> b) -> a -> b
$
forall n. Widget n -> Widget n
border forall a b. (a -> b) -> a -> b
$
forall n. [Widget n] -> Widget n
vBox [ forall a. SemEq a => Text -> Widget a
renderText Text
"Please enter your Mattermost credentials to log in."
, forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ forall n s e. Eq n => Form s e n -> Widget n
renderForm (State
stforall s a. s -> Getting a s a -> a
^.Lens' State (Form ConnectionInfo LoginEvent Name)
loginForm)
, forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall a. SemEq a => Text -> Widget a
renderText Text
"Press Enter to log in or Esc to exit."
]