AskPassword.hs

{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
--
-- Module      :  VCSGui.Svn.AskPassword
-- Copyright   :  2011 Stephan Fortelny, Harald Jagenteufel
-- License     :  GPL
--
-- Maintainer  :  stephanfortelny at gmail.com, h.jagenteufel at gmail.com
-- Stability   :
-- Portability :
-- TODO this should be moved into Common Package
-- | Provides a GUI asking a user for a password.
--
-----------------------------------------------------------------------------

module VCSGui.Svn.AskPassword (
    showAskpassGUI
    ,Handler
) where

import qualified VCSGui.Common.GtkHelper as H
import qualified VCSGui.Common as VCSGUI

import qualified VCSWrapper.Common as Wrapper

import Data.Maybe (fromJust, fromMaybe)
import Control.Monad.Trans(liftIO)
import Paths_vcsgui(getDataFileName)
import Control.Monad.Reader(ask)
import Data.Text (Text)
import GI.Gtk.Objects.VBox (VBox(..))
import GI.Gtk.Objects.Action (onActionActivate)
import GI.Gtk.Objects.ToggleButton
       (setToggleButtonActive, getToggleButtonActive,
        onToggleButtonToggled)
import GI.Gtk.Objects.Widget
       (onWidgetDeleteEvent, widgetHide, widgetShowAll)
import Data.GI.Base.Attributes (AttrOp(..))
import GI.Gtk.Objects.Builder (builderGetObject)
import Data.GI.Base.ManagedPtr (unsafeCastTo)
import Data.GI.Base.BasicTypes (NullToNothing(..))
--
-- glade path and object accessors
--
getGladepath = getDataFileName "data/guiSvnAskpass.glade"
accessorWindow = "windowAskpass"
accessorActOk = "actOk"
accessorActCancel = "actCancel"
accessorEntryPw = "entryPw"
accessorCheckbtUsePw = "checkbtUsePw"
accessorCheckbtSaveForSession = "checkbtSaveForSession"
accessorboxUsePwd = ("boxUsePwd" :: Text)

{- |
    'Handler' is a function used as an argument to the 'showAskpassGUI'. It represents a VCS
    command running in a 'Wrapper.Ctx' expecting password data which can be the followingAxis
        * Nothing, if GUI is closed or cancel button is pressed
        * Just (savePasswordSettingForSession, Maybe password)
    where savePasswordSettingForSession indicates if password-settings should be saved for current
    session. Maybe password is either:
        * Nothing, no password given
        * Just password, password has been provided
-}
type Handler = ((Maybe (Bool, Maybe Text))
                -> Wrapper.Ctx())

data AskpassGUI = AskpassGUI {
    windowAskpass :: H.WindowItem
    ,actOk :: H.ActionItem
    ,actCancel :: H.ActionItem
    ,entryPw :: H.TextEntryItem
    ,checkbtUsePw :: H.CheckButtonItem
    ,checkbtSaveForSession :: H.CheckButtonItem
    ,boxUsePwd :: VBox
}

-- | Shows a GUI asking the user for a password. 'Handler' will be called with result.
showAskpassGUI :: Handler -- ^ 'Handler' to be called when GUI is closed passing the result.
                  -> Wrapper.Ctx ()
showAskpassGUI handler = do
    config <- ask
    liftIO $ do
        gui <- loadAskpassGUI

        -- connect actions
        registerClose (windowAskpass gui) handler config
        registerCloseAction (actCancel gui) (windowAskpass gui) handler config
        onActionActivate (H.getItem (actOk gui)) $ do
                                            putStrLn "ok clicked"
                                            usePw <- H.get $ checkbtUsePw gui
                                            pw <- H.get (entryPw gui)
                                            saveForSession <- H.get $ checkbtSaveForSession gui

                                            let args =  if usePw then Just (saveForSession, Just $ fromMaybe "" pw)
                                                                 else Just (saveForSession, Nothing)
                                            VCSGUI.defaultVCSExceptionHandler $ Wrapper.runVcs config $ handler args
                                            H.closeWin (windowAskpass gui)
        onToggleButtonToggled (H.getItem (checkbtUsePw gui)) $ do
                                            active <- getToggleButtonActive (H.getItem (checkbtUsePw gui))
                                            if active then
                                                    widgetShowAll (boxUsePwd gui)
                                                else
                                                    widgetHide (boxUsePwd gui)
        -- present window
        widgetShowAll $ H.getItem $ windowAskpass gui
        return ()

registerClose :: H.WindowItem
                -> Handler
                -> Wrapper.Config
                -> IO()
registerClose win handler config = onWidgetDeleteEvent (H.getItem win) (\e -> liftIO (close win handler config) >> return False) >> return ()

registerCloseAction :: H.ActionItem
                    -> H.WindowItem
                    -> Handler
                    -> Wrapper.Config
                    -> IO()
registerCloseAction act win handler config = onActionActivate (H.getItem act) (liftIO (close win handler config)) >> return ()

close :: H.WindowItem
                -> Handler
                -> Wrapper.Config
                -> IO()
close win handler config = do
                        liftIO $ H.closeWin win
                        VCSGUI.defaultVCSExceptionHandler $ Wrapper.runVcs config $ handler Nothing

loadAskpassGUI :: IO AskpassGUI
loadAskpassGUI = do
    gladepath <- getGladepath
    builder <- H.openGladeFile gladepath

    windowAskpass <- H.getWindowFromGlade builder accessorWindow
    actOk <- H.getActionFromGlade builder accessorActOk
    actCancel <- H.getActionFromGlade builder accessorActCancel
    entryPw <- H.getTextEntryFromGlade builder accessorEntryPw
    checkbtUsePw <- H.getCheckButtonFromGlade builder accessorCheckbtUsePw
    setToggleButtonActive (H.getItem checkbtUsePw) True
    checkbtSaveForSession <- H.getCheckButtonFromGlade builder accessorCheckbtSaveForSession
    setToggleButtonActive (H.getItem checkbtSaveForSession) True
    boxUsePw <- nullToNothing (builderGetObject builder accessorboxUsePwd) >>= unsafeCastTo VBox . fromJust
    return $ AskpassGUI windowAskpass actOk actCancel entryPw checkbtUsePw checkbtSaveForSession boxUsePw