Permalink
Browse files

Dedupe lots of auth handling code

  • Loading branch information...
1 parent 118a764 commit 183777a53771a699f88cba95b2a53a93fee5f5ae @samstokes committed Sep 22, 2011
Showing with 36 additions and 49 deletions.
  1. +36 −49 Handler/Root.hs
View
85 Handler/Root.hs
@@ -35,27 +35,26 @@ getRootR = maybeAuthId >>= getRootR' where
getRootR' (Just _) = redirectTemporary TasksR
-getTasksR :: Handler RepHtml
-getTasksR = maybeAuth >>= getTasksR' where
- getTasksR' :: Maybe (UserId, User) -> Handler RepHtml
+authed :: HasReps a => (UserId -> Handler a) -> Handler a
+authed handler = maybeAuthId >>= maybe (redirectTemporary RootR) handler
- getTasksR' Nothing = redirectTemporary RootR
- getTasksR' (Just (userId, user)) = do
- tasks <- runDB $ userTasks userId
+getTasksR :: Handler RepHtml
+getTasksR = authed (\userId -> do
+ tasks <- runDB $ userTasks userId
- estimates <- runDB $ mapM (taskEstimates . fst) tasks
- let tasksEstimates :: [(TaskId, (Task, [(EstimateId, Estimate)]))]
- tasksEstimates = (map fst tasks) `zip` ((map snd tasks) `zip` estimates)
+ estimates <- runDB $ mapM (taskEstimates . fst) tasks
+ let tasksEstimates :: [(TaskId, (Task, [(EstimateId, Estimate)]))]
+ tasksEstimates = (map fst tasks) `zip` ((map snd tasks) `zip` estimates)
- let (done, pending) = partition (taskDone . fst . snd) tasksEstimates
+ let (done, pending) = partition (taskDone . fst . snd) tasksEstimates
- timeZone <- liftIO getCurrentTimeZone
- let doneByDay = groupByEq (fromJust . taskDoneDay timeZone . fst . snd) done
- ((_, taskWidget), enctype) <- generateFormPost taskForm
- defaultLayout $ do
- setTitle "tasks"
- addWidget $(widgetFile "tasks")
+ timeZone <- liftIO getCurrentTimeZone
+ let doneByDay = groupByEq (fromJust . taskDoneDay timeZone . fst . snd) done
+ ((_, taskWidget), enctype) <- generateFormPost taskForm
+ defaultLayout $ do
+ setTitle "tasks"
+ addWidget $(widgetFile "tasks")) where
userTasks userId = selectList [TaskUser ==. userId] [Asc TaskOrder, Desc TaskDoneAt] -- must specify sorts backwards...
taskEstimates taskId = selectList [EstimateTask ==. taskId] []
@@ -75,16 +74,13 @@ taskForm :: Html -> Form Yesodoro Yesodoro (FormResult NewTask, Widget)
taskForm = renderDivs $ NewTask <$> areq textField "Title" Nothing
postTasksR :: Handler RepHtml
-postTasksR = maybeAuthId >>= postTasksR' where
- postTasksR' :: Maybe UserId -> Handler RepHtml
- postTasksR' Nothing = redirectTemporary RootR
- postTasksR' (Just userId) = do
- ((result, taskWidget), _) <- runFormPost taskForm
- case result of
- FormSuccess task -> do
- runDB $ createTaskAtBottom userId task
- redirectTemporary TasksR
- _ -> undefined -- TODO
+postTasksR = authed (\userId -> do
+ ((result, taskWidget), _) <- runFormPost taskForm
+ case result of
+ FormSuccess task -> do
+ runDB $ createTaskAtBottom userId task
+ redirectTemporary TasksR
+ _ -> undefined) -- TODO
postCompleteTaskR :: TaskId -> Handler RepHtml
@@ -96,12 +92,9 @@ postRestartTaskR :: TaskId -> Handler RepHtml
postRestartTaskR = updateAndRedirectR TasksR [TaskDoneAt =. Nothing]
updateAndRedirectR :: HasReps a => YesodoroRoute -> [Update Task] -> TaskId -> Handler a
-updateAndRedirectR route updates taskId = maybeAuthId >>= updateAndRedirectR' route updates taskId where
- updateAndRedirectR' :: HasReps a => YesodoroRoute -> [Update Task] -> TaskId -> Maybe UserId -> Handler a
- updateAndRedirectR' _ _ _ Nothing = redirectTemporary RootR
- updateAndRedirectR' route updates taskId (Just userId) = do
- runDB $ updateWhere [TaskId ==. taskId, TaskUser ==. userId] updates
- redirectTemporary route
+updateAndRedirectR route updates taskId = authed (\userId -> do
+ runDB $ updateWhere [TaskId ==. taskId, TaskUser ==. userId] updates
+ redirectTemporary route)
setTaskDonenessRoute :: (TaskId, Task) -> YesodoroRoute
setTaskDonenessRoute (taskId, task) = route taskId
@@ -124,17 +117,14 @@ postTaskAddPomoR :: TaskId -> Handler RepHtml
postTaskAddPomoR = updateAndRedirectR TasksR [TaskPomos +=. 1]
postTaskAddEstimateR :: TaskId -> Handler RepHtml
-postTaskAddEstimateR taskId = maybeAuthId >>= postTaskAddEstimateR' taskId where
- postTaskAddEstimateR' :: TaskId -> Maybe UserId -> Handler RepHtml
- postTaskAddEstimateR' taskId (Just userId) = do
- authzedTaskId <- checkAuthz userId taskId
- pomosParam <- lookupPostParam "pomos"
- let pomos = do
- param <- maybeToEither "no pomos" $ pomosParam
- (num, _) <- decimal param
- return num
- postTaskAddEstimateR'' authzedTaskId pomos
- postTaskAddEstimateR' _ Nothing = redirectTemporary RootR
+postTaskAddEstimateR taskId = authed (\userId -> do
+ authzedTaskId <- checkAuthz userId taskId
+ pomosParam <- lookupPostParam "pomos"
+ let pomos = do
+ param <- maybeToEither "no pomos" $ pomosParam
+ (num, _) <- decimal param
+ return num
+ postTaskAddEstimateR'' authzedTaskId pomos) where
checkAuthz :: UserId -> TaskId -> Handler (Maybe TaskId)
checkAuthz userId taskId = do
@@ -170,9 +160,6 @@ postLowerTaskR :: TaskId -> Handler RepHtml
postLowerTaskR = reorderTaskR Down
reorderTaskR :: Direction -> TaskId -> Handler RepHtml
-reorderTaskR direction taskId = maybeAuthId >>= reorderTaskR' direction taskId where
- reorderTaskR' :: Direction -> TaskId -> Maybe UserId -> Handler RepHtml
- reorderTaskR' _ _ Nothing = redirectTemporary RootR
- reorderTaskR' direction taskId (Just userId) = do
- runDB $ reorderTask direction [TaskUser ==. userId, TaskId ==. taskId]
- redirectTemporary TasksR
+reorderTaskR direction taskId = authed (\userId -> do
+ runDB $ reorderTask direction [TaskUser ==. userId, TaskId ==. taskId]
+ redirectTemporary TasksR)

0 comments on commit 183777a

Please sign in to comment.