Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Dedupe lots of auth handling code

  • Loading branch information...
commit 183777a53771a699f88cba95b2a53a93fee5f5ae 1 parent 118a764
Sam Stokes authored September 22, 2011

Showing 1 changed file with 36 additions and 49 deletions. Show diff stats Hide diff stats

  1. 85  Handler/Root.hs
85  Handler/Root.hs
@@ -35,27 +35,26 @@ getRootR = maybeAuthId >>= getRootR' where
35 35
   getRootR' (Just _) = redirectTemporary TasksR
36 36
 
37 37
 
38  
-getTasksR :: Handler RepHtml
39  
-getTasksR = maybeAuth >>= getTasksR' where
40  
-  getTasksR' :: Maybe (UserId, User) -> Handler RepHtml
  38
+authed :: HasReps a => (UserId -> Handler a) -> Handler a
  39
+authed handler = maybeAuthId >>= maybe (redirectTemporary RootR) handler
41 40
 
42  
-  getTasksR' Nothing = redirectTemporary RootR
43 41
 
44  
-  getTasksR' (Just (userId, user)) = do
45  
-    tasks <- runDB $ userTasks userId
  42
+getTasksR :: Handler RepHtml
  43
+getTasksR = authed (\userId -> do
  44
+  tasks <- runDB $ userTasks userId
46 45
 
47  
-    estimates <- runDB $ mapM (taskEstimates . fst) tasks
48  
-    let tasksEstimates :: [(TaskId, (Task, [(EstimateId, Estimate)]))]
49  
-        tasksEstimates = (map fst tasks) `zip` ((map snd tasks) `zip` estimates)
  46
+  estimates <- runDB $ mapM (taskEstimates . fst) tasks
  47
+  let tasksEstimates :: [(TaskId, (Task, [(EstimateId, Estimate)]))]
  48
+      tasksEstimates = (map fst tasks) `zip` ((map snd tasks) `zip` estimates)
50 49
 
51  
-    let (done, pending) = partition (taskDone . fst . snd) tasksEstimates
  50
+  let (done, pending) = partition (taskDone . fst . snd) tasksEstimates
52 51
 
53  
-    timeZone <- liftIO getCurrentTimeZone
54  
-    let doneByDay = groupByEq (fromJust . taskDoneDay timeZone . fst . snd) done
55  
-    ((_, taskWidget), enctype) <- generateFormPost taskForm
56  
-    defaultLayout $ do
57  
-        setTitle "tasks"
58  
-        addWidget $(widgetFile "tasks")
  52
+  timeZone <- liftIO getCurrentTimeZone
  53
+  let doneByDay = groupByEq (fromJust . taskDoneDay timeZone . fst . snd) done
  54
+  ((_, taskWidget), enctype) <- generateFormPost taskForm
  55
+  defaultLayout $ do
  56
+      setTitle "tasks"
  57
+      addWidget $(widgetFile "tasks")) where
59 58
 
60 59
   userTasks userId = selectList [TaskUser ==. userId] [Asc TaskOrder, Desc TaskDoneAt] -- must specify sorts backwards...
61 60
   taskEstimates taskId = selectList [EstimateTask ==. taskId] []
@@ -75,16 +74,13 @@ taskForm :: Html -> Form Yesodoro Yesodoro (FormResult NewTask, Widget)
75 74
 taskForm = renderDivs $ NewTask <$> areq textField "Title" Nothing
76 75
 
77 76
 postTasksR :: Handler RepHtml
78  
-postTasksR = maybeAuthId >>= postTasksR' where
79  
-  postTasksR' :: Maybe UserId -> Handler RepHtml
80  
-  postTasksR' Nothing = redirectTemporary RootR
81  
-  postTasksR' (Just userId) = do
82  
-    ((result, taskWidget), _) <- runFormPost taskForm
83  
-    case result of
84  
-      FormSuccess task -> do
85  
-        runDB $ createTaskAtBottom userId task
86  
-        redirectTemporary TasksR
87  
-      _ -> undefined -- TODO
  77
+postTasksR = authed (\userId -> do
  78
+  ((result, taskWidget), _) <- runFormPost taskForm
  79
+  case result of
  80
+    FormSuccess task -> do
  81
+      runDB $ createTaskAtBottom userId task
  82
+      redirectTemporary TasksR
  83
+    _ -> undefined) -- TODO
88 84
 
89 85
 
90 86
 postCompleteTaskR :: TaskId -> Handler RepHtml
@@ -96,12 +92,9 @@ postRestartTaskR :: TaskId -> Handler RepHtml
96 92
 postRestartTaskR = updateAndRedirectR TasksR [TaskDoneAt =. Nothing]
97 93
 
98 94
 updateAndRedirectR :: HasReps a => YesodoroRoute -> [Update Task] -> TaskId -> Handler a
99  
-updateAndRedirectR route updates taskId = maybeAuthId >>= updateAndRedirectR' route updates taskId where
100  
-  updateAndRedirectR' :: HasReps a => YesodoroRoute -> [Update Task] -> TaskId -> Maybe UserId -> Handler a
101  
-  updateAndRedirectR' _ _ _ Nothing = redirectTemporary RootR
102  
-  updateAndRedirectR' route updates taskId (Just userId) = do
103  
-    runDB $ updateWhere [TaskId ==. taskId, TaskUser ==. userId] updates
104  
-    redirectTemporary route
  95
+updateAndRedirectR route updates taskId = authed (\userId -> do
  96
+  runDB $ updateWhere [TaskId ==. taskId, TaskUser ==. userId] updates
  97
+  redirectTemporary route)
105 98
 
106 99
 setTaskDonenessRoute :: (TaskId, Task) -> YesodoroRoute
107 100
 setTaskDonenessRoute (taskId, task) = route taskId
@@ -124,17 +117,14 @@ postTaskAddPomoR :: TaskId -> Handler RepHtml
124 117
 postTaskAddPomoR = updateAndRedirectR TasksR [TaskPomos +=. 1]
125 118
 
126 119
 postTaskAddEstimateR :: TaskId -> Handler RepHtml
127  
-postTaskAddEstimateR taskId = maybeAuthId >>= postTaskAddEstimateR' taskId where
128  
-  postTaskAddEstimateR' :: TaskId -> Maybe UserId -> Handler RepHtml
129  
-  postTaskAddEstimateR' taskId (Just userId) = do
130  
-    authzedTaskId <- checkAuthz userId taskId
131  
-    pomosParam <- lookupPostParam "pomos"
132  
-    let pomos = do
133  
-        param <- maybeToEither "no pomos" $ pomosParam
134  
-        (num, _) <- decimal param
135  
-        return num
136  
-    postTaskAddEstimateR'' authzedTaskId pomos
137  
-  postTaskAddEstimateR' _ Nothing = redirectTemporary RootR
  120
+postTaskAddEstimateR taskId = authed (\userId -> do
  121
+  authzedTaskId <- checkAuthz userId taskId
  122
+  pomosParam <- lookupPostParam "pomos"
  123
+  let pomos = do
  124
+      param <- maybeToEither "no pomos" $ pomosParam
  125
+      (num, _) <- decimal param
  126
+      return num
  127
+  postTaskAddEstimateR'' authzedTaskId pomos) where
138 128
 
139 129
   checkAuthz :: UserId -> TaskId -> Handler (Maybe TaskId)
140 130
   checkAuthz userId taskId = do
@@ -170,9 +160,6 @@ postLowerTaskR :: TaskId -> Handler RepHtml
170 160
 postLowerTaskR = reorderTaskR Down
171 161
 
172 162
 reorderTaskR :: Direction -> TaskId -> Handler RepHtml
173  
-reorderTaskR direction taskId = maybeAuthId >>= reorderTaskR' direction taskId where
174  
-  reorderTaskR' :: Direction -> TaskId -> Maybe UserId -> Handler RepHtml
175  
-  reorderTaskR' _ _ Nothing = redirectTemporary RootR
176  
-  reorderTaskR' direction taskId (Just userId) = do
177  
-    runDB $ reorderTask direction [TaskUser ==. userId, TaskId ==. taskId]
178  
-    redirectTemporary TasksR
  163
+reorderTaskR direction taskId = authed (\userId -> do
  164
+  runDB $ reorderTask direction [TaskUser ==. userId, TaskId ==. taskId]
  165
+  redirectTemporary TasksR)

0 notes on commit 183777a

Please sign in to comment.
Something went wrong with that request. Please try again.