yammat/Handler/Pinentry.hs
2018-10-10 18:13:50 +02:00

57 lines
1.6 KiB
Haskell

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
FormSuccess ppin ->
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
pinentryForm = areq passwordField (withAutofocus $ bfs MsgPIN) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)