yammat/Handler/Pinentry.hs

58 lines
1.6 KiB
Haskell
Raw Normal View History

2018-10-02 18:25:32 +00:00
module Handler.Pinentry where
import Import
import Handler.Common
import qualified Data.Text as T (pack)
getPinentryR :: UserId -> Handler Html
getPinentryR uId =
isUser uId HomeR >>= (\user -> do
case userPin user of
Just pin -> do
(pinWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm
$ pinentryForm
defaultLayout $ do
[whamlet|
<h3>_{MsgEnterPin}
<form method="post" enctype=#{enctype}>
^{pinWidget}
|]
Nothing -> do
setSession "pinentry" (T.pack $ show uId)
redirect $ SelectR uId
)
postPinentryR :: UserId -> Handler Html
postPinentryR uId = do
isUser uId HomeR >>= (\user -> do
case userPin user of
Just pin -> do
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm
$ pinentryForm
case res of
2018-10-02 18:51:56 +00:00
FormSuccess ppin ->
2018-10-02 18:25:32 +00:00
if ppin == pin
then do
setSession "pinentry" (T.pack $ show uId)
redirect $ SelectR uId
else do
deleteSession "pinentry"
setMessageI MsgWrongPin
redirect HomeR
_ -> do
deleteSession "pinentry"
setMessageI MsgPinFailure
redirect HomeR
Nothing -> do
setSession "pinentry" (T.pack $ show uId)
redirect $ SelectR uId
)
pinentryForm :: AForm Handler Text
2018-10-10 16:13:50 +00:00
pinentryForm = areq passwordField (withAutofocus $ bfs MsgPIN) Nothing
2018-10-02 18:25:32 +00:00
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)