Authorize endpoints

If I ever fully learn `servant-auth`, I'll probably recognize how naive this
hand-rolled solution is. But it works! And the code is pretty declarative, which
I like.

1 files changed, 16 insertions, 14 deletions

diff --git a/src/App.hs b/src/App.hs
index 4d9bf22db879..708dd896fab2 100644
--- a/src/App.hs
+++ b/src/App.hs
@@ -47,6 +47,11 @@ server dbFile = createAccount
            :<|> login
            :<|> logout
   where
+    -- Admit Admins + whatever the predicate `p` passes.
+    adminsAnd cookie p = Auth.assert dbFile cookie (\acct@T.Account{..} -> accountRole == T.Admin || p acct)
+    -- Admit Admins only.
+    adminsOnly cookie = adminsAnd cookie (const True)
+
     -- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
     createAccount :: T.CreateAccountRequest -> Handler NoContent
     createAccount request = do
@@ -58,26 +63,23 @@ server dbFile = createAccount
       pure NoContent
 
     deleteAccount :: T.SessionCookie -> Text -> Handler NoContent
-    deleteAccount cookie username = do
-      mRole <- liftIO $ Auth.roleFromCookie dbFile cookie
-      case mRole of
-        Just T.Admin -> do
-          liftIO $ Accounts.delete dbFile (T.Username username)
-          pure NoContent
-        -- cannot delete an account if you're not an Admin
-        _ -> throwError err401 { errBody = "Only admins can delete accounts." }
+    deleteAccount cookie username = adminsOnly cookie $ do
+      liftIO $ Accounts.delete dbFile (T.Username username)
+      pure NoContent
 
     listAccounts :: T.SessionCookie -> Handler [T.User]
-    listAccounts (T.SessionCookie cookie) = liftIO $ Accounts.list dbFile
+    listAccounts cookie = adminsOnly cookie $ do
+      liftIO $ Accounts.list dbFile
 
     createTrip :: T.SessionCookie -> T.Trip -> Handler NoContent
-    createTrip cookie trip = do
-      liftIO $ Trips.create dbFile trip
-      pure NoContent
+    createTrip cookie trip@T.Trip{..} =
+      adminsAnd cookie (\T.Account{..} -> accountUsername == tripUsername) $ do
+        liftIO $ Trips.create dbFile trip
+        pure NoContent
 
-    -- TODO(wpcarro): Validate incoming data like startDate.
     deleteTrip :: T.SessionCookie -> T.TripPK -> Handler NoContent
-    deleteTrip cookie tripPK = do
+    deleteTrip cookie tripPK@T.TripPK{..} =
+      adminsAnd cookie (\T.Account{..} -> accountUsername == tripPKUsername) $ do
       liftIO $ Trips.delete dbFile tripPK
       pure NoContent