diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/App.hs | 30 | ||||
| -rw-r--r-- | src/Auth.hs | 24 |
2 files changed, 36 insertions, 18 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 diff --git a/src/Auth.hs b/src/Auth.hs index 6a24360584a2..4962ce50abef 100644 --- a/src/Auth.hs +++ b/src/Auth.hs @@ -3,9 +3,13 @@ -------------------------------------------------------------------------------- module Auth where -------------------------------------------------------------------------------- +import Control.Monad.IO.Class (liftIO) +import Data.String.Conversions (cs) import Database.SQLite.Simple import Utils import Web.Cookie +import Servant +import Servant.Server.Internal.ServerError import qualified Data.UUID as UUID import qualified Web.Cookie as WC @@ -22,9 +26,9 @@ uuidFromCookie (T.SessionCookie cookies) = do uuid <- UUID.fromASCIIBytes auth pure $ T.SessionUUID uuid --- | Attempt to return the user role associated with the `cookie`. -roleFromCookie :: FilePath -> T.SessionCookie -> IO (Maybe T.Role) -roleFromCookie dbFile cookie = withConnection dbFile $ \conn -> do +-- | Attempt to return the account associated with `cookie`. +accountFromCookie :: FilePath -> T.SessionCookie -> IO (Maybe T.Account) +accountFromCookie dbFile cookie = withConnection dbFile $ \conn -> do case uuidFromCookie cookie of Nothing -> pure Nothing Just uuid -> do @@ -35,7 +39,7 @@ roleFromCookie dbFile cookie = withConnection dbFile $ \conn -> do mAccount <- Accounts.lookup dbFile storedSessionUsername case mAccount of Nothing -> pure Nothing - Just T.Account{..} -> pure (Just accountRole) + Just x -> pure (Just x) -- | Create a new session cookie. mkCookie :: T.SessionUUID -> SetCookie @@ -52,3 +56,15 @@ emptyCookie = { setCookieName = "auth" , setCookieValue = "" } + +-- | Throw a 401 error if the `predicate` fails. +assert :: FilePath -> T.SessionCookie -> (T.Account -> Bool) -> Handler a -> Handler a +assert dbFile cookie predicate handler = do + mRole <- liftIO $ accountFromCookie dbFile cookie + case mRole of + Nothing -> throwError err401 { errBody = "Missing valid session cookie" } + Just account -> + if predicate account then + handler + else + throwError err401 { errBody = "You are not authorized to access this resource" } |