88 lines
2.9 KiB
Haskell
88 lines
2.9 KiB
Haskell
-- yammat - Yet Another MateMAT
|
|
-- Copyright (C) 2015 Amedeo Molnár
|
|
--
|
|
-- This program is free software: you can redistribute it and/or modify
|
|
-- it under the terms of the GNU Affero General Public License as published
|
|
-- by the Free Software Foundation, either version 3 of the License, or
|
|
-- (at your option) any later version.
|
|
--
|
|
-- This program is distributed in the hope that it will be useful,
|
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
-- GNU Affero General Public License for more details.
|
|
--
|
|
-- 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/>.
|
|
{-# LANGUAGE DoAndIfThenElse #-}
|
|
module Handler.Select where
|
|
|
|
import Import
|
|
import Handler.Common
|
|
import qualified Data.Text as T
|
|
import Data.Maybe
|
|
|
|
getSelectR :: UserId -> Handler Html
|
|
getSelectR uId =
|
|
isUser uId HomeR >>= (\user -> do
|
|
master <- getYesod
|
|
mpin <- lookupSession "pinentry"
|
|
case mpin of
|
|
Nothing -> redirect $ PinentryR uId
|
|
Just ppin ->
|
|
if ppin == T.pack (show uId)
|
|
then do
|
|
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 = do
|
|
beverages <- runDB $ selectList [BeverageAmount >. 0] [Asc BeverageIdent]
|
|
defaultLayout $ do
|
|
addScript $ StaticR js_barcode_js
|
|
setTitleI MsgSelectItem
|
|
$(widgetFile "selectCash")
|
|
|
|
getRechargeR :: UserId -> Handler Html
|
|
getRechargeR uId =
|
|
isUser uId HomeR >>= (\user -> do
|
|
(rechargeWidget, enctype) <- generateFormPost
|
|
$ renderBootstrap3 BootstrapBasicForm rechargeForm
|
|
currency <- appCurrency <$> appSettings <$> getYesod
|
|
defaultLayout $ do
|
|
setTitleI MsgRecharge
|
|
$(widgetFile "recharge")
|
|
)
|
|
|
|
postRechargeR :: UserId -> Handler Html
|
|
postRechargeR uId =
|
|
isUser uId HomeR >>= (\user -> do
|
|
((res, _), _) <- runFormPost
|
|
$ renderBootstrap3 BootstrapBasicForm rechargeForm
|
|
case res of
|
|
FormSuccess amount ->
|
|
if amount <= 0
|
|
then do
|
|
setMessageI MsgNegativeRecharge
|
|
redirect $ RechargeR uId
|
|
else do
|
|
updateCashier amount ("Guthaben: " `T.append` userIdent user)
|
|
today <- liftIO $ return . utctDay =<< getCurrentTime
|
|
runDB $ update uId [UserBalance +=. amount, UserTimestamp =. today]
|
|
setMessageI MsgRecharged
|
|
redirect HomeR
|
|
_ -> do
|
|
setMessageI MsgRechargeError
|
|
redirect HomeR
|
|
)
|
|
|
|
rechargeForm :: AForm Handler Int
|
|
rechargeForm = areq currencyField (bfs MsgValue) (Just 0)
|
|
<* bootstrapSubmit (msgToBSSubmit MsgRecharge)
|