hero: rename stuff to new structure

Working toward https://github.com/bsima/biz/issues/5

1 files changed, 0 insertions, 396 deletions

diff --git a/Hero/Server.hs b/Hero/Server.hs
deleted file mode 100644
index cdf89d0..0000000
--- a/Hero/Server.hs
+++ /dev/null
@@ -1,396 +0,0 @@
-{-# 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 #-}
-
--- | Hero web app
---
--- : exe mmc
---
--- : dep acid-state
--- : dep aeson
--- : dep clay
--- : dep containers
--- : dep envy
--- : dep http-types
--- : dep ixset
--- : dep lucid
--- : dep miso
--- : dep mtl
--- : dep network-uri
--- : dep protolude
--- : dep safecopy
--- : dep servant
--- : dep servant-auth
--- : dep servant-auth-server
--- : dep servant-lucid
--- : dep servant-server
--- : dep split
--- : dep split
--- : dep string-quote
--- : dep text
--- : dep wai
--- : dep wai-app-static
--- : dep wai-extra
--- : dep wai-middleware-metrics
--- : dep warp
--- : dep x509
-module Hero.Server
-  ( main,
-  )
-where
-
-import Alpha
-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
-import qualified Hero.Assets as Assets
-import qualified Hero.Keep as Keep
-import qualified Hero.Look as Look
-import qualified Hero.Look.Typography as Typography
-import qualified Lucid as L
-import Lucid.Base
-import Miso
-import Miso.String
-import Network.HTTP.Types hiding (Header)
-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
-
-main :: IO ()
-main = bracket startup shutdown run
-  where
-    run (cfg, app, _) = Warp.run (heroPort cfg) app
-    prn = IO.hPutStrLn IO.stderr
-    startup = Envy.decodeEnv >>= \case
-      Left e -> Exit.die e
-      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 =
-                -- assets, auth, and the homepage is public
-                static
-                  :<|> cssHandlers
-                  :<|> pure heroManifest
-                  :<|> pubHostHandlers
-                  :<|> authHandler cs jwts
-                  -- app and api are private
-                  :<|> wrapAuth (jsonHandlers keep)
-                  :<|> wrapAuth appHostHandlers
-                  -- fall through to 404
-                  :<|> 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
---   - 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
--- things named clearly so I don't get confused.
-
--- | This can be generalized I think, put in Biz.App, or something
-type App = (Config, Application, AcidState Keep.HeroKeep)
-
-data Config
-  = Config
-      { heroPort :: Warp.Port,
-        heroBeam :: FilePath,
-        heroKeep :: FilePath,
-        heroSkey :: FilePath
-      }
-  deriving (Generic, Show)
-
-instance Envy.DefConfig Config where
-  defConfig = Config 3000 "_bild/Hero.Client/static" "_keep" "/run/hero/skey"
-
-instance Envy.FromEnv Config
-
--- | Convert client side routes into server-side web handlers
-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 AuthRoute =
-  "auth"
-    :> ReqBody '[JSON] LoginForm
-    :> Post '[JSON]
-         ( Headers
-             '[ Header "Set-Cookie" Auth.SetCookie,
-                Header "Set-Cookie" Auth.SetCookie
-              ]
-             User
-         )
-
-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 ->
-  Handler
-    ( Headers
-        '[ Header "Set-Cookie" Auth.SetCookie,
-           Header "Set-Cookie" Auth.SetCookie
-         ]
-        User
-    )
-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
-    :<|> ("manifest.json" :> Get '[JSON] Manifest)
-    :<|> PubHostRoutes
-    :<|> AuthRoute
-    :<|> (Auth.Auth auths User :> JsonApi)
-    :<|> (Auth.Auth auths User :> AppHostRoutes)
-    :<|> Raw
-
-heroManifest :: Manifest
-heroManifest =
-  Manifest
-    { name = "Hero",
-      short_name = "Hero",
-      start_url = ".",
-      display = "standalone",
-      theme_color = "#0a0a0a",
-      description = "Comics for all"
-    }
-
--- | Type for setting wrapping a view in HTML doctype, header, etc
-newtype Templated a = Templated a
-  deriving (Show, Eq)
-
-instance L.ToHtml a => L.ToHtml (Templated a) where
-  toHtmlRaw = L.toHtml
-  toHtml (Templated x) = do
-    L.doctype_
-    L.html_ [L.lang_ "en"] $ do
-      L.head_ $ do
-        L.title_ "Hero [alpha]"
-        L.link_ [L.rel_ "manifest", L.href_ "/manifest.json"]
-        L.link_ [L.rel_ "icon", L.type_ ""]
-        -- icons
-        L.link_
-          [ L.rel_ "apple-touch-icon",
-            L.sizes_ "180x180",
-            L.href_ $
-              Assets.cdnEdge
-                <> "/old-assets/images/favicons/apple-touch-icon.png"
-          ]
-        L.link_
-          [ L.rel_ "icon",
-            L.type_ "image/png",
-            L.sizes_ "32x32",
-            L.href_ $
-              Assets.cdnEdge
-                <> "/old-assets/images/favicons/favicon-32x32.png"
-          ]
-        L.link_
-          [ L.rel_ "icon",
-            L.type_ "image/png",
-            L.sizes_ "16x16",
-            L.href_ $
-              Assets.cdnEdge
-                <> "/old-assets/images/favicons/favicon-16x16.png"
-          ]
-        L.link_
-          [ L.rel_ "manifest",
-            L.href_ $
-              Assets.cdnEdge
-                <> "/old-assets/images/favicons/manifest.json"
-          ]
-        L.link_
-          [ L.rel_ "mask-icon",
-            L.href_ $
-              Assets.cdnEdge
-                <> "/old-assets/images/favicons/safari-pinned-tab.svg"
-          ]
-        L.meta_ [L.charset_ "utf-8"]
-        L.meta_ [L.name_ "theme-color", L.content_ "#000"]
-        L.meta_ [L.httpEquiv_ "X-UA-Compatible", L.content_ "IE=edge"]
-        L.meta_
-          [L.name_ "viewport", L.content_ "width=device-width, initial-scale=1"]
-        cssRef animateRef
-        cssRef bulmaRef
-        cssRef fontAwesomeRef
-        cssRef "/css/main.css" -- TODO: make this a safeLink?
-        jsRef "/static/mmc.js"
-        jsRef "/static/usersnap.js"
-      L.body_ (L.toHtml x)
-    where
-      jsRef href =
-        L.with
-          (L.script_ mempty)
-          [ makeAttribute "src" href,
-            makeAttribute "async" mempty,
-            makeAttribute "defer" mempty
-          ]
-      cssRef href =
-        L.with
-          (L.link_ mempty)
-          [L.rel_ "stylesheet", L.type_ "text/css", L.href_ href]
-
-handle404 :: Application
-handle404 _ respond =
-  respond
-    $ responseLBS status404 [("Content-Type", "text/html")]
-    $ renderBS
-    $ toHtml
-    $ Templated
-    $ the404
-    $ initModel homeLink
-
-fontAwesomeRef :: MisoString
-fontAwesomeRef = "https://use.fontawesome.com/releases/v5.7.2/css/all.css"
-
-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"
-
-homeHandler :: Handler (Templated (View Action))
-homeHandler = pure . Templated . home $ initModel homeLink
-
-comicCoverHandler :: ComicId -> Handler (Templated (View Action))
-comicCoverHandler id =
-  pure . Templated . comicCover id . initModel $ comicLink id
-
-comicPageHandler :: ComicId -> Page -> Handler (Templated (View Action))
-comicPageHandler id n =
-  pure . Templated . comicReader id n . initModel $ comicReaderSpreadLink id n
-
-comicPageFullHandler :: ComicId -> Page -> Handler (Templated (View Action))
-comicPageFullHandler id n =
-  pure . Templated . comicReader id n . initModel $ comicReaderFullLink id n
-
-comicVideoHandler :: ComicId -> Page -> Handler (Templated (View Action))
-comicVideoHandler id n =
-  pure . Templated . comicReader id n . initModel $ comicVideoLink id n
-
-discoverHandler :: Handler (Templated (View Action))
-discoverHandler = pure . Templated . discover $ initModel discoverLink
-
-chooseExperienceHandler :: ComicId -> Page -> Handler (Templated (View Action))
-chooseExperienceHandler id n =
-  pure . Templated . comicReader id n . initModel $ chooseExperienceLink id n
-
-loginHandler :: Handler (Templated (View Action))
-loginHandler = pure . Templated . login $ initModel loginLink