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.
This commit is contained in:
William Carroll 2020-07-30 10:23:55 +01:00
parent ca26fcd523
commit 385164c6af
2 changed files with 39 additions and 21 deletions

View file

@ -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." }
listAccounts :: T.SessionCookie -> Handler [T.User]
listAccounts (T.SessionCookie cookie) = liftIO $ Accounts.list dbFile
createTrip :: T.SessionCookie -> T.Trip -> Handler NoContent
createTrip cookie trip = do
liftIO $ Trips.create dbFile trip
deleteAccount cookie username = adminsOnly cookie $ do
liftIO $ Accounts.delete dbFile (T.Username username)
pure NoContent
-- TODO(wpcarro): Validate incoming data like startDate.
listAccounts :: T.SessionCookie -> Handler [T.User]
listAccounts cookie = adminsOnly cookie $ do
liftIO $ Accounts.list dbFile
createTrip :: T.SessionCookie -> T.Trip -> Handler NoContent
createTrip cookie trip@T.Trip{..} =
adminsAnd cookie (\T.Account{..} -> accountUsername == tripUsername) $ do
liftIO $ Trips.create dbFile trip
pure NoContent
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

View file

@ -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" }