deduplication

2016-05-23 20:35:14 +02:00 · 2016-05-23 20:35:14 +02:00 · bc3e52cb90
parent 994f2a751f
commit bc3e52cb90
7 changed files with 284 additions and 337 deletions
--- a/Handler/Buy.hs
+++ b/Handler/Buy.hs
@ -21,60 +21,50 @@ import Text.Shakespeare.Text

 getBuyR :: UserId -> BeverageId -> Handler Html
 getBuyR uId bId = do
-  mTup <- checkData uId bId
-  case mTup of
-    Just (_, bev) -> do
-      master <- getYesod
-      (buyWidget, enctype) <- generateFormPost
-        $ renderBootstrap3 BootstrapBasicForm
-        $ buyForm
-      defaultLayout $
-        $(widgetFile "buy")
-    Nothing -> do
-      setMessageI MsgUserOrArticleUnknown
-      redirect HomeR
+  (_, bev) <- checkData uId bId
+  master <- getYesod
+  (buyWidget, enctype) <- generateFormPost
+    $ renderBootstrap3 BootstrapBasicForm
+    $ buyForm
+  defaultLayout $
+    $(widgetFile "buy")

 postBuyR :: UserId -> BeverageId -> Handler Html
 postBuyR uId bId = do
-  mTup <- checkData uId bId
-  case mTup of
-    Just (user, bev) -> do
-      ((res, _), _) <- runFormPost
-        $ renderBootstrap3 BootstrapBasicForm
-        $ buyForm
-      case res of
-        FormSuccess quant -> do
-          if quant > beverageAmount bev
-            then do
-              setMessageI MsgNotEnoughItems
-              redirect $ BuyR uId bId
-            else do
-              let price = quant * (beveragePrice bev)
-              let sw = price > (userBalance user)
-              today <- liftIO $ return . utctDay =<< getCurrentTime
-              runDB $ do
-                update uId [UserTimestamp =. today]
-                update uId [UserBalance -=. price]
-                update bId [BeverageAmount -=. quant]
-              checkAlert bId
-              master <- getYesod
-              liftIO $ notifyUser user bev quant price master
-              case sw of
-                False -> do
-                  setMessageI MsgPurchaseSuccess
-                  redirect HomeR
-                True -> do
-                  let level = case userBalance user - price of
-                        balance
-                          | balance <= -5000 -> 3
-                          | balance <= -1000 -> 2
-                          | otherwise -> 1
-                  redirect $ DemandR level
-        _ -> do
-          setMessageI MsgErrorOccured
-          redirect HomeR
-    Nothing -> do
-      setMessageI MsgUserUnknown
+  (user, bev) <- checkData uId bId
+  ((res, _), _) <- runFormPost
+    $ renderBootstrap3 BootstrapBasicForm
+    $ buyForm
+  case res of
+    FormSuccess quant -> do
+      if quant > beverageAmount bev
+        then do
+          setMessageI MsgNotEnoughItems
+          redirect $ BuyR uId bId
+        else do
+          let price = quant * (beveragePrice bev)
+          let sw = price > (userBalance user)
+          today <- liftIO $ return . utctDay =<< getCurrentTime
+          runDB $ do
+            update uId [UserTimestamp =. today]
+            update uId [UserBalance -=. price]
+            update bId [BeverageAmount -=. quant]
+          checkAlert bId
+          master <- getYesod
+          liftIO $ notifyUser user bev quant price master
+          case sw of
+            False -> do
+              setMessageI MsgPurchaseSuccess
+              redirect HomeR
+            True -> do
+              let level = case userBalance user - price of
+                    balance
+                      | balance <= -5000 -> 3
+                      | balance <= -1000 -> 2
+                      | otherwise -> 1
+              redirect $ DemandR level
+    _ -> do
+      setMessageI MsgErrorOccured
      redirect HomeR

 notifyUser :: User -> Beverage -> Int -> Int -> App -> IO ()
@ -121,45 +111,38 @@ getBuyCashR bId = do
      redirect HomeR

 postBuyCashR :: BeverageId -> Handler Html
-postBuyCashR bId = do
-  mBev <- runDB $ get bId
-  case mBev of
-    Just bev -> do
-      ((res, _), _) <- runFormPost
-        $ renderBootstrap3 BootstrapBasicForm
-        $ buyForm
-      case res of
-        FormSuccess quant -> do
-          if quant > beverageAmount bev
-            then do
-              setMessageI MsgNotEnoughItems
-              redirect $ BuyCashR bId
-            else do
-              master <- getYesod
-              let price = quant * (beveragePrice bev + appCashCharge (appSettings master))
-              runDB $ update bId [BeverageAmount -=. quant]
-              updateCashier price "Barzahlung"
-              checkAlert bId
-              let currency = appCurrency $ appSettings master
-              setMessageI $ MsgPurchaseSuccessCash price currency
-              redirect HomeR
-        _ -> do
-          setMessageI MsgItemDisappeared
-          redirect HomeR
-    Nothing -> do
-      setMessageI MsgItemUnknown
-      redirect HomeR
+postBuyCashR bId =
+  isBeverage bId HomeR >>= (\bev -> do
+    ((res, _), _) <- runFormPost
+      $ renderBootstrap3 BootstrapBasicForm
+      $ buyForm
+    case res of
+      FormSuccess quant -> do
+        if quant > beverageAmount bev
+          then do
+            setMessageI MsgNotEnoughItems
+            redirect $ BuyCashR bId
+          else do
+            master <- getYesod
+            let price = quant * (beveragePrice bev + appCashCharge (appSettings master))
+            runDB $ update bId [BeverageAmount -=. quant]
+            updateCashier price "Barzahlung"
+            checkAlert bId
+            let currency = appCurrency $ appSettings master
+            setMessageI $ MsgPurchaseSuccessCash price currency
+            redirect HomeR
+      _ -> do
+        setMessageI MsgItemDisappeared
+        redirect HomeR
+  )

-checkData :: UserId -> BeverageId -> Handler (Maybe (User, Beverage))
-checkData uId bId = do
-  mUser <- runDB $ get uId
-  mBev <- runDB $ get bId
-  case mUser of
-    Just user -> do
-      case mBev of
-        Just bev -> return $ Just (user, bev)
-        Nothing -> return Nothing
-    Nothing -> return Nothing
+checkData :: UserId -> BeverageId -> Handler (User, Beverage)
+checkData uId bId =
+  isUser uId HomeR >>= (\user -> do
+    isBeverage bId HomeR >>= (\bev ->
+      return (user, bev)
+      )
+  )

 buyForm :: AForm Handler Int
 buyForm = areq amountField (bfs MsgAmount) (Just 1)
--- a/Handler/Common.hs
+++ b/Handler/Common.hs
@ -223,3 +223,27 @@ sendMail to subject body =

 formatIntVolume :: Int -> Text
 formatIntVolume x = formatFloat (fromIntegral x / 1000)
+
+--------------------------------------------------------------------------------
+-- common case patterns
+--------------------------------------------------------------------------------
+
+isUser :: UserId -> Route App -> Handler User
+isUser uId route = do
+  mUser <- runDB $ get uId
+  case mUser of
+    Nothing -> do
+      setMessageI MsgUserUnknown
+      redirect route
+    Just user ->
+      return user
+
+isBeverage :: BeverageId -> Route App -> Handler Beverage
+isBeverage bId route = do
+  mBev <- runDB $ get bId
+  case mBev of
+    Nothing -> do
+      setMessageI MsgItemUnknown
+      redirect route
+    Just bev ->
+      return bev
--- a/Handler/Modify.hs
+++ b/Handler/Modify.hs
@ -19,58 +19,50 @@ import Import
 import Handler.Common

 getModifyR :: BeverageId -> Handler Html
-getModifyR bId = do
-  mBev <- runDB $ get bId
-  case mBev of
-    Just bev -> do
-      p <- lookupGetParam "barcode"
-      _ <- handleGetParam p (Right bId)
-      rawbs <- runDB $ selectList [BarcodeBev ==. Just bId] []
-      let bs = map (barcodeCode . entityVal) rawbs
-      (modifyWidget, enctype) <- generateFormPost
-        $ renderBootstrap3 BootstrapBasicForm
-        $ modifyForm bev bs
-      defaultLayout $
-        $(widgetFile "modify")
-    Nothing -> do
-      setMessageI MsgItemUnknown
-      redirect SummaryR
+getModifyR bId =
+  isBeverage bId SummaryR >>= (\bev -> do
+    p <- lookupGetParam "barcode"
+    _ <- handleGetParam p (Right bId)
+    rawbs <- runDB $ selectList [BarcodeBev ==. Just bId] []
+    let bs = map (barcodeCode . entityVal) rawbs
+    (modifyWidget, enctype) <- generateFormPost
+      $ renderBootstrap3 BootstrapBasicForm
+      $ modifyForm bev bs
+    defaultLayout $
+      $(widgetFile "modify")
+  )

 postModifyR :: BeverageId -> Handler Html
-postModifyR bId = do
-  mBev <- runDB $ get bId
-  case mBev of
-    Just bev -> do
-      rawbs <- runDB $ selectList [BarcodeBev ==. Just bId] []
-      let bs = map (barcodeCode . entityVal) rawbs
-      ((res, _), _) <- runFormPost
-        $ renderBootstrap3 BootstrapBasicForm
-        $ modifyForm bev bs
-      case res of
-        FormSuccess nBev -> do
-          runDB $ update bId
-            [ BeverageIdent =. modBevIdent nBev
-            , BeveragePrice =. modBevPrice nBev
-            , BeverageAmount =. modBevAmount nBev
-            , BeverageAlertAmount =. modBevAlertAmount nBev
-            , BeverageCorrectedAmount +=. (modBevAmount nBev - beverageAmount bev)
-            , BeverageMl =. modBevMl nBev
-            , BeverageAvatar =. modBevAvatar nBev
-            , BeverageSupplier =. modBevSupp nBev
-            , BeverageMaxAmount =. modBevMaxAmount nBev
-            , BeveragePerCrate =. modBevPC nBev
-            , BeverageArtNr =. modBevArtNr nBev
-            , BeveragePricePerCrate =. modBevPricePC nBev
-            ]
-          handleBarcodes (Right bId) (fromMaybe [] $ modBevBarcodes nBev)
-          setMessageI MsgEditSuccess
-          redirect SummaryR
-        _ -> do
-          setMessageI MsgEditFail
-          redirect SummaryR
-    Nothing -> do
-      setMessageI MsgItemUnknown
-      redirect SummaryR
+postModifyR bId =
+  isBeverage bId SummaryR >>= (\bev -> do
+    rawbs <- runDB $ selectList [BarcodeBev ==. Just bId] []
+    let bs = map (barcodeCode . entityVal) rawbs
+    ((res, _), _) <- runFormPost
+      $ renderBootstrap3 BootstrapBasicForm
+      $ modifyForm bev bs
+    case res of
+      FormSuccess nBev -> do
+        runDB $ update bId
+          [ BeverageIdent =. modBevIdent nBev
+          , BeveragePrice =. modBevPrice nBev
+          , BeverageAmount =. modBevAmount nBev
+          , BeverageAlertAmount =. modBevAlertAmount nBev
+          , BeverageCorrectedAmount +=. (modBevAmount nBev - beverageAmount bev)
+          , BeverageMl =. modBevMl nBev
+          , BeverageAvatar =. modBevAvatar nBev
+          , BeverageSupplier =. modBevSupp nBev
+          , BeverageMaxAmount =. modBevMaxAmount nBev
+          , BeveragePerCrate =. modBevPC nBev
+          , BeverageArtNr =. modBevArtNr nBev
+          , BeveragePricePerCrate =. modBevPricePC nBev
+          ]
+        handleBarcodes (Right bId) (fromMaybe [] $ modBevBarcodes nBev)
+        setMessageI MsgEditSuccess
+        redirect SummaryR
+      _ -> do
+        setMessageI MsgEditFail
+        redirect SummaryR
+  )

 data ModBev = ModBev
  { modBevIdent :: Text
@ -107,13 +99,9 @@ modifyForm bev bs = ModBev
    sups = optionsPersistKey [] [Asc SupplierIdent] supplierIdent

 getDeleteBeverageR :: BeverageId -> Handler Html
-getDeleteBeverageR bId = do
-  mBev <- runDB $ get bId
-  case mBev of
-    Just _ -> do
-      runDB $ delete bId
-      setMessageI MsgItemDeleted
-      redirect HomeR
-    Nothing -> do
-      setMessageI MsgItemUnknown
-      redirect HomeR
+getDeleteBeverageR bId =
+  isBeverage bId HomeR >>= (\_ -> do
+    runDB $ delete bId
+    setMessageI MsgItemDeleted
+    redirect HomeR
+  )
--- a/Handler/NewUser.hs
+++ b/Handler/NewUser.hs
@ -70,56 +70,48 @@ data UserConf = UserConf
  }

 getModifyUserR :: UserId -> Handler Html
-getModifyUserR uId = do
-  mUser <- runDB $ I.get uId
-  case mUser of
-    Just user -> do
-      p <- lookupGetParam "barcode"
-      _ <- handleGetParam p (Left uId)
-      rawbs <- runDB $ selectList [BarcodeUser ==. Just uId] []
-      let bs = map (barcodeCode . entityVal) rawbs
-      (modifyUserWidget, enctype) <- generateFormPost
-        $ renderBootstrap3 BootstrapBasicForm
-        $ modifyUserForm user bs
-      defaultLayout $
-        $(widgetFile "modifyUser")
-    Nothing -> do
-      setMessageI MsgUserUnknown
-      redirect HomeR
+getModifyUserR uId =
+  isUser uId HomeR >>= (\user -> do
+    p <- lookupGetParam "barcode"
+    _ <- handleGetParam p (Left uId)
+    rawbs <- runDB $ selectList [BarcodeUser ==. Just uId] []
+    let bs = map (barcodeCode . entityVal) rawbs
+    (modifyUserWidget, enctype) <- generateFormPost
+      $ renderBootstrap3 BootstrapBasicForm
+      $ modifyUserForm user bs
+    defaultLayout $
+      $(widgetFile "modifyUser")
+  )

 postModifyUserR :: UserId -> Handler Html
-postModifyUserR uId = do
-  mUser <- runDB $ I.get uId
-  case mUser of
-    Just user -> do
-      rawbs <- runDB $ selectList [BarcodeUser ==. Just uId] []
-      let bs = map (barcodeCode . entityVal) rawbs
-      ((res, _), _) <- runFormPost
-        $ renderBootstrap3 BootstrapBasicForm
-        $ modifyUserForm user bs
-      case res of
-        FormSuccess uc -> do
-          namesakes <- runDB $ selectList [UserIdent ==. userConfIdent uc, UserId !=. uId] []
-          if null namesakes
-            then do
-              runDB $ update uId
-                [ UserIdent =. userConfIdent uc
-                , UserEmail =. userConfEmail uc
-                , UserAvatar =. userConfAvatar uc
-                ]
-              liftIO $ notify user (userConfEmail uc)
-              handleBarcodes (Left uId) (fromMaybe [] $ userConfBarcode uc)
-              setMessageI MsgUserEdited
-              redirect $ SelectR uId
-            else do
-              setMessageI MsgUserIdentNotUnique
-              redirect $ ModifyUserR uId
-        _ -> do
-          setMessageI MsgUserNotEdited
-          redirect $ SelectR uId
-    Nothing -> do
-      setMessageI MsgUserUnknown
-      redirect HomeR
+postModifyUserR uId =
+  isUser uId HomeR >>= (\user -> do
+    rawbs <- runDB $ selectList [BarcodeUser ==. Just uId] []
+    let bs = map (barcodeCode . entityVal) rawbs
+    ((res, _), _) <- runFormPost
+      $ renderBootstrap3 BootstrapBasicForm
+      $ modifyUserForm user bs
+    case res of
+      FormSuccess uc -> do
+        namesakes <- runDB $ selectList [UserIdent ==. userConfIdent uc, UserId !=. uId] []
+        if null namesakes
+          then do
+            runDB $ update uId
+              [ UserIdent =. userConfIdent uc
+              , UserEmail =. userConfEmail uc
+              , UserAvatar =. userConfAvatar uc
+              ]
+            liftIO $ notify user (userConfEmail uc)
+            handleBarcodes (Left uId) (fromMaybe [] $ userConfBarcode uc)
+            setMessageI MsgUserEdited
+            redirect $ SelectR uId
+          else do
+            setMessageI MsgUserIdentNotUnique
+            redirect $ ModifyUserR uId
+      _ -> do
+        setMessageI MsgUserNotEdited
+        redirect $ SelectR uId
+  )

 modifyUserForm :: User -> [Text] -> AForm Handler UserConf
 modifyUserForm user bs = UserConf
--- a/Handler/Restock.hs
+++ b/Handler/Restock.hs
@ -26,43 +26,35 @@ getRestockR = do
    $(widgetFile "restock")

 getUpstockR :: BeverageId -> Handler Html
-getUpstockR bId = do
-  mBev <- runDB $ get bId
-  case mBev of
-    Just bev -> do
-      (upstockWidget, enctype) <- generateFormPost
-        $ renderBootstrap3 BootstrapBasicForm upstockForm
-      defaultLayout $
-        $(widgetFile "upstock")
-    Nothing -> do
-      setMessageI MsgItemUnknown
-      redirect RestockR
+getUpstockR bId =
+  isBeverage bId RestockR >>= (\bev -> do
+    (upstockWidget, enctype) <- generateFormPost
+      $ renderBootstrap3 BootstrapBasicForm upstockForm
+    defaultLayout $
+      $(widgetFile "upstock")
+  )

 postUpstockR :: BeverageId -> Handler Html
-postUpstockR bId = do
-  mBev <- runDB $ get bId
-  case mBev of
-    Just bev -> do
-      ((res, _), _) <- runFormPost
-        $ renderBootstrap3 BootstrapBasicForm upstockForm
-      case res of
-        FormSuccess c ->
-          if upstockSingles c >= 0 && upstockCrates c >= 0
-            then do
-              let total = upstockSingles c + (upstockCrates c * (fromMaybe 0 $ beveragePerCrate bev))
-              runDB $ update bId [BeverageAmount +=. total]
-              setMessageI MsgStockedUp
-              redirect RestockR
-            else do
-              setMessageI MsgNotStockedUp
-              redirect $ UpstockR bId
-        
-        _ -> do
-          setMessageI MsgStockupError
-          redirect $ UpstockR bId
-    Nothing -> do
-      setMessageI MsgItemUnknown
-      redirect RestockR
+postUpstockR bId =
+  isBeverage bId RestockR >>= (\bev -> do
+    ((res, _), _) <- runFormPost
+      $ renderBootstrap3 BootstrapBasicForm upstockForm
+    case res of
+      FormSuccess c ->
+        if upstockSingles c >= 0 && upstockCrates c >= 0
+          then do
+            let total = upstockSingles c + (upstockCrates c * (fromMaybe 0 $ beveragePerCrate bev))
+            runDB $ update bId [BeverageAmount +=. total]
+            setMessageI MsgStockedUp
+            redirect RestockR
+          else do
+            setMessageI MsgNotStockedUp
+            redirect $ UpstockR bId
+      
+      _ -> do
+        setMessageI MsgStockupError
+        redirect $ UpstockR bId
+  )

 data UpstockAmount = UpstockAmount
  { upstockSingles :: Int
--- a/Handler/Select.hs
+++ b/Handler/Select.hs
@ -21,17 +21,13 @@ import qualified Data.Text as T
 import Data.Maybe

 getSelectR :: UserId -> Handler Html
-getSelectR uId = do
-  mUser <- runDB $ get uId
-  case mUser of
-    Just user -> do
-      master <- getYesod
-      beverages <- runDB $ selectList [BeverageAmount >. 0] [Asc BeverageIdent]
-      defaultLayout $
-        $(widgetFile "select")
-    Nothing -> do
-      setMessageI MsgUserUnknown
-      redirect HomeR
+getSelectR uId =
+  isUser uId HomeR >>= (\user -> do
+    master <- getYesod
+    beverages <- runDB $ selectList [BeverageAmount >. 0] [Asc BeverageIdent]
+    defaultLayout $
+      $(widgetFile "select")
+  )

 getSelectCashR :: Handler Html
 getSelectCashR = do
@ -40,44 +36,36 @@ getSelectCashR = do
    $(widgetFile "selectCash")

 getRechargeR :: UserId -> Handler Html
-getRechargeR uId = do
-  mUser <- runDB $ get uId
-  case mUser of
-    Just user -> do
-      (rechargeWidget, enctype) <- generateFormPost
-        $ renderBootstrap3 BootstrapBasicForm rechargeForm
-      currency <- appCurrency <$> appSettings <$> getYesod
-      defaultLayout $
-        $(widgetFile "recharge")
-    Nothing -> do
-      setMessageI MsgUserUnknown
-      redirect HomeR
+getRechargeR uId =
+  isUser uId HomeR >>= (\user -> do
+    (rechargeWidget, enctype) <- generateFormPost
+      $ renderBootstrap3 BootstrapBasicForm rechargeForm
+    currency <- appCurrency <$> appSettings <$> getYesod
+    defaultLayout $
+      $(widgetFile "recharge")
+  )

 postRechargeR :: UserId -> Handler Html
-postRechargeR uId = do
-  mUser <- runDB $ get uId
-  case mUser of
-    Just 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
-    Nothing -> do
-      setMessageI MsgUserUnknown
-      redirect HomeR
+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)
--- a/Handler/Transfer.hs
+++ b/Handler/Transfer.hs
@ -21,69 +21,49 @@ import Data.Maybe
 import Text.Shakespeare.Text (stext)

 getTransferSelectR :: UserId -> Handler Html
-getTransferSelectR from = do
-  mUser <- runDB $ get from
-  case mUser of
-    Just _ -> do
-      users <- runDB $ selectList [UserId !=. from] [Asc UserIdent]
-      defaultLayout $
-        $(widgetFile "transferSelect")
-    Nothing -> do
-      setMessageI MsgUserUnknown
-      redirect HomeR
+getTransferSelectR from =
+  isUser from HomeR >>= (\_ -> do
+    users <- runDB $ selectList [UserId !=. from] [Asc UserIdent]
+    defaultLayout $
+      $(widgetFile "transferSelect")
+  )

 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
-            $ renderBootstrap3 BootstrapBasicForm transferForm
-          currency <- appCurrency <$> appSettings <$> getYesod
-          defaultLayout $ do
-            $(widgetFile "transfer")
-        Nothing -> do
-          setMessageI MsgUserUnknown
-          redirect $ TransferSelectR from
-    Nothing -> do
-      setMessageI MsgUserUnknown
-      redirect HomeR
+getTransferR from to =
+  isUser from HomeR >>= (\sender ->
+    isUser to (TransferSelectR from) >>= (\recpt -> do
+      (transferWidget, enctype) <- generateFormPost
+        $ renderBootstrap3 BootstrapBasicForm transferForm
+      currency <- appCurrency <$> appSettings <$> getYesod
+      defaultLayout $ do
+        $(widgetFile "transfer")
+      )
+  )

 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
-            $ renderBootstrap3 BootstrapBasicForm transferForm
-          case res of
-            FormSuccess amount -> do
-              if amount < 0
-                then do
-                  setMessageI MsgNegativeTransfer
-                  redirect $ TransferR from to
-                else do
-                  runDB $ update from [UserBalance -=. amount]
-                  runDB $ update to [UserBalance +=. amount]
-                  master <- getYesod
-                  liftIO $ notify sender recpt amount master
-                  setMessageI MsgTransferComplete
-                  redirect HomeR
-            _ -> do
-              setMessageI MsgTransferError
+postTransferR from to =
+  isUser from HomeR >>= (\sender ->
+    isUser to (TransferSelectR from) >>= (\recpt -> do
+      ((res, _), _) <- runFormPost
+        $ renderBootstrap3 BootstrapBasicForm transferForm
+      case res of
+        FormSuccess amount -> do
+          if amount < 0
+            then do
+              setMessageI MsgNegativeTransfer
+              redirect $ TransferR from to
+            else do
+              runDB $ update from [UserBalance -=. amount]
+              runDB $ update to [UserBalance +=. amount]
+              master <- getYesod
+              liftIO $ notify sender recpt amount master
+              setMessageI MsgTransferComplete
              redirect HomeR
-        Nothing -> do
-          setMessageI MsgUserUnknown
-          redirect $ TransferSelectR from
-    Nothing -> do
-      setMessageI MsgUserUnknown
-      redirect HomeR
+        _ -> do
+          setMessageI MsgTransferError
+          redirect HomeR
+      )
+  )

 transferForm :: AForm Handler Int
 transferForm = areq currencyField (bfs MsgValue) (Just 0)