diff options
Diffstat (limited to 'Hero/Server.hs')
| -rw-r--r-- | Hero/Server.hs | 142 |
1 files changed, 70 insertions, 72 deletions
diff --git a/Hero/Server.hs b/Hero/Server.hs index 1cbcdd3..cdf89d0 100644 --- a/Hero/Server.hs +++ b/Hero/Server.hs @@ -47,7 +47,10 @@ -- : dep wai-middleware-metrics -- : dep warp -- : dep x509 -module Hero.Server where +module Hero.Server + ( main, + ) +where import Alpha import Biz.App (CSS (..), Manifest (..)) @@ -100,13 +103,16 @@ main = bracket startup shutdown run proxy = Proxy @(AllRoutes '[Auth.JWT]) static = serveDirectoryWith $ defaultWebAppSettings $ heroBeam cfg server = + -- assets, auth, and the homepage is public static :<|> cssHandlers - :<|> (return "hi") - :<|> loginHookHandler cs jwts - :<|> jsonHandlers keep - :<|> publicHandlers :<|> pure heroManifest + :<|> pubHostHandlers + :<|> authHandler cs jwts + -- app and api are private + :<|> wrapAuth (jsonHandlers keep) + :<|> wrapAuth appHostHandlers + -- fall through to 404 :<|> Tagged handle404 return ( cfg, @@ -157,20 +163,47 @@ instance Envy.DefConfig Config where instance Envy.FromEnv Config -- | Convert client side routes into server-side web handlers -type ServerRoutes = ToServerRoutes ClientRoutes Templated Action +type AppHostRoutes = ToServerRoutes AppRoutes Templated Action + +-- | These are the main app handlers, and should require authentication. +appHostHandlers :: User -> Server AppHostRoutes +appHostHandlers _ = + comicCoverHandler + :<|> comicPageHandler + :<|> comicPageFullHandler + :<|> comicVideoHandler + :<|> discoverHandler + :<|> chooseExperienceHandler + +-- | Marketing pages +type PubHostRoutes = ToServerRoutes PubRoutes Templated Action + +pubHostHandlers :: Server PubHostRoutes +pubHostHandlers = + homeHandler :<|> loginHandler type JsonApi = "api" :> "comic" :> Get '[JSON] [Comic] +-- TODO: need a "you're not logged in" page +wrapAuth :: + Auth.ThrowAll route => + (user -> route) -> + Auth.AuthResult user -> + route +wrapAuth f (Auth.Authenticated user) = f user +wrapAuth _ _ = Auth.throwAll err401 + +jsonHandlers :: AcidState Keep.HeroKeep -> User -> Server JsonApi +jsonHandlers keep _ = Acid.query' keep $ Keep.GetComics 10 + type CssRoute = "css" :> "main.css" :> Get '[CSS] Text cssHandlers :: Server CssRoute cssHandlers = return . Lazy.toStrict . Clay.render $ Typography.main <> Look.main -type Ping = "ping" :> Get '[JSON] Text - -type LoginHook = - "login-hook" +type AuthRoute = + "auth" :> ReqBody '[JSON] LoginForm :> Post '[JSON] ( Headers @@ -180,7 +213,15 @@ type LoginHook = User ) -loginHookHandler :: +instance Auth.ToJWT User + +instance Auth.FromJWT User + +-- | Endpoint for performing authentication +-- +-- TODO: get creds from keep +-- TODO: load initial library for user +authHandler :: Auth.CookieSettings -> Auth.JWTSettings -> LoginForm -> @@ -191,17 +232,29 @@ loginHookHandler :: ] User ) -loginHookHandler cs jwts = - checkCreds cs jwts +authHandler cookieSettings jwtSettings loginForm = + case loginForm of + (LoginForm "ben@bsima.me" "test") -> do + applyCreds $ User "ben@bsima.me" "ben" [] + (LoginForm "mcovino@heroprojects.io" "test") -> do + applyCreds $ User "mcovino@heroprojects.io" "mike" [] + _ -> throwError err401 + where + applyCreds usr = do + mApplyCookies <- liftIO $ Auth.acceptLogin cookieSettings jwtSettings usr + case mApplyCookies of + Nothing -> throwError err401 + Just applyCookies -> return $ applyCookies usr +-- | See also 'server' above type AllRoutes auths = ("static" :> Raw) :<|> CssRoute - :<|> Ping - :<|> LoginHook - :<|> (Auth.Auth auths User :> JsonApi) - :<|> ServerRoutes :<|> ("manifest.json" :> Get '[JSON] Manifest) + :<|> PubHostRoutes + :<|> AuthRoute + :<|> (Auth.Auth auths User :> JsonApi) + :<|> (Auth.Auth auths User :> AppHostRoutes) :<|> Raw heroManifest :: Manifest @@ -313,61 +366,6 @@ bulmaRef :: MisoString bulmaRef = "https://cdnjs.cloudflare.com/ajax/libs/bulma/0.7.2/css/bulma.min.css" -publicHandlers :: Server ServerRoutes -publicHandlers = - homeHandler - :<|> comicCoverHandler - :<|> comicPageHandler - :<|> comicPageFullHandler - :<|> comicVideoHandler - :<|> loginHandler - :<|> 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 -> - LoginForm -> - Handler - ( Headers - '[ Header "Set-Cookie" Auth.SetCookie, - Header "Set-Cookie" Auth.SetCookie - ] - User - ) -checkCreds cookieSettings jwtSettings (LoginForm "ben@bsima.me" "test") = do - 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 - -jsonHandlers :: AcidState Keep.HeroKeep -> Auth.AuthResult User -> Server JsonApi -jsonHandlers keep (Auth.Authenticated user) = Acid.query' keep $ Keep.GetComics 10 -jsonHandlers _ _ = Auth.throwAll err401 - homeHandler :: Handler (Templated (View Action)) homeHandler = pure . Templated . home $ initModel homeLink |