now user notification on buy

Handler/Buy.hs

@@ -4,6 +4,7 @@ import Import
 import Handler.Common
 import qualified Data.Text as T
 import Text.Blaze.Internal
+import Text.Shakespeare.Text
 
 getBuyR :: UserId -> BeverageId -> Handler Html
 getBuyR uId bId = do
@@ -33,6 +34,8 @@ postBuyR uId bId = do
               runDB $ update uId [UserBalance -=. price]
               runDB $ update bId [BeverageAmount -=. quant]
               checkAlert bId
+              master <- getYesod
+              liftIO $ notifyUser user bev price master
               case sw of
                 False -> do
                   setMessage "Viel Vergnügen"
@@ -50,6 +53,27 @@ postBuyR uId bId = do
       setMessage "Benutzer oder Artikel unbekannt"
       redirect $ HomeR
 
+notifyUser :: User -> Beverage -> Int -> App -> IO ()
+notifyUser user bev price master = do
+  case userNotify user of
+    True ->
+      case userEmail user of
+        Just email ->
+          sendMail email "Einkauf beim Matematen"
+            [stext|
+Hallo #{userIdent user},
+
+Du hast gerade beim Matematen für #{formatIntCurrency price}#{appCurrency $ appSettings master} #{beverageIdent bev} eingekauft.
+
+Viele Grüsse,
+
+Der Matemat
+            |]
+        Nothing ->
+          return ()
+    False ->
+      return ()
+
 getBuyCashR :: BeverageId -> Handler Html
 getBuyCashR bId = do
   mBev <- runDB $ get bId

Handler/NewUser.hs

@@ -1,6 +1,6 @@
 module Handler.NewUser where
 
-import Import
+import Import as I
 import Text.Read
 
 getNewUserR :: Handler Html
@@ -30,3 +30,48 @@ newUserForm secs = renderDivs $ User
   <$> areq textField "Nickname" Nothing
   <*> pure 0
   <*> pure secs
+  <*> aopt emailField "E-mail" Nothing
+  <*> areq boolField "Benachrichtigung bei Kauf" (Just False)
+
+data UserConf = UserConf
+  { userConfEmail :: Maybe Text
+  , userConfNotify :: Bool
+  }
+
+getModifyUserR :: UserId -> Handler Html
+getModifyUserR uId = do
+  mUser <- runDB $ I.get uId
+  case mUser of
+    Just user -> do
+      (modifyUserWidget, enctype) <- generateFormPost $ modifyUserForm user
+      defaultLayout $ do
+      $(widgetFile "modifyUser")
+    Nothing -> do
+      setMessage "Benutzer unbekannt"
+      redirect $ HomeR
+
+postModifyUserR :: UserId -> Handler Html
+postModifyUserR uId = do
+  mUser <- runDB $ I.get uId
+  case mUser of
+    Just user -> do
+      ((res, _), _) <- runFormPost $ modifyUserForm user
+      case res of
+        FormSuccess conf -> do
+          runDB $ update uId
+            [ UserEmail =. userConfEmail conf
+            , UserNotify =. userConfNotify conf
+            ]
+          setMessage "Nutzerdaten aktualisiert"
+          redirect $ SelectR uId
+        _ -> do
+          setMessage "Nutzerdatenaktualisierung nicht erfolgreich"
+          redirect $ SelectR uId
+    Nothing -> do
+      setMessage "Nutzer unbekannt"
+      redirect $ HomeR
+
+modifyUserForm :: User -> Form UserConf
+modifyUserForm user = renderDivs $ UserConf
+  <$> aopt emailField "E-Mail" (Just $ userEmail user)
+  <*> areq boolField "Benachrichtigung bei Kauf" (Just $ userNotify user)

config/models

@@ -2,6 +2,8 @@ User
     ident Text
     balance Int
     timestamp Int
+    email Text Maybe
+    notify Bool default=False
     UniqueUser ident
     deriving Typeable Show
 Beverage

config/routes

@@ -9,6 +9,7 @@
 /user/#UserId		 	SelectR			GET
 !/user/cash			SelectCashR		GET
 /user/#UserId/recharge		RechargeR		GET POST
+/user/#UserId/modify		ModifyUserR		GET POST
 /newuser			NewUserR		GET POST
 /restock	 		RestockR		GET
 /upstock/#BeverageId		UpstockR		GET POST

templates/modify.hamlet

@@ -7,5 +7,5 @@ $doctype 5
   <div>
     <input type=submit value="Absenden">
 
-<p>
+<a href=@{ModifyR bId}>
-  <a href=@{DeleteBeverageR bId}>Artikel löschen
+  Artikel löschen

templates/select.hamlet

@@ -7,6 +7,9 @@ $doctype 5
     <li>
       <a href=@{RechargeR uId}>
         Guthaben aufladen
+    <li>
+      <a href=@{ModifyUserR uId}>
+        Nutzerdaten akutalisieren
 
 <h3>Wähle deinen Artikel, #{userIdent user}