tvl-depot/users/wpcarro/assessments/tt/src/Auth.hs
Vincent Ambo 019f8fd211 subtree(users/wpcarro): docking briefcase at '24f5a642'
git-subtree-dir: users/wpcarro
git-subtree-mainline: 464bbcb15c
git-subtree-split: 24f5a642af
Change-Id: I6105b3762b79126b3488359c95978cadb3efa789
2021-12-14 02:15:47 +03:00

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