hero: implement the basics of user logins

There's also a lot of refactoring/renaming in here, so the diff is really messy.
The overall problem is that I've only ever added code, I've never gone back and
reorganized/rearchitected stuff. So adding even small features is becoming an
enormous effort.

Anyway, this adds the basics of user auth. Next I need to add the auth checks
for every route that needs it, and make sure everything is back to working
correctly.

4 files changed, 367 insertions, 219 deletions

diff --git a/Hero/App.hs b/Hero/App.hs
index 418993d..9391eac 100644
--- a/Hero/App.hs
+++ b/Hero/App.hs
@@ -35,37 +35,22 @@ import Hero.Look as Look
 import Hero.Look.Typography
 import Miso
 import qualified Miso (for_)
+import Miso.Extend
 import Miso.String
 import Network.RemoteData
 import Servant.API
   ( (:<|>) (..),
     (:>),
-    Capture,
-    ToHttpApiData,
-    FromHttpApiData,
-    URI (..),
-    safeLink,
   )
+import qualified Servant.API as Api
 import Servant.Links (linkURI)
 
-crossorigin_ :: MisoString -> Attribute action
-crossorigin_ = textProp "crossorigin"
-
 -- | The css id for controling music in the comic player.
 audioId :: MisoString
 audioId = "audioSource"
 
--- | Like 'onClick' but prevents the default action from triggering. Use this to
--- overide 'a_' links, for example.
-onPreventClick :: Action -> Attribute Action
-onPreventClick action =
-  onWithOptions
-    Miso.defaultOptions {preventDefault = True}
-    "click"
-    emptyDecoder
-    (\() -> action)
-
--- TODO: make ComicId a hashid https://hackage.haskell.org/package/hashids-1.0.2.4/docs/Web-Hashids.html
+-- TODO: make ComicId a hashid
+-- https://hackage.haskell.org/package/hashids-1.0.2.4/docs/Web-Hashids.html
 newtype ComicId
   = ComicId String
   deriving
@@ -77,8 +62,8 @@ newtype ComicId
       Generic,
       ToMisoString,
       IsString,
-      ToHttpApiData,
-      FromHttpApiData
+      Api.ToHttpApiData,
+      Api.FromHttpApiData
     )
 
 instance ToJSON ComicId where
@@ -98,6 +83,8 @@ instance CanSnakeCase Text where
 comicSlug :: Comic -> Text
 comicSlug Comic {..} = snake comicName <> "-" <> comicIssue
 
+-- * user
+
 data User
   = User
       { userEmail :: Text,
@@ -107,10 +94,11 @@ data User
   deriving (Show, Eq, Generic, Data, Ord)
 
 instance Semigroup User where
-  a <> b = User
-    (userEmail a <> userEmail b)
-    (userName a <> userName b)
-    (userLibrary a <> userLibrary b)
+  a <> b =
+    User
+      (userEmail a <> userEmail b)
+      (userName a <> userName b)
+      (userLibrary a <> userLibrary b)
 
 instance Monoid User where
   mempty = User mempty mempty mempty
@@ -121,23 +109,6 @@ instance ToJSON User where
 instance FromJSON User where
   parseJSON = genericParseJSON Data.Aeson.defaultOptions
 
-data Comic
-  = Comic
-      { comicId :: ComicId,
-        comicPages :: Integer,
-        comicName :: Text,
-        -- | Ideally this would be a dynamic number-like type
-        comicIssue :: Text,
-        comicDescription :: Text
-      }
-  deriving (Show, Eq, Generic, Data, Ord)
-
-instance ToJSON Comic where
-  toJSON = genericToJSON Data.Aeson.defaultOptions
-
-instance FromJSON Comic where
-  parseJSON = genericParseJSON Data.Aeson.defaultOptions
-
 -- | Class for rendering media objects in different ways.
 class IsMediaObject o where
   -- | Render a thumbnail for use in a shelf, or otherwise.
@@ -149,74 +120,8 @@ class IsMediaObject o where
   -- | Media info view
   info :: o -> User -> View Action
 
-instance IsMediaObject Comic where
-  thumbnail c@Comic {..} =
-    li_
-      []
-      [ a_
-          [ class_ "comic grow clickable",
-            id_ $ "comic-" <> ms comicId,
-            onClick $ SetMediaInfo $ Just c
-          ]
-          [ img_ [src_ $ ms $ Assets.demo <> comicSlug c <> ".png"],
-            span_ [] [text $ "Issue #" <> ms comicIssue],
-            span_ [] [text $ ms comicName]
-          ]
-      ]
-  feature comic lib =
-    div_
-      [id_ "featured-comic"]
-      [ img_ [id_ "featured-banner", src_ $ ms $ Assets.demo <> "feature-banner.png"],
-        div_
-          [id_ "featured-content"]
-          [ div_
-              [class_ "hero-original", css wide]
-              [ span_ [css thicc] [text "Herø"],
-                span_ [css euro] [text " Original"]
-              ],
-            div_
-              [class_ "comic-logo"]
-              [img_ [src_ $ ms $ Assets.demo <> comicSlug comic <> "-logo.png"]],
-            div_ [class_ "comic-action-menu"] $ el <$> [Watch comic, Read comic, Save comic lib],
-            p_
-              [class_ "description"]
-              [ text . ms $ comicDescription comic
-              ]
-          ]
-      ]
-  info c@Comic {..} lib =
-    div_
-      [class_ "media-info", css euro]
-      [ div_
-          [class_ "media-info-meta"]
-          [ column [img_ [src_ $ ms $ Assets.demo <> "dmc-widethumb.png"]],
-            column
-              [ span_ [style_ title] [text $ ms comicName],
-                span_ [style_ subtitle] [text $ "Issue #" <> ms comicIssue],
-                span_ [] [text "Released: "],
-                span_ [] [text $ "Pages: " <> ms (show comicPages :: String)]
-              ]
-          ],
-        div_
-          [class_ "media-info-summary"]
-          [ p_
-              [style_ $ uppercase <> bold <> Look.expanded <> "font-size" =: ".8rem"]
-              [text "Summary"],
-            p_ [] [text $ ms comicDescription]
-          ],
-        div_ [class_ "media-info-actions"] $ el <$> [Save c lib, Read c, Watch c]
-        -- , row [ text "credits" ]
-      ]
-    where
-      title =
-        "color" =: "red" <> "font-size" =: "1.6rem" <> uppercase
-          <> "line-height"
-            =: "100%"
-          <> Look.condensed
-          <> bold
-      subtitle = "color" =: "#fff" <> "font-size" =: "1.2rem" <> bold <> Look.condensed
-
-type ZoomModel = Int
+-- | How much to Zoom the comic image
+type Magnification = Int
 
 -- | All the buttons.
 data Button
@@ -224,7 +129,7 @@ data Button
   | Read Comic
   | Save Comic User
   | SaveIcon Comic User
-  | ZoomIcon ZoomModel Comic Page
+  | ZoomIcon Magnification Comic Page
   | PlayPause MisoString AudioState
   | Arrow Action
 
@@ -336,17 +241,17 @@ findComic id = List.find (\c -> comicId c == id)
 -- discover, 'cp' for comic player.
 data Model
   = Model
-      { uri :: URI,
+      { uri :: Api.URI,
         appComics :: RemoteData MisoString [Comic],
         user :: User,
         dMediaInfo :: Maybe Comic,
         cpState :: ComicReaderState,
         cpAudioState :: AudioState,
-        zoomModel :: ZoomModel
+        magnification :: Magnification
       }
   deriving (Show, Eq)
 
-initModel :: URI -> Model
+initModel :: Api.URI -> Model
 initModel uri_ =
   Model
     { uri = uri_,
@@ -355,12 +260,12 @@ initModel uri_ =
       user = mempty,
       cpState = detectPlayerState uri_,
       cpAudioState = Paused,
-      zoomModel = 100
+      magnification = 100
     }
 
--- | Hacky way to initialize the 'ComicReaderState' from the URI.
-detectPlayerState :: URI -> ComicReaderState
-detectPlayerState u = case List.splitOn "/" $ uriPath u of
+-- | Hacky way to initialize the 'ComicReaderState' from the Api.URI.
+detectPlayerState :: Api.URI -> ComicReaderState
+detectPlayerState u = case List.splitOn "/" $ Api.uriPath u of
   ["", "comic", id, pg, "experience"] -> ChooseExperience (ComicId id) (toPage pg)
   ["", "comic", id, _, "video"] -> Watching $ ComicId id
   ["", "comic", id, pg, "full"] -> Reading Full (ComicId id) (toPage pg)
@@ -388,10 +293,12 @@ data Action
   | -- discover stuff
     SetMediaInfo (Maybe Comic)
   | ToggleInLibrary Comic
+  | -- login
+    ValidateUserPassword
   | -- app stuff
     ScrollIntoView MisoString
-  | HandleURI URI
-  | ChangeURI URI
+  | HandleURI Api.URI
+  | ChangeURI Api.URI
   | DumpModel
   deriving (Show, Eq)
 
@@ -427,7 +334,7 @@ routes = Proxy
 --   proxy :: Proxy name
 --   proxy = Proxy name
 --   view :: Model -> View Action
---   link :: URI
+--   link :: Api.URI
 
 -- * home
 
@@ -440,19 +347,26 @@ homeProxy = Proxy
 home :: Model -> View Action
 home = login
 
-homeLink :: URI
-homeLink = linkURI $ safeLink routes homeProxy
+homeLink :: Api.URI
+homeLink = linkURI $ Api.safeLink routes homeProxy
 
 -- * login
 
+data LoginForm = LoginForm {loginEmail :: String, loginPass :: String}
+  deriving (Eq, Show, Read, Generic)
+
+instance ToJSON LoginForm
+
+instance FromJSON LoginForm
+
 type Login =
   "login" :> View Action
 
 loginProxy :: Proxy Login
 loginProxy = Proxy
 
-loginLink :: URI
-loginLink = linkURI $ safeLink routes loginProxy
+loginLink :: Api.URI
+loginLink = linkURI $ Api.safeLink routes loginProxy
 
 login :: Model -> View Action
 login _ =
@@ -467,8 +381,8 @@ login _ =
           hr_ [class_ fadeIn],
           form_
             [class_ fadeIn]
-            [ ctrl [class_ "input", type_ "email", placeholder_ "Email"],
-              ctrl [class_ "input", type_ "password", placeholder_ "Password"],
+            [ ctrl [id_ "user", class_ "input", type_ "email", placeholder_ "Email"],
+              ctrl [id_ "pass", class_ "input", type_ "password", placeholder_ "Password"],
               div_
                 [class_ "action", css euro]
                 [ div_
@@ -477,7 +391,7 @@ login _ =
                       label_ [Miso.for_ "checkbox"] [text "Remember Me"]
                     ],
                   div_
-                    [class_ "button is-black", onClick $ ChangeURI discoverLink]
+                    [class_ "button is-black", onClick ValidateUserPassword]
                     [text "Login"]
                 ]
             ],
@@ -502,8 +416,8 @@ login _ =
 
 type Discover = "discover" :> View Action
 
-discoverLink :: URI
-discoverLink = linkURI $ safeLink routes discoverProxy
+discoverLink :: Api.URI
+discoverLink = linkURI $ Api.safeLink routes discoverProxy
 
 discoverProxy :: Proxy Discover
 discoverProxy = Proxy
@@ -566,9 +480,102 @@ discoverFooter =
 
 -- * comic
 
+data Comic
+  = Comic
+      { comicId :: ComicId,
+        comicPages :: Integer,
+        comicName :: Text,
+        -- | Ideally this would be a dynamic number-like type
+        comicIssue :: Text,
+        comicDescription :: Text
+      }
+  deriving (Show, Eq, Generic, Data, Ord)
+
+instance ToJSON Comic where
+  toJSON = genericToJSON Data.Aeson.defaultOptions
+
+instance FromJSON Comic where
+  parseJSON = genericParseJSON Data.Aeson.defaultOptions
+
+instance IsMediaObject Comic where
+  thumbnail c@Comic {..} =
+    li_
+      []
+      [ a_
+          [ class_ "comic grow clickable",
+            id_ $ "comic-" <> ms comicId,
+            onClick $ SetMediaInfo $ Just c
+          ]
+          [ img_ [src_ $ ms $ Assets.demo <> comicSlug c <> ".png"],
+            span_ [] [text $ "Issue #" <> ms comicIssue],
+            span_ [] [text $ ms comicName]
+          ]
+      ]
+  feature comic lib =
+    div_
+      [id_ "featured-comic"]
+      [ img_
+          [ id_ "featured-banner",
+            src_ $ ms $ Assets.demo <> "feature-banner.png"
+          ],
+        div_
+          [id_ "featured-content"]
+          [ div_
+              [class_ "hero-original", css wide]
+              [ span_ [css thicc] [text "Herø"],
+                span_ [css euro] [text " Original"]
+              ],
+            div_
+              [class_ "comic-logo"]
+              [ img_
+                  [ src_
+                      $ ms
+                      $ Assets.demo <> comicSlug comic <> "-logo.png"
+                  ]
+              ],
+            div_ [class_ "comic-action-menu"] $
+              el <$> [Watch comic, Read comic, Save comic lib],
+            p_
+              [class_ "description"]
+              [ text . ms $ comicDescription comic
+              ]
+          ]
+      ]
+  info c@Comic {..} lib =
+    div_
+      [class_ "media-info", css euro]
+      [ div_
+          [class_ "media-info-meta"]
+          [ column [img_ [src_ $ ms $ Assets.demo <> "dmc-widethumb.png"]],
+            column
+              [ span_ [style_ title] [text $ ms comicName],
+                span_ [style_ subtitle] [text $ "Issue #" <> ms comicIssue],
+                span_ [] [text "Released: "],
+                span_ [] [text $ "Pages: " <> ms (show comicPages :: String)]
+              ]
+          ],
+        div_
+          [class_ "media-info-summary"]
+          [ p_
+              [style_ $ uppercase <> bold <> Look.expanded <> "font-size" =: ".8rem"]
+              [text "Summary"],
+            p_ [] [text $ ms comicDescription]
+          ],
+        div_ [class_ "media-info-actions"] $ el <$> [Save c lib, Read c, Watch c]
+        -- , row [ text "credits" ]
+      ]
+    where
+      title =
+        "color" =: "red" <> "font-size" =: "1.6rem" <> uppercase
+          <> "line-height"
+            =: "100%"
+          <> Look.condensed
+          <> bold
+      subtitle = "color" =: "#fff" <> "font-size" =: "1.2rem" <> bold <> Look.condensed
+
 type ComicCover =
   "comic"
-    :> Capture "comicId" ComicId
+    :> Api.Capture "comicId" ComicId
     :> View Action
 
 comicProxy :: Proxy ComicCover
@@ -577,24 +584,24 @@ comicProxy = Proxy
 comicCover :: ComicId -> Model -> View Action
 comicCover comicId_ = comicReader comicId_ 1
 
-comicLink :: ComicId -> URI
-comicLink comicId_ = linkURI $ safeLink routes comicProxy comicId_
+comicLink :: ComicId -> Api.URI
+comicLink comicId_ = linkURI $ Api.safeLink routes comicProxy comicId_
 
 -- * chooseExperience
 
 type ChooseExperience =
   "comic"
-    :> Capture "id" ComicId
-    :> Capture "page" Page
+    :> Api.Capture "id" ComicId
+    :> Api.Capture "page" Page
     :> "experience"
     :> View Action
 
 chooseExperienceProxy :: Proxy ChooseExperience
 chooseExperienceProxy = Proxy
 
-chooseExperienceLink :: ComicId -> Page -> URI
+chooseExperienceLink :: ComicId -> Page -> Api.URI
 chooseExperienceLink id page =
-  linkURI $ safeLink routes chooseExperienceProxy id page
+  linkURI $ Api.safeLink routes chooseExperienceProxy id page
 
 chooseExperiencePage :: Comic -> Page -> Model -> View Action
 chooseExperiencePage comic page model =
@@ -641,7 +648,6 @@ dark, energetic or dramatic. Feeling indecisive? Let us navigate your journey
 with the original curated music for this piece of visual art.
 |]
 
-
 -- * comicReader
 
 data ComicReaderView = Spread | Full
@@ -683,21 +689,20 @@ zoomScreen comic page model =
         <> padLeft page
         <> ".png"
 
-
 -- * comicReaderSpread
 
 type ComicReaderSpread =
   "comic"
-    :> Capture "id" ComicId
-    :> Capture "page" Page
+    :> Api.Capture "id" ComicId
+    :> Api.Capture "page" Page
     :> View Action
 
 comicReaderSpreadProxy :: Proxy ComicReaderSpread
 comicReaderSpreadProxy = Proxy
 
-comicReaderSpreadLink :: ComicId -> Page -> URI
+comicReaderSpreadLink :: ComicId -> Page -> Api.URI
 comicReaderSpreadLink id page =
-  linkURI $ safeLink routes comicReaderSpreadProxy id page
+  linkURI $ Api.safeLink routes comicReaderSpreadProxy id page
 
 comicSpread :: Comic -> Page -> Model -> View Action
 comicSpread comic page model =
@@ -741,33 +746,33 @@ closeButton =
 
 type ComicReaderFull =
   "comic"
-    :> Capture "id" ComicId
-    :> Capture "page" Page
+    :> Api.Capture "id" ComicId
+    :> Api.Capture "page" Page
     :> "full"
     :> View Action
 
 comicReaderFullProxy :: Proxy ComicReaderFull
 comicReaderFullProxy = Proxy
 
-comicReaderFullLink :: ComicId -> Page -> URI
+comicReaderFullLink :: ComicId -> Page -> Api.URI
 comicReaderFullLink id page =
-  linkURI $ safeLink routes comicReaderFullProxy id page
+  linkURI $ Api.safeLink routes comicReaderFullProxy id page
 
 -- * comicVideo
 
 type ComicVideo =
   "comic"
-    :> Capture "id" ComicId
-    :> Capture "page" Page
+    :> Api.Capture "id" ComicId
+    :> Api.Capture "page" Page
     :> "video"
     :> View Action
 
 comicVideoProxy :: Proxy ComicVideo
 comicVideoProxy = Proxy
 
-comicVideoLink :: ComicId -> Page -> URI
+comicVideoLink :: ComicId -> Page -> Api.URI
 comicVideoLink id page =
-  linkURI $ safeLink routes comicVideoProxy id page
+  linkURI $ Api.safeLink routes comicVideoProxy id page
 
 frameborder_ :: MisoString -> Attribute action
 frameborder_ = textProp "frameborder"
@@ -794,7 +799,6 @@ comicVideo _ _ _ =
         ]
     ]
 
-
 -- * general page components & utils
 
 -- | If 'View' had a 'Monoid' instance, then '(text "")' could just be 'mempty'
@@ -886,7 +890,7 @@ comicControls comic page model =
       div_
         [class_ "comic-controls-share"]
         [ el $ SaveIcon comic $ user model,
-          el $ ZoomIcon (zoomModel model) comic page,
+          el $ ZoomIcon (magnification model) comic page,
           button_
             [class_ "button icon is-large", onClick ToggleFullscreen]
             [i_ [class_ "fa fa-expand"] []]
@@ -928,6 +932,5 @@ column :: [View Action] -> View Action
 column = div_ [css $ Clay.display Clay.flex <> Clay.flexDirection Clay.column]
 
 -- | Links
-
 the404 :: Model -> View Action
 the404 _ = template "404" [p_ [] [text "Not found"]]
diff --git a/Hero/Client.hs b/Hero/Client.hs
index 2b222bd..06a7eab 100644
--- a/Hero/Client.hs
+++ b/Hero/Client.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NoImplicitPrelude #-}
@@ -18,9 +19,12 @@
 -- : dep ghcjs-base
 module Hero.Client where
 
+import Alpha
+import Biz.Auth as Auth
 import Data.Aeson (eitherDecodeStrict)
 import qualified Data.Set as Set
 import qualified GHC.Show as Legacy
+import GHCJS.Types (JSVal)
 import Hero.App
   ( Action (..),
     AudioState (..),
@@ -34,18 +38,13 @@ import Hero.App
     comicReaderFullLink,
     comicReaderSpreadLink,
     comicVideoLink,
+    discoverLink,
     handlers,
     initModel,
     routes,
     the404,
   )
-import JavaScript.Web.XMLHttpRequest
-  ( Method (GET),
-    Request (..),
-    RequestData (NoData),
-    contents,
-    xhrByteString,
-  )
+import JavaScript.Web.XMLHttpRequest as Ajax
 import Miso
 import Miso.Effect.DOM (scrollIntoView)
 import qualified Miso.FFI.Audio as Audio
@@ -66,7 +65,7 @@ main = miso $ \currentURI -> App {model = initModel currentURI, ..}
         keyboardSub keynav
       ]
     events = defaultEvents
-    initialAction = FetchComics
+    initialAction = NoOp
     mountPoint = Nothing
 
 (∈) :: Ord a => a -> Set a -> Bool
@@ -75,8 +74,8 @@ main = miso $ \currentURI -> App {model = initModel currentURI, ..}
 -- | Keyboard navigation - maps keys to actions.
 keynav :: Set Int -> Action
 keynav ks
-  | 37 ∈ ks = PrevPage -- left arrow
-  | 39 ∈ ks = NextPage -- right arrow
+  | 37 ∈ ks = PrevPage -- ←
+  | 39 ∈ ks = NextPage -- →
   | 191 ∈ ks = DumpModel -- ?
   | 32 ∈ ks = ToggleAudio audioId -- SPC
   | otherwise = NoOp
@@ -89,13 +88,16 @@ see model =
 
 -- | Console-logging
 foreign import javascript unsafe "console.log($1);"
-  say :: MisoString -> IO ()
+  jslog :: MisoString -> IO ()
+
+foreign import javascript unsafe "$1.value"
+  getValue :: JSVal -> IO MisoString
 
 -- | Updates model, optionally introduces side effects
 move :: Action -> Model -> Effect Action Model
 move NoOp model = noEff model
 move DumpModel model = model <# do
-  say $ ms $ Legacy.show model
+  jslog $ ms $ Legacy.show model
   pure NoOp
 move (SelectExperience comic) model = model {cpState = ChooseExperience (comicId comic) 1}
   <# do pure $ ChangeURI $ chooseExperienceLink (comicId comic) 1
@@ -133,7 +135,7 @@ move (ToggleZoom c pg) m = m {cpState = newState} <# pure act
       x -> (x, NoOp)
 move (ToggleInLibrary c) model = model {user = newUser} <# pure NoOp
   where
-    newUser = (user model) { userLibrary = newLib }
+    newUser = (user model) {userLibrary = newLib}
     newLib
       | c `elem` (userLibrary $ user model) =
         Protolude.filter (/= c) $ userLibrary $ user model
@@ -171,27 +173,79 @@ move (SetMediaInfo x) model = model {dMediaInfo = x}
     Nothing ->
       pure NoOp
 move (ScrollIntoView id) model = model <# do
-  say $ ms $ Legacy.show id
+  jslog $ ms $ Legacy.show id
   scrollIntoView id
   pure NoOp
+move ValidateUserPassword model =
+  batchEff
+    model
+    [doLogin, (SetComics </ fetchComics)]
+  where
+    doLogin = do
+      user <- getValue =<< Document.getElementById "user"
+      pass <- getValue =<< Document.getElementById "pass"
+      jslog "sending login"
+      sendLogin (ms user) (ms pass) >>= \case
+        Network.Success user -> do
+          jslog "successful login"
+          pure $ ChangeURI discoverLink
+        -- TODO: handle these error cases
+        Network.Loading -> pure NoOp
+        Network.Failure _ -> pure NoOp
+        Network.NotAsked -> pure NoOp
 
 fetchComics :: IO (Network.RemoteData MisoString [Comic])
-fetchComics = do
-  mjson <- contents <$> xhrByteString req
-  case mjson of
-    Nothing ->
-      pure $ Network.Failure "Could not fetch comics from server."
-    Just json ->
-      pure $ Network.fromEither
-        $ either (Left . ms) pure
-        $ eitherDecodeStrict json
+fetchComics = Ajax.xhrByteString req /> Ajax.contents >>= \case
+  Nothing ->
+    pure $ Network.Failure "Could not fetch comics from server."
+  Just json ->
+    pure $ Network.fromEither
+      $ either (Left . ms) pure
+      $ eitherDecodeStrict json
+  where
+    req =
+      Ajax.Request
+        { Ajax.reqMethod = Ajax.GET,
+          Ajax.reqURI = "/api/comic", -- FIXME: can we replace this hardcoding?
+          Ajax.reqLogin = Nothing,
+          Ajax.reqHeaders = [],
+          Ajax.reqWithCredentials = False,
+          Ajax.reqData = Ajax.NoData
+        }
+
+sendLogin ::
+  Auth.Username ->
+  Auth.Password ->
+  IO
+    ( Network.RemoteData MisoString
+        User
+    )
+sendLogin u p = Ajax.xhrByteString req /> Ajax.contents >>= \case
+  Nothing ->
+    pure $ Network.Failure "Could not send login request."
+  Just json ->
+    pure $ Network.fromEither
+      $ either (Left . ms) pure
+      $ eitherDecodeStrict json
   where
     req =
-      Request
-        { reqMethod = GET,
-          reqURI = "/api/comic", -- FIXME: can we replace this hardcoding?
-          reqLogin = Nothing,
-          reqHeaders = [],
-          reqWithCredentials = False,
-          reqData = NoData
+      Ajax.Request
+        { Ajax.reqMethod = Ajax.POST,
+          Ajax.reqURI = "/login-hook",
+          Ajax.reqLogin = Nothing, -- FIXME
+          Ajax.reqHeaders =
+            [ ("Accept", "application/json"),
+              ("Content-Type", "application/json")
+            ],
+          Ajax.reqWithCredentials = False,
+          -- TODO: make this use Aeson
+          Ajax.reqData =
+            Ajax.StringData $
+              Miso.String.concat
+                [ "{\"loginEmail\": \"",
+                  u,
+                  "\", \"loginPass\": \"",
+                  p,
+                  "\"}"
+                ]
         }
diff --git a/Hero/Server.hs b/Hero/Server.hs
index 97ce7a2..d179cd2 100644
--- a/Hero/Server.hs
+++ b/Hero/Server.hs
@@ -1,11 +1,17 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
@@ -27,6 +33,8 @@
 -- : dep protolude
 -- : dep safecopy
 -- : dep servant
+-- : dep servant-auth
+-- : dep servant-auth-server
 -- : dep servant-lucid
 -- : dep servant-server
 -- : dep split
@@ -38,13 +46,16 @@
 -- : dep wai-extra
 -- : dep wai-middleware-metrics
 -- : dep warp
+-- : dep x509
 module Hero.Server where
 
 import Alpha
-import Biz.App (CSS(..), Manifest(..))
+import Biz.App (CSS (..), Manifest (..))
 import qualified Clay
+import qualified Crypto.JOSE.JWK as Crypto
 import Data.Acid (AcidState)
 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.App
@@ -61,6 +72,8 @@ import Network.Wai
 import Network.Wai.Application.Static
 import qualified Network.Wai.Handler.Warp as Warp
 import Servant
+import qualified Servant.Auth.Server as Auth
+import qualified System.Directory as Directory
 import qualified System.Envy as Envy
 import qualified System.Exit as Exit
 import qualified System.IO as IO
@@ -72,26 +85,55 @@ main = bracket startup shutdown run
     prn = IO.hPutStrLn IO.stderr
     startup = Envy.decodeEnv >>= \case
       Left e -> Exit.die e
-      Right cfg -> do
-        keep <- Keep.open (heroKeep cfg)
-        say "hero"
-        prn $ "port: " ++ show (heroPort cfg)
-        prn $ "beam: " ++ heroBeam cfg
-        prn $ "keep: " ++ heroKeep cfg
-        let waiapp = mkApp keep cfg
-        return (cfg, waiapp, keep)
+      Right cfg ->
+        do
+          keep <- Keep.open (heroKeep cfg)
+          skey <- upsertKey (heroSkey cfg)
+          say "hero"
+          prn $ "port: " ++ show (heroPort cfg)
+          prn $ "beam: " ++ heroBeam cfg
+          prn $ "keep: " ++ heroKeep cfg
+          prn $ "skey: " ++ heroSkey cfg
+          let jwts = Auth.defaultJWTSettings skey
+              cs = Auth.defaultCookieSettings
+              ctx = cs :. jwts :. EmptyContext
+              proxy = Proxy @(AllRoutes '[Auth.JWT])
+              static = serveDirectoryWith $ defaultWebAppSettings $ heroBeam cfg
+              server =
+                static
+                  :<|> cssHandlers
+                  :<|> (return "hi")
+                  :<|> loginHookHandler cs jwts
+                  :<|> jsonHandlers keep
+                  :<|> publicHandlers
+                  :<|> pure heroManifest
+                  :<|> Tagged handle404
+          return
+            ( cfg,
+              serveWithContext
+                proxy
+                ctx
+                server,
+              keep
+            )
     shutdown :: App -> IO ()
     shutdown (_, _, keep) = do
       Keep.close keep
       return ()
 
+upsertKey :: FilePath -> IO Crypto.JWK
+upsertKey fp = Directory.doesFileExist fp >>= \exists ->
+  if exists
+    then Auth.readKey fp
+    else Auth.writeKey fp >> Auth.readKey fp
+
 -- This part is a little confusing. I have:
 --
 --   - 'App' which encapsulates the entire runtime state
 --   - 'Config' has stuff I can set at startup
 --   - 'HeroKeep' is the database and any other persistance
---   - 'mkApp' take the second two and makes a 'Wai.Application', should really be
---     called 'serve', and might need to be Servant's 'hoistServer' thing
+--   - the above are then put together in the 'startup' private function in
+--     `main` above
 --
 -- I'm sure this can be cleaned up with a monad stack of some sort, but I
 -- haven't the brain power to think through that. For now, just try and keep
@@ -104,29 +146,16 @@ data Config
   = Config
       { heroPort :: Warp.Port,
         heroBeam :: FilePath,
-        heroKeep :: FilePath
+        heroKeep :: FilePath,
+        heroSkey :: FilePath
       }
   deriving (Generic, Show)
 
 instance Envy.DefConfig Config where
-  defConfig = Config 3000 "_bild/Hero.Client/static" "_keep"
+  defConfig = Config 3000 "_bild/Hero.Client/static" "_keep" "/run/hero/skey"
 
 instance Envy.FromEnv Config
 
-mkApp :: AcidState Keep.HeroKeep -> Config -> Application
-mkApp keep cfg =
-  serve
-    (Proxy @AllRoutes)
-    ( static
-        :<|> cssHandlers
-        :<|> jsonHandlers keep
-        :<|> serverHandlers
-        :<|> pure heroManifest
-        :<|> Tagged handle404
-    )
-  where
-    static = serveDirectoryWith $ defaultWebAppSettings $ heroBeam cfg
-
 -- | Convert client side routes into server-side web handlers
 type ServerRoutes = ToServerRoutes ClientRoutes Templated Action
 
@@ -138,10 +167,39 @@ cssHandlers :: Server CssRoute
 cssHandlers =
   return . Lazy.toStrict . Clay.render $ Typography.main <> Look.main
 
-type AllRoutes =
+type Ping = "ping" :> Get '[JSON] Text
+
+type LoginHook =
+  "login-hook"
+    :> ReqBody '[JSON] LoginForm
+    :> Post '[JSON]
+         ( Headers
+             '[ Header "Set-Cookie" Auth.SetCookie,
+                Header "Set-Cookie" Auth.SetCookie
+              ]
+             User
+         )
+
+loginHookHandler ::
+  Auth.CookieSettings ->
+  Auth.JWTSettings ->
+  LoginForm ->
+  Handler
+    ( Headers
+        '[ Header "Set-Cookie" Auth.SetCookie,
+           Header "Set-Cookie" Auth.SetCookie
+         ]
+        User
+    )
+loginHookHandler cs jwts =
+  checkCreds cs jwts
+
+type AllRoutes auths =
   ("static" :> Raw)
     :<|> CssRoute
-    :<|> JsonApi
+    :<|> Ping
+    :<|> LoginHook
+    :<|> (Auth.Auth auths User :> JsonApi)
     :<|> ServerRoutes
     :<|> ("manifest.json" :> Get '[JSON] Manifest)
     :<|> Raw
@@ -231,7 +289,6 @@ instance L.ToHtml a => L.ToHtml (Templated a) where
           (L.link_ mempty)
           [L.rel_ "stylesheet", L.type_ "text/css", L.href_ href]
 
-
 handle404 :: Application
 handle404 _ respond =
   respond
@@ -249,12 +306,15 @@ animateRef :: MisoString
 animateRef =
   "https://cdnjs.cloudflare.com/ajax/libs/animate.css/3.7.0/animate.min.css"
 
+-- TODO: if I remove this, then the login form (and probably other stuff) gets
+-- messed up. When I remove this, I need to also port the necessary CSS styles
+-- to make stuff look good.
 bulmaRef :: MisoString
 bulmaRef =
   "https://cdnjs.cloudflare.com/ajax/libs/bulma/0.7.2/css/bulma.min.css"
 
-serverHandlers :: Server ServerRoutes
-serverHandlers =
+publicHandlers :: Server ServerRoutes
+publicHandlers =
   homeHandler
     :<|> comicCoverHandler
     :<|> comicPageHandler
@@ -264,8 +324,35 @@ serverHandlers =
     :<|> discoverHandler
     :<|> chooseExperienceHandler
 
-jsonHandlers :: AcidState Keep.HeroKeep -> Server JsonApi
-jsonHandlers keep = Acid.query' keep $ Keep.GetComics 10
+
+instance Auth.ToJWT User
+
+instance Auth.FromJWT 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
+  -- 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
+  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
+jsonHandlers _ _ = Auth.throwAll err401
 
 homeHandler :: Handler (Templated (View Action))
 homeHandler = pure . Templated . home $ initModel homeLink
@@ -295,4 +382,3 @@ chooseExperienceHandler id n =
 
 loginHandler :: Handler (Templated (View Action))
 loginHandler = pure . Templated . login $ initModel loginLink
-
diff --git a/Hero/Service.nix b/Hero/Service.nix
index a3c6bd5..e5d811b 100644
--- a/Hero/Service.nix
+++ b/Hero/Service.nix
@@ -31,6 +31,11 @@ in
       type = lib.types.package;
       description = "herocomics-client package to use";
     };
+    skey = lib.mkOption {
+      type = lib.types.path;
+      default = "/run/hero/skey";
+      description = "where to store the signing key";
+    };
     domain = lib.mkOption {
       type = lib.types.str;
       default = "herocomics.app";