019f8fd211
git-subtree-dir: users/wpcarro git-subtree-mainline:464bbcb15c
git-subtree-split:24f5a642af
Change-Id: I6105b3762b79126b3488359c95978cadb3efa789
64 lines
2.2 KiB
Haskell
64 lines
2.2 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
--------------------------------------------------------------------------------
|
|
module Auth where
|
|
--------------------------------------------------------------------------------
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Web.Cookie
|
|
import Servant
|
|
|
|
import qualified Data.UUID as UUID
|
|
import qualified Sessions as Sessions
|
|
import qualified Accounts as Accounts
|
|
import qualified Types as T
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Return the UUID from a Session cookie.
|
|
uuidFromCookie :: T.SessionCookie -> Maybe T.SessionUUID
|
|
uuidFromCookie (T.SessionCookie cookies) = do
|
|
auth <- lookup "auth" cookies
|
|
uuid <- UUID.fromASCIIBytes auth
|
|
pure $ T.SessionUUID uuid
|
|
|
|
-- | Attempt to return the account associated with `cookie`.
|
|
accountFromCookie :: FilePath -> T.SessionCookie -> IO (Maybe T.Account)
|
|
accountFromCookie dbFile cookie =
|
|
case uuidFromCookie cookie of
|
|
Nothing -> pure Nothing
|
|
Just uuid -> do
|
|
mSession <- Sessions.get dbFile uuid
|
|
case mSession of
|
|
Nothing -> pure Nothing
|
|
Just T.StoredSession{..} -> do
|
|
mAccount <- Accounts.lookup dbFile storedSessionUsername
|
|
case mAccount of
|
|
Nothing -> pure Nothing
|
|
Just x -> pure (Just x)
|
|
|
|
-- | Create a new session cookie.
|
|
mkCookie :: T.SessionUUID -> SetCookie
|
|
mkCookie (T.SessionUUID uuid) =
|
|
defaultSetCookie
|
|
{ setCookieName = "auth"
|
|
, setCookieValue = UUID.toASCIIBytes uuid
|
|
}
|
|
|
|
-- | Use this to clear out the session cookie.
|
|
emptyCookie :: SetCookie
|
|
emptyCookie =
|
|
defaultSetCookie
|
|
{ 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" }
|