Fully support login, logout
Refactor my handlers to use the `Handler a` type instead of `IO a`; this allows me to throwError inside of handlers that Servant properly handles. Previously I was creating 500 errors unnecessarily.
This commit is contained in:
parent
ab12be7840
commit
fdd51f626c
3 changed files with 117 additions and 60 deletions
54
src/Auth.hs
Normal file
54
src/Auth.hs
Normal file
|
|
@ -0,0 +1,54 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Auth where
|
||||
--------------------------------------------------------------------------------
|
||||
import Database.SQLite.Simple
|
||||
import Utils
|
||||
import Web.Cookie
|
||||
|
||||
import qualified Data.UUID as UUID
|
||||
import qualified Web.Cookie as WC
|
||||
import qualified Sessions as Sessions
|
||||
import qualified Accounts as Accounts
|
||||
import qualified Types as T
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | 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 user role associated with the `cookie`.
|
||||
roleFromCookie :: FilePath -> T.SessionCookie -> IO (Maybe T.Role)
|
||||
roleFromCookie dbFile cookie = withConnection dbFile $ \conn -> do
|
||||
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 T.Account{..} -> pure (Just accountRole)
|
||||
|
||||
-- | 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 = ""
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue