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:
parent
ca26fcd523
commit
385164c6af
2 changed files with 39 additions and 21 deletions
36
src/App.hs
36
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." }
|
||||
|
||||
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
|
||||
|
||||
|
|
24
src/Auth.hs
24
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" }
|
||||
|
|
Loading…
Reference in a new issue