diff options
-rw-r--r-- | Hero/Server.hs | 26 |
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 |