{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}
-- | This module provides the login interface for Matterhorn.
--
-- * Overview
--
-- The interface provides a set of form fields for the user to use to
-- enter their server information and credentials. The user enters
-- this information and presses Enter, and then this module
-- attempts to connect to the server. The module's main function,
-- interactiveGetLoginSession, returns the result of that connection
-- attempt, if any.
--
-- * Details
--
-- The interactiveGetLoginSession function takes the Matterhorn
-- configuration's initial connection information as input. If the
-- configuration provided a complete set of values needed to make a
-- login attempt, this module goes ahead and immediately makes a login
-- attempt before even showing the user the login form. This case is
-- the case where the configuration provided all four values needed:
-- server host name, port, username, and password. When the interface
-- immediately makes a login attempt under these conditions, this is
-- referred to as an "initial" attempt in various docstrings below.
-- Otherwise, the user is prompted to fill out the form to enter any
-- missing values. On pressing Enter, a login attempt is made.
--
-- A status message about whether a connection is underway is shown in
-- both cases: in the case where the user has edited the credentials and
-- pressed Enter, and in the case where the original credentials
-- provided to interactiveGetLoginSession caused an initial connection
-- attempt.
--
-- The "initial" login case is special because in addition to not
-- showing the form, we want to ensure that the "connecting to..."
-- status message that is shown is shown long enough for the user to
-- see what is happening (rather than just flashing by in the case
-- of a fast server connection). For this usability reason, we have
-- a "startup timer" thread: the thread waits a specified number
-- of milliseconds (see 'startupTimerMilliseconds' below) and then
-- notifies the interface that it has timed out. If there is an initial
-- connection attempt underway that succeeds *before* the timer
-- fires, we wait until the timer fires before quitting the Login
-- application and returning control to Matterhorn. This ensures that
-- the "connecting to..." message stays on the screen long enough to not
-- be jarring, and to show the user what is happening. If the connection
-- fails before the timer fires, we just resume normal operation and
-- show the login form so the user can intervene.
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(..)
                       )


-- | Resource names for the login interface.
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
(==)

-- | The result of an authentication attempt.
data LoginAttempt =
    AttemptFailed AuthenticationException
    -- ^ The attempt failed with the corresponding error.
    | AttemptSucceeded ConnectionInfo ConnectionData Session User (Maybe Text) --team
    -- ^ The attempt succeeded.

-- | The state of the login interface: whether a login attempt is
-- currently in progress.
data LoginState =
    Idle
    -- ^ No login attempt is in progress.
    | Connecting Bool Text
    -- ^ A login attempt to the specified host is in progress. The
    -- boolean flag indicates whether this login was user initiated
    -- (False) or triggered immediately when starting the interface
    -- (True). This "initial" flag is used to determine whether the
    -- login form is shown while the connection attempt is underway.
    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)

-- | Requests that we can make to the login worker thead.
data LoginRequest =
    DoLogin Bool ConnectionInfo
    -- ^ Request a login using the specified connection information.
    -- The boolean flag is the "initial" flag value corresponding to the
    -- "Connecting" constructor flag of the "LoginState" type.

-- | The messages that the login worker thread can send to the user
-- interface event handler.
data LoginEvent =
    StartConnect Bool Text
    -- ^ A connection to the specified host has begun. The boolean
    -- value is whether this was an "initial" connection attempt (see
    -- LoginState).
    | LoginResult LoginAttempt
    -- ^ A login attempt finished with the specified result.
    | StartupTimeout
    -- ^ The startup timer thread fired.

-- | The login application state.
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

-- | The HTTP connection pool settings for the login worker thread.
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
                               }

-- | Run an IO action and convert various kinds of thrown exceptions
-- into a returned AuthenticationException.
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)

-- | The login worker thread.
loginWorker :: (ConnectionData -> ConnectionData)
            -- ^ The function used to set the logger on the
            -- ConnectionData that results from a successful login
            -- attempt.
            -> LogManager
            -- ^ The log manager used to do logging.
            -> BChan LoginRequest
            -- ^ The channel on which we'll await requests.
            -> BChan LoginEvent
            -- ^ The channel to which we'll send login attempt results.
            -> 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



-- | Searches prefixes of the given URL to determine Mattermost API URL
-- path and team name
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))

    -- the candidates list is never empty because inits never returns an
    -- empty list
    (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)

    -- This code prefers to report the error from the URL corresponding
    -- to what the user actually provided. Errors from derived URLs are
    -- lost in favor of this first error.
    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)


-- | The amount of time that the startup timer thread will wait before
-- firing.
startupTimerMilliseconds :: Int
startupTimerMilliseconds :: Int
startupTimerMilliseconds = Int
750

-- | The startup timer thread.
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

-- | The main function of this module: interactively present a login
-- interface, get the user's input, and attempt to log into the user's
-- specified mattermost server.
--
-- This always returns the final terminal state handle. If the user
-- makes no login attempt, this returns Nothing. Otherwise it returns
-- Just the result of the latest attempt.
interactiveGetLoginSession :: Vty
                           -- ^ The initial terminal state handle to use.
                           -> IO Vty
                           -- ^ An action to build a new state handle
                           -- if one is needed. (In practice this
                           -- never fires since the login app doesn't
                           -- use suspendAndResume, but we need it to
                           -- satisfy the Brick API.)
                           -> (ConnectionData -> ConnectionData)
                           -- ^ The function to set the logger on
                           -- connection handles.
                           -> LogManager
                           -- ^ The log manager used to do logging.
                           -> ConnectionInfo
                           -- ^ Initial connection info to use to
                           -- populate the login form. If the connection
                           -- info provided here is fully populated, an
                           -- initial connection attempt is made without
                           -- first getting the user to hit Enter.
                           -> 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)

-- | Is the specified ConnectionInfo sufficiently populated for us to
-- bother attempting to use it to connect?
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
        ]

-- | Make an initial login application state.
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
    -- If the startup timer fired and we have already succeeded, halt.
    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
            -- If the startup timer already fired, halt. Otherwise wait
            -- until that timer fires.
            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
    -- Ignore the keypress if we are already attempting a connection, or
    -- if have already successfully connected but are waiting on the
    -- startup timer.
    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))

-- | Validate a server URI @hostname[:port][/path]@. Result is either an error message
-- indicating why validation failed or a tuple of (hostname, port, path)
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)
                    ]
    ]

-- | Whether the login form should be displayed.
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
        -- If we're connecting, only show the form if the connection
        -- attempt is not an initial one.
        Connecting Bool
initial Text
_ -> Bool -> Bool
not Bool
initial

        -- If we're idle, we want to show the form - unless we have
        -- already connected and are waiting for the startup timer to
        -- fire.
        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

-- | The "current state" of the login process. Show a connecting status
-- message if a connection is underway, or if one is already established
-- and the startup timer has not fired.
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."
         ]