added possibility for cash transfer between users

This commit is contained in:
nek0 2015-07-28 21:47:18 +02:00
parent c98c0341d1
commit 6e93762eee
8 changed files with 128 additions and 0 deletions

View File

@ -37,6 +37,7 @@ import Handler.Modify
import Handler.CashCheck
import Handler.Avatar
import Handler.Barcode
import Handler.Transfer
-- 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

90
Handler/Transfer.hs Normal file
View File

@ -0,0 +1,90 @@
module Handler.Transfer where
import Import
import Handler.Common
import Data.Maybe
import Text.Shakespeare.Text (stext)
getTransferSelectR :: UserId -> Handler Html
getTransferSelectR from = do
mUser <- runDB $ get from
case mUser of
Just user -> do
users <- runDB $ selectList [UserId !=. from] [Asc UserIdent]
defaultLayout $ do
$(widgetFile "transferSelect")
Nothing -> do
setMessageI MsgUserUnknown
redirect HomeR
getTransferR :: UserId -> UserId -> Handler Html
getTransferR from to = do
mSender <- runDB $ get from
case mSender of
Just sender -> do
mRecpt <- runDB $ get to
case mRecpt of
Just recpt -> do
(transferWidget, enctype) <- generateFormPost transferForm
currency <- appCurrency <$> appSettings <$> getYesod
defaultLayout $ do
$(widgetFile "transfer")
Nothing -> do
setMessageI MsgUserUnknown
redirect $ TransferSelectR from
Nothing -> do
setMessageI MsgUserUnknown
redirect HomeR
postTransferR :: UserId -> UserId -> Handler Html
postTransferR from to = do
mSender <- runDB $ get from
case mSender of
Just sender -> do
mRecpt <- runDB $ get to
case mRecpt of
Just recpt -> do
((res, _), _) <- runFormPost transferForm
case res of
FormSuccess amount -> do
case amount < 0 of
False -> do
runDB $ update from [UserBalance -=. amount]
runDB $ update to [UserBalance +=. amount]
master <- getYesod
liftIO $ notify sender recpt amount master
setMessageI MsgTransferComplete
redirect HomeR
True -> do
setMessageI MsgNegativeTransfer
redirect $ TransferR from to
_ -> do
setMessageI MsgTransferError
redirect HomeR
Nothing -> do
setMessageI MsgUserUnknown
redirect $ TransferSelectR from
Nothing -> do
setMessageI MsgUserUnknown
redirect HomeR
transferForm :: Form Int
transferForm = renderDivs
$ areq currencyField (fieldSettingsLabel MsgValue) (Just 0)
notify :: User -> User -> Int -> App -> IO ()
notify sender recpt amount master = do
case userEmail sender of
Just email ->
liftIO $ sendMail email "Guthabentransfer beim Matematen"
[stext|
Hallo #{userIdent sender}
Du hast gerade #{formatIntCurrency amount}#{appCurrency $ appSettings master} an #{userIdent recpt} transferiert.
Viele Grüßem
Der Matemat
|]
Nothing ->
return ()

View File

@ -33,3 +33,5 @@
/barcode HomeBarcodeR GET
/user/#UserId/barcode SelectBarcodeR GET
!/user/cash/barcode SelectCashBarcodeR GET
/user/#UserId/transfer TransferSelectR GET
/user/#UserId/to/#UserId TransferR GET POST

View File

@ -108,3 +108,8 @@ BarcodeUnknown: Dieser Barcode ist unbekannt
BarcodeField: Barcodes
BarcodeAdded: Barcode erfolgreich hinzugefügt
BarcodeDuplicate: Dieser barcode wird schon verwendet
Transfer: Transferieren
TransferTo: Guthaben transferieren an
NegativeTransfer: Keine negativen Beträge transferieren
TransferComplete: Transfer abgeschlossen
TransferError: Fehler beim Transfer

View File

@ -10,6 +10,9 @@ $doctype 5
<li>
<a href=@{ModifyUserR uId}>
_{MsgEditUser}
<li>
<a href=@{TransferSelectR uId}>
_{MsgTransfer}
<h3>_{MsgChoosePrompt $ userIdent user}

14
templates/transfer.hamlet Normal file
View File

@ -0,0 +1,14 @@
$doctype 5
<h3>
_{MsgTransferTo} #{userIdent recpt}
<p>
_{MsgCurrentCharge (userBalance sender) currency}
<form method=post enctype=#{enctype}>
^{transferWidget}
<div>
<input type=submit value="_{MsgTransfer}">
<input onclick="crmnt( document.getElementById('hident2'), 5 )" value="_{MsgPlus5}" type="button">
<input onclick="crmnt( document.getElementById('hident2'), -5 )" value="_{MsgMinus5}" type="button">

View File

@ -0,0 +1,12 @@
$doctype 5
<h3>_{MsgTransferTo}
$forall (Entity uId user) <- users
<article .article>
$if userAvatar user /= Nothing
<a href=@{TransferR from uId} style="background-image: url(@{GetAvatarR $ fromJust $ userAvatar user})" .avatar>
<p>#{userIdent user}
$else
<a href=@{TransferR from uId}>
<p>#{userIdent user}

View File

@ -32,6 +32,7 @@ library
Handler.CashCheck
Handler.Avatar
Handler.Barcode
Handler.Transfer
if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT