diff options
Diffstat (limited to 'Hero/Host.hs')
| -rw-r--r-- | Hero/Host.hs | 66 |
1 files changed, 33 insertions, 33 deletions
diff --git a/Hero/Host.hs b/Hero/Host.hs index 326738b..d547fa5 100644 --- a/Hero/Host.hs +++ b/Hero/Host.hs @@ -14,7 +14,7 @@ -- | Hero web app -- --- : exe mmc +-- : out mmc -- -- : dep acid-state -- : dep aeson @@ -90,10 +90,10 @@ main = bracket startup shutdown run keep <- Keep.open (heroKeep cfg) skey <- upsertKey (heroSkey cfg) say "hero" - prn $ "port: " ++ show (heroPort cfg) - prn $ "keep: " ++ heroKeep cfg - prn $ "node: " ++ heroNode cfg - prn $ "skey: " ++ heroSkey cfg + prn <| "port: " ++ show (heroPort cfg) + prn <| "keep: " ++ heroKeep cfg + prn <| "node: " ++ heroNode cfg + prn <| "skey: " ++ heroSkey cfg let jwts = Auth.defaultJWTSettings skey cs = Auth.defaultCookieSettings @@ -103,7 +103,7 @@ main = bracket startup shutdown run } ctx = cs :. jwts :. EmptyContext proxy = Proxy @(AllRoutes '[Auth.JWT, Auth.Cookie]) - static = serveDirectoryWith $ defaultWebAppSettings $ heroNode cfg + static = serveDirectoryWith <| defaultWebAppSettings <| heroNode cfg server = -- assets, auth, and the homepage is public static @@ -200,13 +200,13 @@ wrapAuth f authResult = case authResult of Auth.Indefinite -> Auth.throwAll err422 jsonHandlers :: AcidState Keep.HeroKeep -> User -> Server JsonApi -jsonHandlers keep _ = Acid.query' keep $ Keep.GetComics 10 +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 + return . Lazy.toStrict . Clay.render <| Typography.main <> Look.main type AuthRoute = "auth" @@ -241,16 +241,16 @@ authHandler :: authHandler cookieSettings jwtSettings loginForm = case loginForm of (LoginForm "ben@bsima.me" "test") -> - applyCreds $ User "ben@bsima.me" "ben" [] + applyCreds <| User "ben@bsima.me" "ben" [] (LoginForm "mcovino@heroprojects.io" "test") -> - applyCreds $ User "mcovino@heroprojects.io" "mike" [] + applyCreds <| User "mcovino@heroprojects.io" "mike" [] _ -> throwError err401 where applyCreds usr = do - mApplyCookies <- liftIO $ Auth.acceptLogin cookieSettings jwtSettings usr + mApplyCookies <- liftIO <| Auth.acceptLogin cookieSettings jwtSettings usr case mApplyCookies of Nothing -> throwError err401 - Just applyCookies -> return $ applyCookies usr + Just applyCookies -> return <| applyCookies usr -- | See also 'server' above type AllRoutes auths = @@ -282,8 +282,8 @@ 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.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_ ""] @@ -291,7 +291,7 @@ instance L.ToHtml a => L.ToHtml (Templated a) where L.link_ [ L.rel_ "apple-touch-icon", L.sizes_ "180x180", - L.href_ $ + L.href_ <| Pack.cdnEdge <> "/old-assets/images/favicons/apple-touch-icon.png" ] @@ -299,7 +299,7 @@ instance L.ToHtml a => L.ToHtml (Templated a) where [ L.rel_ "icon", L.type_ "image/png", L.sizes_ "32x32", - L.href_ $ + L.href_ <| Pack.cdnEdge <> "/old-assets/images/favicons/favicon-32x32.png" ] @@ -307,19 +307,19 @@ instance L.ToHtml a => L.ToHtml (Templated a) where [ L.rel_ "icon", L.type_ "image/png", L.sizes_ "16x16", - L.href_ $ + L.href_ <| Pack.cdnEdge <> "/old-assets/images/favicons/favicon-16x16.png" ] L.link_ [ L.rel_ "manifest", - L.href_ $ + L.href_ <| Pack.cdnEdge <> "/old-assets/images/favicons/manifest.json" ] L.link_ [ L.rel_ "mask-icon", - L.href_ $ + L.href_ <| Pack.cdnEdge <> "/old-assets/images/favicons/safari-pinned-tab.svg" ] @@ -351,12 +351,12 @@ instance L.ToHtml a => L.ToHtml (Templated a) where handle404 :: Application handle404 _ respond = respond - $ responseLBS status404 [("Content-Type", "text/html")] - $ renderBS - $ toHtml - $ Templated - $ the404 - $ initForm homeLink + <| responseLBS status404 [("Content-Type", "text/html")] + <| renderBS + <| toHtml + <| Templated + <| the404 + <| initForm homeLink fontAwesomeRef :: MisoString fontAwesomeRef = "https://use.fontawesome.com/releases/v5.7.2/css/all.css" @@ -373,30 +373,30 @@ bulmaRef = "https://cdnjs.cloudflare.com/ajax/libs/bulma/0.7.2/css/bulma.min.css" homeHandler :: Handler (Templated (View Move)) -homeHandler = pure . Templated . home $ initForm homeLink +homeHandler = pure . Templated . home <| initForm homeLink comicCoverHandler :: ComicId -> Handler (Templated (View Move)) comicCoverHandler id = - pure . Templated . comicCover id . initForm $ comicLink id + pure . Templated . comicCover id . initForm <| comicLink id comicPageHandler :: ComicId -> PageNumber -> Handler (Templated (View Move)) comicPageHandler id n = - pure . Templated . comicReader id n . initForm $ comicReaderSpreadLink id n + pure . Templated . comicReader id n . initForm <| comicReaderSpreadLink id n comicPageFullHandler :: ComicId -> PageNumber -> Handler (Templated (View Move)) comicPageFullHandler id n = - pure . Templated . comicReader id n . initForm $ comicReaderFullLink id n + pure . Templated . comicReader id n . initForm <| comicReaderFullLink id n comicVideoHandler :: ComicId -> PageNumber -> Handler (Templated (View Move)) comicVideoHandler id n = - pure . Templated . comicReader id n . initForm $ comicVideoLink id n + pure . Templated . comicReader id n . initForm <| comicVideoLink id n discoverHandler :: Handler (Templated (View Move)) -discoverHandler = pure . Templated . discover $ initForm discoverLink +discoverHandler = pure . Templated . discover <| initForm discoverLink chooseExperienceHandler :: ComicId -> PageNumber -> Handler (Templated (View Move)) chooseExperienceHandler id n = - pure . Templated . comicReader id n . initForm $ chooseExperienceLink id n + pure . Templated . comicReader id n . initForm <| chooseExperienceLink id n loginHandler :: Handler (Templated (View Move)) -loginHandler = pure . Templated . login $ initForm loginLink +loginHandler = pure . Templated . login <| initForm loginLink |