adding PIN "protection"

This commit is contained in:
nek0 2018-10-02 20:25:32 +02:00
parent 1a2e12010c
commit 438844d340
8 changed files with 89 additions and 5 deletions

View file

@ -57,6 +57,7 @@ import Handler.Supplier
import Handler.SupplierActions import Handler.SupplierActions
import Handler.Demand import Handler.Demand
import Handler.Statistics import Handler.Statistics
import Handler.Pinentry
-- This line actually creates our YesodDispatch instance. It is the second half -- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the -- of the call to mkYesodData which occurs in Foundation.hs. Please see the

View file

@ -70,6 +70,7 @@ newUserForm today = User
<*> pure today <*> pure today
<*> aopt emailField (bfs MsgEmailNotify) Nothing <*> aopt emailField (bfs MsgEmailNotify) Nothing
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) Nothing <*> aopt (selectField avatars) (bfs MsgSelectAvatar) Nothing
<*> aopt passwordField (bfs MsgUserPin) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit) <* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where where
avatars = do avatars = do
@ -81,6 +82,7 @@ data UserConf = UserConf
, userConfEmail :: Maybe Text , userConfEmail :: Maybe Text
, userConfAvatar :: Maybe AvatarId , userConfAvatar :: Maybe AvatarId
, userConfBarcode :: Maybe [Text] , userConfBarcode :: Maybe [Text]
, userConfPIN :: Maybe Text
} }
getModifyUserR :: UserId -> Handler Html getModifyUserR :: UserId -> Handler Html
@ -115,6 +117,7 @@ postModifyUserR uId =
[ UserIdent =. userConfIdent uc [ UserIdent =. userConfIdent uc
, UserEmail =. userConfEmail uc , UserEmail =. userConfEmail uc
, UserAvatar =. userConfAvatar uc , UserAvatar =. userConfAvatar uc
, UserPin =. userConfPIN uc
] ]
liftIO $ notify user (userConfEmail uc) liftIO $ notify user (userConfEmail uc)
handleBarcodes (Left uId) (fromMaybe [] $ userConfBarcode uc) handleBarcodes (Left uId) (fromMaybe [] $ userConfBarcode uc)
@ -134,6 +137,7 @@ modifyUserForm user bs = UserConf
<*> aopt emailField (bfs MsgEmailNotify) (Just $ userEmail user) <*> aopt emailField (bfs MsgEmailNotify) (Just $ userEmail user)
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) (Just $ userAvatar user) <*> aopt (selectField avatars) (bfs MsgSelectAvatar) (Just $ userAvatar user)
<*> aopt barcodeField (bfs MsgBarcodeField) (Just $ Just bs) <*> aopt barcodeField (bfs MsgBarcodeField) (Just $ Just bs)
<*> aopt passwordField (bfs MsgUserPin) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit) <* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where where
avatars = do avatars = do

58
Handler/Pinentry.hs Normal file
View file

@ -0,0 +1,58 @@
{-# LANGUAGE DoAndIfThenElse #-}
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 -> do
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 (bfs MsgPIN) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)

View file

@ -13,6 +13,7 @@
-- --
-- You should have received a copy of the GNU Affero General Public License -- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>. -- along with this program. If not, see <http://www.gnu.org/licenses/>.
{-# LANGUAGE DoAndIfThenElse #-}
module Handler.Select where module Handler.Select where
import Import import Import
@ -24,11 +25,22 @@ getSelectR :: UserId -> Handler Html
getSelectR uId = getSelectR uId =
isUser uId HomeR >>= (\user -> do isUser uId HomeR >>= (\user -> do
master <- getYesod master <- getYesod
beverages <- runDB $ selectList [BeverageAmount >. 0] [Asc BeverageIdent] mpin <- lookupSession "pinentry"
defaultLayout $ do case mpin of
addScript $ StaticR js_barcode_js Nothing -> redirect $ PinentryR uId
setTitleI MsgSelectItem Just ppin -> do
$(widgetFile "select") if ppin == T.pack (show uId)
then do
deleteSession "pinentry"
beverages <- runDB $ selectList [BeverageAmount >. 0] [Asc BeverageIdent]
defaultLayout $ do
addScript $ StaticR js_barcode_js
setTitleI MsgSelectItem
$(widgetFile "select")
else do
deleteSession "pinentry"
setMessageI MsgWrongPinAuth
redirect HomeR
) )
getSelectCashR :: Handler Html getSelectCashR :: Handler Html

View file

@ -4,6 +4,7 @@ User
timestamp Day timestamp Day
email Text Maybe email Text Maybe
avatar AvatarId Maybe avatar AvatarId Maybe
pin Text Maybe
UniqueUser ident UniqueUser ident
deriving Typeable Show deriving Typeable Show

View file

@ -45,5 +45,6 @@
/supply/#SupplierId/digest SupplierDigestR GET /supply/#SupplierId/digest SupplierDigestR GET
/supply/#SupplierId/delete DeleteSupplierR GET /supply/#SupplierId/delete DeleteSupplierR GET
/demand/#Int DemandR GET /demand/#Int DemandR GET
/pin/#UserId PinentryR GET POST
/statistics.json StatisticsR GET /statistics.json StatisticsR GET

View file

@ -151,3 +151,9 @@ MainPage: Hauptseite
ModifyBeverage ident@Text: Artikel #{ident} bearbeiten ModifyBeverage ident@Text: Artikel #{ident} bearbeiten
ModifyUser ident@Text: Benutzer #{ident} bearbeiten ModifyUser ident@Text: Benutzer #{ident} bearbeiten
SupplierActions ident@Text: Aktionen für Lieferant #{ident} SupplierActions ident@Text: Aktionen für Lieferant #{ident}
UserPin: Benutzer-PIN
WrongPinAuth: Falsche Pin fpr diesen Benutzer
EnterPin: Bitte PIN Eingeben
WrongPin: Falsche PIN eingegeben
PinFailure: Fehler bei der Pineingabe
PIN: PIN

View file

@ -41,6 +41,7 @@ library
Handler.SupplierActions Handler.SupplierActions
Handler.Demand Handler.Demand
Handler.Statistics Handler.Statistics
Handler.Pinentry
if flag(dev) || flag(library-only) if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT -DHTTP_CLIENT cpp-options: -DDEVELOPMENT -DHTTP_CLIENT