From c2827b0560082f5499c178ead746e7ff9448dd64 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Fri, 24 Jul 2020 23:39:21 -0700
Subject: hero: working authenticated api calls

---
 Hero/Host.hs | 21 +++++++++++++++------
 1 file changed, 15 insertions(+), 6 deletions(-)

(limited to 'Hero/Host.hs')

diff --git a/Hero/Host.hs b/Hero/Host.hs
index fc31c39..267d475 100644
--- a/Hero/Host.hs
+++ b/Hero/Host.hs
@@ -61,8 +61,8 @@ import qualified Data.Acid.Abstract as Acid
 import qualified Data.Aeson as Aeson
 import Data.Text (Text)
 import qualified Data.Text.Lazy as Lazy
-import Hero.Core
 import qualified Hero.Assets as Assets
+import Hero.Core
 import qualified Hero.Keep as Keep
 import qualified Hero.Look as Look
 import qualified Hero.Look.Typography as Typography
@@ -98,9 +98,14 @@ main = bracket startup shutdown run
           prn $ "node: " ++ heroNode cfg
           prn $ "skey: " ++ heroSkey cfg
           let jwts = Auth.defaultJWTSettings skey
-              cs = Auth.defaultCookieSettings
+              cs =
+                Auth.defaultCookieSettings
+                  { -- uncomment this for insecure dev
+                    Auth.cookieIsSecure = Auth.NotSecure,
+                    Auth.cookieXsrfSetting = Nothing
+                  }
               ctx = cs :. jwts :. EmptyContext
-              proxy = Proxy @(AllRoutes '[Auth.JWT])
+              proxy = Proxy @(AllRoutes '[Auth.JWT, Auth.Cookie])
               static = serveDirectoryWith $ defaultWebAppSettings $ heroNode cfg
               server =
                 -- assets, auth, and the homepage is public
@@ -168,7 +173,8 @@ type AppHostRoutes = ToServerRoutes AppRoutes Templated Action
 -- | These are the main app handlers, and should require authentication.
 appHostHandlers :: User -> Server AppHostRoutes
 appHostHandlers _ =
-  comicCoverHandler
+  homeHandler
+    :<|> comicCoverHandler
     :<|> comicPageHandler
     :<|> comicPageFullHandler
     :<|> comicVideoHandler
@@ -190,8 +196,11 @@ wrapAuth ::
   (user -> route) ->
   Auth.AuthResult user ->
   route
-wrapAuth f (Auth.Authenticated user) = f user
-wrapAuth _ _ = Auth.throwAll err401
+wrapAuth f authResult = case authResult of
+  Auth.Authenticated user -> f user
+  Auth.BadPassword -> Auth.throwAll err401
+  Auth.NoSuchUser -> Auth.throwAll err406
+  Auth.Indefinite -> Auth.throwAll err422
 
 jsonHandlers :: AcidState Keep.HeroKeep -> User -> Server JsonApi
 jsonHandlers keep _ = Acid.query' keep $ Keep.GetComics 10
-- 
cgit v1.2.3