summaryrefslogtreecommitdiff
path: root/Hero/Server.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Hero/Server.hs')
-rw-r--r--Hero/Server.hs26
1 files changed, 20 insertions, 6 deletions
diff --git a/Hero/Server.hs b/Hero/Server.hs
index d179cd2..1cbcdd3 100644
--- a/Hero/Server.hs
+++ b/Hero/Server.hs
@@ -324,11 +324,12 @@ publicHandlers =
:<|> discoverHandler
:<|> chooseExperienceHandler
-
instance Auth.ToJWT User
instance Auth.FromJWT User
+-- TODO: get creds from keep
+-- TODO: load initial library for user
checkCreds ::
Auth.CookieSettings ->
Auth.JWTSettings ->
@@ -341,14 +342,27 @@ checkCreds ::
User
)
checkCreds cookieSettings jwtSettings (LoginForm "ben@bsima.me" "test") = do
- -- TODO: get this from keep
- liftIO $ say "successful login"
- let usr = User "ben@bsima.me" "ben" [] -- TODO: load initial library
- mApplyCookies <- liftIO $ Auth.acceptLogin cookieSettings jwtSettings usr
+ applyCreds cookieSettings jwtSettings $ User "ben@bsima.me" "ben" []
+checkCreds cookieSettings jwtSettings (LoginForm "mcovino@heroprojects.io" "test") = do
+ applyCreds cookieSettings jwtSettings $ User "mcovino@heroprojects.io" "mike" []
+checkCreds _ _ _ = throwError err401
+
+applyCreds ::
+ Auth.CookieSettings ->
+ Auth.JWTSettings ->
+ User ->
+ Handler
+ ( Headers
+ '[ Header "Set-Cookie" Auth.SetCookie,
+ Header "Set-Cookie" Auth.SetCookie
+ ]
+ User
+ )
+applyCreds cs jwts usr = do
+ mApplyCookies <- liftIO $ Auth.acceptLogin cs jwts usr
case mApplyCookies of
Nothing -> throwError err401
Just applyCookies -> return $ applyCookies usr
-checkCreds _ _ _ = throwError err401
jsonHandlers :: AcidState Keep.HeroKeep -> Auth.AuthResult User -> Server JsonApi
jsonHandlers keep (Auth.Authenticated user) = Acid.query' keep $ Keep.GetComics 10