matterhorn-30802.1.0: src/Login.hs

{-# LANGUAGE MultiWayIf #-}
module Login
  ( interactiveGatherCredentials
  ) where

import Prelude ()
import Prelude.Compat

import Brick
import Brick.Widgets.Edit
import Brick.Widgets.Center
import Brick.Widgets.Border
import Control.Monad.IO.Class (liftIO)
import Data.Maybe (isNothing)
import Text.Read (readMaybe)
import qualified Data.Text as T
import Graphics.Vty hiding (Config)
import System.Exit (exitSuccess)

import Network.Mattermost.Exceptions (LoginFailureException(..))

import Config
import Markdown
import Types (ConnectionInfo(..), AuthenticationException(..))

data Name = Hostname | Port | Username | Password deriving (Ord, Eq, Show)

data State =
    State { hostnameEdit :: Editor T.Text Name
          , portEdit     :: Editor T.Text Name
          , usernameEdit :: Editor T.Text Name
          , passwordEdit :: Editor T.Text Name
          , focus    :: Name
          , previousError :: Maybe AuthenticationException
          }

toPassword :: [T.Text] -> Widget a
toPassword s = txt $ T.replicate (T.length $ T.concat s) "*"

interactiveGatherCredentials :: Config
                             -> Maybe AuthenticationException
                             -> IO ConnectionInfo
interactiveGatherCredentials config authError = do
    let state = State { hostnameEdit = editor Hostname (txt . T.concat) (Just 1) hStr
                      , portEdit = editor Port (txt . T.concat) (Just 1) (T.pack $ show $ configPort config)
                      , usernameEdit = editor Username (txt . T.concat) (Just 1) uStr
                      , passwordEdit = editor Password toPassword     (Just 1) pStr
                      , focus = initialFocus
                      , previousError = authError
                      }
        hStr = maybe "" id $ configHost config
        uStr = maybe "" id $ configUser config
        pStr = case configPass config of
            Just (PasswordString s) -> s
            _                       -> ""
        initialFocus = if | T.null hStr -> Hostname
                          | T.null uStr -> Username
                          | T.null pStr -> Password
                          | otherwise   -> Hostname
    finalSt <- defaultMain app state
    let finalH = T.concat $ getEditContents $ hostnameEdit finalSt
        finalPort = read $ T.unpack $ T.concat $ getEditContents $ portEdit finalSt
        finalU = T.concat $ getEditContents $ usernameEdit finalSt
        finalPass = T.concat $ getEditContents $ passwordEdit finalSt
    return $ ConnectionInfo finalH finalPort finalU finalPass

app :: App State e Name
app = App
  { appDraw         = credsDraw
  , appChooseCursor = showFirstCursor
  , appHandleEvent  = onEvent
  , appStartEvent   = return
  , appAttrMap      = const colorTheme
  }

errorAttr :: AttrName
errorAttr = "errorMessage"

colorTheme :: AttrMap
colorTheme = attrMap defAttr
  [ (editAttr, black `on` white)
  , (editFocusedAttr, black `on` yellow)
  , (errorAttr, fg red)
  ]

credsDraw :: State -> [Widget Name]
credsDraw st =
    [ center (credentialsForm st <=> errorMessageDisplay st)
    ]

errorMessageDisplay :: State -> Widget Name
errorMessageDisplay st = do
    case previousError st of
        Nothing -> emptyWidget
        -- XXX
        Just e -> txt " " <=>
                  (withDefAttr errorAttr $
                   hCenter (str "Error: " <+> renderAuthError e))

renderAuthError :: AuthenticationException -> Widget Name
renderAuthError (ConnectError _) = txt "Could not connect to server"
renderAuthError (ResolveError _) = txt "Could not resolve server hostname"
renderAuthError (OtherAuthError e) = str $ show e
renderAuthError (LoginError (LoginFailureException msg)) = str msg

credentialsForm :: State -> Widget Name
credentialsForm st =
    hCenter $ hLimit 50 $ vLimit 15 $
    border $
    vBox [ renderText "Please enter your MatterMost credentials to log in."
         , txt " "
         , txt "Hostname:" <+> renderEditor (focus st == Hostname) (hostnameEdit st)
         , txt " "
         , txt "Port:    " <+> renderEditor (focus st == Port) (portEdit st)
         , txt " "
         , txt "Username:" <+> renderEditor (focus st == Username) (usernameEdit st)
         , txt " "
         , txt "Password:" <+> renderEditor (focus st == Password) (passwordEdit st)
         , txt " "
         , renderText "Press Enter to log in or Esc to exit."
         ]

onEvent :: State -> BrickEvent Name e -> EventM Name (Next State)
onEvent _  (VtyEvent (EvKey KEsc [])) = liftIO exitSuccess
onEvent st (VtyEvent (EvKey (KChar '\t') [])) =
    continue $ st { focus = if | focus st == Hostname -> Port
                               | focus st == Port     -> Username
                               | focus st == Username -> Password
                               | focus st == Password -> Hostname
                  }
onEvent st (VtyEvent (EvKey KEnter [])) =
    -- check for valid (non-empty) contents
    let h = T.concat $ getEditContents $ hostnameEdit st
        u = T.concat $ getEditContents $ usernameEdit st
        p = T.concat $ getEditContents $ passwordEdit st
        port :: Maybe Int
        port = readMaybe (T.unpack $ T.concat $ getEditContents $ portEdit st)
    in case T.null h || T.null u || T.null p || isNothing port of
        True -> continue st
        False -> halt st
onEvent st (VtyEvent e) =
    case focus st of
        Hostname -> do
            e' <- handleEditorEvent e (hostnameEdit st)
            continue $ st { hostnameEdit = e' }
        Port -> do
            e' <- handleEditorEvent e (portEdit st)
            continue $ st { portEdit = e' }
        Username -> do
            e' <- handleEditorEvent e (usernameEdit st)
            continue $ st { usernameEdit = e' }
        Password -> do
            e' <- handleEditorEvent e (passwordEdit st)
            continue $ st { passwordEdit = e' }
onEvent st _ = continue st