summaryrefslogtreecommitdiff
path: root/Com
diff options
context:
space:
mode:
Diffstat (limited to 'Com')
-rw-r--r--Com/MusicMeetsComics/App.hs4
-rw-r--r--Com/MusicMeetsComics/Database.hs23
-rw-r--r--Com/MusicMeetsComics/Look/Typography.hs78
-rw-r--r--Com/MusicMeetsComics/Prod.nix43
-rw-r--r--Com/MusicMeetsComics/Server.hs189
-rw-r--r--Com/MusicMeetsComics/Server/Config.hs102
-rw-r--r--Com/MusicMeetsComics/Server/Init.hs6
-rw-r--r--Com/MusicMeetsComics/Service.nix76
8 files changed, 336 insertions, 185 deletions
diff --git a/Com/MusicMeetsComics/App.hs b/Com/MusicMeetsComics/App.hs
index fa3b8e9..4c5f60a 100644
--- a/Com/MusicMeetsComics/App.hs
+++ b/Com/MusicMeetsComics/App.hs
@@ -388,7 +388,7 @@ discover model@(Model { userLibrary = lib}) = template "discover"
, main_ [id_ "app-body"] $ case appComics model of
NotAsked -> [loading]
Loading -> [loading]
- Failure e -> [nocomics]
+ Failure _ -> [nocomics]
Success [] -> [nocomics]
Success (comic:rest) ->
[ feature comic lib
@@ -480,7 +480,7 @@ comicPlayer :: ComicId -> Page -> Model -> View Action
comicPlayer _ _ model = case appComics model of
NotAsked -> loading
Loading -> loading
- Failure e -> nocomics
+ Failure _ -> nocomics
Success comics -> case cpState model of
NotReading -> template "comic-player" [ text "error: not reading" ]
Cover id -> viewOr404 comics comicSpread id 1 model
diff --git a/Com/MusicMeetsComics/Database.hs b/Com/MusicMeetsComics/Database.hs
index 8178e9a..c5a0068 100644
--- a/Com/MusicMeetsComics/Database.hs
+++ b/Com/MusicMeetsComics/Database.hs
@@ -3,18 +3,19 @@
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Com.MusicMeetsComics.Database
- (
- ComicDB
+ ( ComicDB
, getComics
, load
- ) where
+ , dummy
+ )
+where
import Com.MusicMeetsComics.App
-import Data.Map ( Map )
-import qualified Data.Map as Map
+import Data.Map ( Map )
+import qualified Data.Map as Map
import Dhall
import Protolude
-import Servant ( Handler )
+import Servant ( Handler )
type ComicDB = (Map ComicId Comic)
@@ -23,6 +24,16 @@ instance Interpret Comic
load :: IO ComicDB
load = listToComicDB <$> input auto "./comic-database.dhall"
+dummy :: IO ComicDB
+dummy = return $ listToComicDB
+ [ Comic { comicId = "ComicId"
+ , comicPages = 10
+ , comicName = "Dummy comic"
+ , comicIssue = "dummy issue"
+ , comicDescription = "Lorem ipsum"
+ }
+ ]
+
listToComicDB :: [Comic] -> ComicDB
listToComicDB ls = Map.fromList $ (,) <$> comicId <*> identity <$> ls
diff --git a/Com/MusicMeetsComics/Look/Typography.hs b/Com/MusicMeetsComics/Look/Typography.hs
index bb9fc01..152662a 100644
--- a/Com/MusicMeetsComics/Look/Typography.hs
+++ b/Com/MusicMeetsComics/Look/Typography.hs
@@ -4,80 +4,70 @@
module Com.MusicMeetsComics.Look.Typography where
import Clay
-import Clay.Stylesheet (key)
-import qualified Com.MusicMeetsComics.Assets as Assets
+import Clay.Stylesheet ( key )
+import qualified Com.MusicMeetsComics.Assets as Assets
import Com.Simatime.Alpha
-import Data.Semigroup ((<>))
-import Protolude
+import Data.Semigroup ( (<>) )
main :: Css
main = fonts
----------------------------------------------------------------------------------
-- font modifiers
----------------------------------------------------------------------------------
-euro, slim, wide, thicc, thinn, norm, lean,
- smol, lower, upper :: Css
+euro, slim, wide, thicc, thinn, norm, lean, smol, lower, upper :: Css
-euro = fontFamily ["Eurostile"] [sansSerif]
+euro = fontFamily ["Eurostile"] [sansSerif]
--- stretch
-slim = fontStretch condensed
-wide = fontStretch expanded
+-- | stretch
+slim = fontStretch condensed
+wide = fontStretch expanded
--- weight
+-- | weight
thicc = fontWeight bold
thinn = fontWeight normal
--- style
-norm = fontStyle normal
-lean = fontStyle italic
+-- | style
+norm = fontStyle normal
+lean = fontStyle italic
--- "smallcaps" is already taken by Clay
-smol = fontVariant smallCaps
+-- | "smallcaps" is already taken by Clay
+smol = fontVariant smallCaps
lower = textTransform lowercase
upper = textTransform uppercase
----------------------------------------------------------------------------------
--- font sizing
----------------------------------------------------------------------------------
+-- | font sizing
-- | apparently "coat" is a synonym for "size"
coat :: Double -> Css
coat = fontSize . Clay.rem
----------------------------------------------------------------------------------
--- font faces
----------------------------------------------------------------------------------
-
fontRoot :: Text
fontRoot = Assets.cdnEdge <> "/old-assets/fonts/eurostile/Eurostile"
+-- | font faces
fonts :: Css
-fonts = mconcat $ mkEuro </
- [ ("-Reg.otf", OpenType, fontWeight normal <> fontStyle normal)
- , ("LTStd-Bold.otf", OpenType, thicc <> norm)
- , ("LTStd-Cn.otf", OpenType, slim <> norm)
- , ("LTStd-Ex2.otf", OpenType, wide <> norm)
- , ("LTStd-BoldCn.otf", OpenType, slim <> thicc)
- , ("LTStd-BoldEx2.otf", OpenType, wide <> thicc)
- ]
- where
- mkEuro :: (Text, FontFaceFormat, Css) -> Css
- mkEuro (sufx, fmt, extra) = fontFace $ do
- fontFamily ["Eurostile"] []
- fontFaceSrc [FontFaceSrcUrl (fontRoot <> sufx) $ Just fmt]
- extra
-
-
----------------------------------------------------------------------------------
+fonts =
+ mconcat
+ $ mkEuro
+ </ [ ("-Reg.otf" , OpenType, fontWeight normal <> fontStyle normal)
+ , ("LTStd-Bold.otf" , OpenType, thicc <> norm)
+ , ("LTStd-Cn.otf" , OpenType, slim <> norm)
+ , ("LTStd-Ex2.otf" , OpenType, wide <> norm)
+ , ("LTStd-BoldCn.otf" , OpenType, slim <> thicc)
+ , ("LTStd-BoldEx2.otf", OpenType, wide <> thicc)
+ ]
+ where
+ mkEuro :: (Text, FontFaceFormat, Css) -> Css
+ mkEuro (sufx, fmt, extra) = fontFace $ do
+ fontFamily ["Eurostile"] []
+ fontFaceSrc [FontFaceSrcUrl (fontRoot <> sufx) $ Just fmt]
+ extra
+
-- TODO: add the below to Clay.Font upstream
----------------------------------------------------------------------------------
newtype FontStretch = FontStretch Value
- deriving (Val, Inherit, Normal, Other)
+ deriving (Val, Inherit, Normal, Other)
expanded :: FontStretch
expanded = FontStretch "expanded"
diff --git a/Com/MusicMeetsComics/Prod.nix b/Com/MusicMeetsComics/Prod.nix
new file mode 100644
index 0000000..10650ee
--- /dev/null
+++ b/Com/MusicMeetsComics/Prod.nix
@@ -0,0 +1,43 @@
+{ config, pkgs, lib, ... }:
+{
+ imports = [ <nixpkgs/nixos/modules/profiles/qemu-guest.nix> ];
+ boot.loader.grub.device = "/dev/vda";
+ fileSystems."/" = { device = "/dev/vda1"; fsType = "ext4"; };
+
+ services.herocomics = {
+ enable = true;
+ port = 3000;
+ server = pkgs.herocomics-server;
+ client = pkgs.herocomics-client;
+ };
+
+ networking = {
+ firewall.allowedTCPPorts = [ 22 80 443 ];
+ nameservers = [
+ "67.207.67.2"
+ "67.207.67.3"
+ ];
+ defaultGateway = "138.68.40.1";
+ defaultGateway6 = "";
+ dhcpcd.enable = false;
+ usePredictableInterfaceNames = lib.mkForce true;
+ interfaces = {
+ eth0 = {
+ ipv4.addresses = [
+ { address="138.68.40.97"; prefixLength=21; }
+ { address="10.46.0.5"; prefixLength=16; }
+ ];
+ ipv6.addresses = [
+ { address="fe80::b063:c4ff:fee5:d636"; prefixLength=64; }
+ ];
+ ipv4.routes = [ { address = "138.68.40.1"; prefixLength = 32; } ];
+ ipv6.routes = [ { address = ""; prefixLength = 32; } ];
+ };
+
+ };
+ };
+ services.udev.extraRules = ''
+ ATTR{address}=="b2:63:c4:e5:d6:36", NAME="eth0"
+
+ '';
+}
diff --git a/Com/MusicMeetsComics/Server.hs b/Com/MusicMeetsComics/Server.hs
index 5b12861..5736688 100644
--- a/Com/MusicMeetsComics/Server.hs
+++ b/Com/MusicMeetsComics/Server.hs
@@ -45,24 +45,29 @@ module Com.MusicMeetsComics.Server where
import qualified Clay
import Com.MusicMeetsComics.App
-import qualified Com.MusicMeetsComics.Assets as Assets
+import qualified Com.MusicMeetsComics.Assets as Assets
import qualified Com.MusicMeetsComics.Database as Database
-import qualified Com.MusicMeetsComics.Server.Config as Config
-import qualified Com.MusicMeetsComics.Server.Init as Init
-import qualified Com.MusicMeetsComics.Look as Look
-import qualified Com.MusicMeetsComics.Look.Typography as Typography
+import qualified Com.MusicMeetsComics.Server.Config
+ as Config
+import qualified Com.MusicMeetsComics.Server.Init
+ as Init
+import qualified Com.MusicMeetsComics.Look as Look
+import qualified Com.MusicMeetsComics.Look.Typography
+ as Typography
import Data.Aeson
import Data.Proxy
-import Data.Text ( Text )
-import qualified Data.Text.Lazy as Lazy
-import qualified Data.Text.Lazy.Encoding as Lazy
+import Data.Text ( Text )
+import qualified Data.Text.Lazy as Lazy
+import qualified Data.Text.Lazy.Encoding as Lazy
import GHC.Generics
-import qualified Lucid as L
+import qualified Lucid as L
import Lucid.Base
import Miso
import Miso.String
-import Network.HTTP.Media ((//), (/:))
-import Network.HTTP.Types hiding ( Header )
+import Network.HTTP.Media ( (//)
+ , (/:)
+ )
+import Network.HTTP.Types hiding ( Header )
import Network.Wai
import Network.Wai.Application.Static
import Protolude
@@ -71,11 +76,11 @@ import Servant
main :: IO ()
main = do
- db <- Database.load
- Init.runApp (app db)
+ db <- Database.dummy
+ Init.runApp (app db)
app :: Database.ComicDB -> Config.Config -> Application
-app db _ = serve
+app db cfg = serve
(Proxy @AllRoutes)
( static
:<|> cssHandlers
@@ -84,8 +89,8 @@ app db _ = serve
:<|> pure heroManifest
:<|> Tagged handle404
)
- where
- static = serveDirectoryWith (defaultWebAppSettings "static")
+ where
+ static = serveDirectoryWith $ defaultWebAppSettings $ Config.configClient cfg
-- | HtmlPage for setting HTML doctype and header
@@ -99,25 +104,32 @@ type JsonApi = "api" :> "comic" :> Get '[JSON] [Comic]
type CssRoute = "css" :> "main.css" :> Get '[CSS] Text
-newtype CSS = CSS { unCSS :: Text }
+newtype CSS = CSS
+ { unCSS :: Text
+ }
instance Accept CSS where
- contentType _ = "text" // "css" /: ("charset", "utf-8")
+ contentType _ = "text" // "css" /: ("charset", "utf-8")
instance MimeRender CSS Text where
- mimeRender _ = Lazy.encodeUtf8 . Lazy.fromStrict
+ mimeRender _ = Lazy.encodeUtf8 . Lazy.fromStrict
cssHandlers :: Server CssRoute
-cssHandlers = return . Lazy.toStrict . Clay.render
- $ Typography.main <> Look.main
+cssHandlers =
+ return . Lazy.toStrict . Clay.render $ Typography.main <> Look.main
type AllRoutes
= ("static" :> Raw)
- :<|> CssRoute
- :<|> JsonApi
- :<|> ServerRoutes
- :<|> ("manifest.json" :> Get '[JSON] Manifest)
- :<|> Raw
+ :<|>
+ CssRoute
+ :<|>
+ JsonApi
+ :<|>
+ ServerRoutes
+ :<|>
+ ("manifest.json" :> Get '[JSON] Manifest)
+ :<|>
+ Raw
data Manifest = Manifest
{ name :: Text
@@ -153,58 +165,61 @@ instance L.ToHtml a => L.ToHtml (HtmlPage a) where
toHtmlRaw = L.toHtml
toHtml (HtmlPage 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/all.js"
- jsRef "/static/usersnap.js"
- L.body_ (L.toHtml x)
+ 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)
@@ -217,8 +232,7 @@ instance L.ToHtml a => L.ToHtml (HtmlPage a) where
[L.rel_ "stylesheet", L.type_ "text/css", L.href_ href]
fontAwesomeRef :: MisoString
-fontAwesomeRef =
- "https://use.fontawesome.com/releases/v5.7.2/css/all.css"
+fontAwesomeRef = "https://use.fontawesome.com/releases/v5.7.2/css/all.css"
animateRef :: MisoString
animateRef =
@@ -246,16 +260,20 @@ homeHandler :: Handler (HtmlPage (View Action))
homeHandler = pure . HtmlPage . home $ initModel homeLink
comicCoverHandler :: ComicId -> Handler (HtmlPage (View Action))
-comicCoverHandler id = pure . HtmlPage . comicCover id . initModel $ comicLink id
+comicCoverHandler id =
+ pure . HtmlPage . comicCover id . initModel $ comicLink id
comicPageHandler :: ComicId -> Page -> Handler (HtmlPage (View Action))
-comicPageHandler id n = pure . HtmlPage . comicPlayer id n . initModel $ comicPlayerSpreadLink id n
+comicPageHandler id n =
+ pure . HtmlPage . comicPlayer id n . initModel $ comicPlayerSpreadLink id n
comicPageFullHandler :: ComicId -> Page -> Handler (HtmlPage (View Action))
-comicPageFullHandler id n = pure . HtmlPage . comicPlayer id n . initModel $ comicPlayerFullLink id n
+comicPageFullHandler id n =
+ pure . HtmlPage . comicPlayer id n . initModel $ comicPlayerFullLink id n
comicVideoHandler :: ComicId -> Page -> Handler (HtmlPage (View Action))
-comicVideoHandler id n = pure . HtmlPage . comicPlayer id n . initModel $ comicVideoLink id n
+comicVideoHandler id n =
+ pure . HtmlPage . comicPlayer id n . initModel $ comicVideoLink id n
loginHandler :: Handler (HtmlPage (View Action))
loginHandler = pure . HtmlPage . login $ initModel loginLink
@@ -264,4 +282,5 @@ discoverHandler :: Handler (HtmlPage (View Action))
discoverHandler = pure . HtmlPage . discover $ initModel discoverLink
chooseExperienceHandler :: ComicId -> Page -> Handler (HtmlPage (View Action))
-chooseExperienceHandler id n = pure . HtmlPage . comicPlayer id n . initModel $ chooseExperienceLink id n
+chooseExperienceHandler id n =
+ pure . HtmlPage . comicPlayer id n . initModel $ chooseExperienceLink id n
diff --git a/Com/MusicMeetsComics/Server/Config.hs b/Com/MusicMeetsComics/Server/Config.hs
index ac634a2..0de3379 100644
--- a/Com/MusicMeetsComics/Server/Config.hs
+++ b/Com/MusicMeetsComics/Server/Config.hs
@@ -8,23 +8,38 @@
module Com.MusicMeetsComics.Server.Config where
import Com.MusicMeetsComics.Server.Logger
-import Control.Concurrent (ThreadId)
-import Control.Monad.Except (ExceptT, MonadError)
+import Control.Concurrent ( ThreadId )
+import Control.Monad.Except ( ExceptT
+ , MonadError
+ )
import Control.Monad.IO.Class
-import Control.Monad.Logger (MonadLogger(..))
-import Control.Monad.Metrics (Metrics, MonadMetrics, getMetrics)
-import qualified Control.Monad.Metrics as M
-import Control.Monad.Reader (MonadIO, MonadReader, ReaderT, asks)
-import Data.Text (pack)
-import GHC.Base (String)
-import Network.Wai (Middleware)
-import Network.Wai.Handler.Warp (Port)
-import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev)
+import Control.Monad.Logger ( MonadLogger(..) )
+import Control.Monad.Metrics ( Metrics
+ , MonadMetrics
+ , getMetrics
+ )
+import qualified Control.Monad.Metrics as M
+import Control.Monad.Reader ( MonadIO
+ , MonadReader
+ , ReaderT
+ , asks
+ )
+import Data.Text ( pack )
+import GHC.Base ( String )
+import Network.Wai ( Middleware )
+import Network.Wai.Handler.Warp ( Port )
+import Network.Wai.Middleware.RequestLogger
+ ( logStdout
+ , logStdoutDev
+ )
import Protolude
-import Safe (readMay)
-import Servant (ServerError)
-import System.Environment (lookupEnv)
-import System.Remote.Monitoring (forkServer, serverMetricStore, serverThreadId)
+import Safe ( readMay )
+import Servant ( ServerError )
+import System.Environment ( lookupEnv )
+import System.Remote.Monitoring ( forkServer
+ , serverMetricStore
+ , serverThreadId
+ )
-- | This type represents the effects we want to have for our application.
-- We wrap the standard Servant monad with 'ReaderT Config', which gives us
@@ -35,13 +50,9 @@ import System.Remote.Monitoring (forkServer, serverMetricStore, server
-- monad stack without having to modify code that uses the current layout.
newtype AppT m a = AppT
{ runApp :: ReaderT Config (ExceptT ServerError m) a
- } deriving ( Functor
- , Applicative
- , Monad
- , MonadReader Config
- , MonadError ServerError
- , MonadIO
- )
+ }
+ deriving (Functor, Applicative, Monad, MonadReader Config, MonadError
+ ServerError, MonadIO)
type App = AppT IO
@@ -53,6 +64,7 @@ data Config = Config
, configEkgServer :: ThreadId
, configLogEnv :: LogEnv
, configPort :: Port
+ , configClient :: FilePath
}
instance Monad m => MonadMetrics (AppT m) where
@@ -60,7 +72,7 @@ instance Monad m => MonadMetrics (AppT m) where
-- | Katip instance for @AppT m@
instance MonadIO m => Katip (AppT m) where
- getLogEnv = asks configLogEnv
+ getLogEnv = asks configLogEnv
localLogEnv = panic "not implemented"
-- | MonadLogger instance to use within @AppT m@
@@ -81,42 +93,42 @@ data Environment
-- | This returns a 'Middleware' based on the environment that we're in.
setLogger :: Environment -> Middleware
-setLogger Test = identity
+setLogger Test = identity
setLogger Development = logStdoutDev
-setLogger Production = logStdout
+setLogger Production = logStdout
-- | Web request logger (currently unimplemented and unused). For inspiration
-- see ApacheLogger from wai-logger package.
katipLogger :: LogEnv -> Middleware
-katipLogger env app req respond =
- runKatipT env $ do
- logMsg "web" InfoS "todo: received some request"
- -- todo: log proper request data
- liftIO $ app req respond
+katipLogger env app req respond = runKatipT env $ do
+ logMsg "web" InfoS "todo: received some request"
+ -- todo: log proper request data
+ liftIO $ app req respond
-- | The number of pools to use for a given environment.
envPool :: Environment -> Int
-envPool Test = 1
+envPool Test = 1
envPool Development = 1
-envPool Production = 8
+envPool Production = 8
-- | Allocates resources for 'Config'
acquire :: IO Config
acquire = do
- port <- lookupSetting "PORT" 3001
- env <- lookupSetting "ENV" Development
- logEnv <- defaultLogEnv
+ port <- lookupSetting "PORT" 3001
+ clientDir <- lookupSetting "CLIENT_DIR"
+ "_bild/Com.MusicMeetsComics.Client/static"
+ env <- lookupSetting "ENV" Development
+ logEnv <- defaultLogEnv
ekgServer <- forkServer "localhost" 8000
let store = serverMetricStore ekgServer
metr <- M.initializeWith store
- pure
- Config
- { configEnv = env
- , configMetrics = metr
- , configLogEnv = logEnv
- , configPort = port
- , configEkgServer = serverThreadId ekgServer
- }
+ pure Config { configEnv = env
+ , configMetrics = metr
+ , configLogEnv = logEnv
+ , configPort = port
+ , configEkgServer = serverThreadId ekgServer
+ , configClient = clientDir
+ }
-- | Looks up a setting in the environment, with a provided default, and
-- 'read's that information into the inferred type.
@@ -127,5 +139,5 @@ lookupSetting env def_ = do
Nothing -> return def_
Just str -> maybe (handleFailedRead str) return (readMay str)
where
- handleFailedRead str = panic
- $ mconcat ["Failed to read [[", pack str, "]] for environment variable ", pack env]
+ handleFailedRead str = panic $ mconcat
+ ["Failed to read [[", pack str, "]] for environment variable ", pack env]
diff --git a/Com/MusicMeetsComics/Server/Init.hs b/Com/MusicMeetsComics/Server/Init.hs
index 7ad3ebf..04ddc88 100644
--- a/Com/MusicMeetsComics/Server/Init.hs
+++ b/Com/MusicMeetsComics/Server/Init.hs
@@ -18,7 +18,7 @@ import qualified System.IO as IO
-- | An action that creates a WAI 'Application' together with its resources,
-- runs it, and tears it down on exit
runApp :: (Config.Config -> Application) -> IO ()
-runApp app = bracket Config.acquire shutdownApp jog
+runApp app = bracket Config.acquire shutdown jog
where
say = IO.hPutStrLn IO.stderr
jog config = do
@@ -39,8 +39,8 @@ compress :: Middleware
compress = gzip def { gzipFiles = GzipCompress }
-- | Takes care of cleaning up 'Config.Config' resources
-shutdownApp :: Config.Config -> IO ()
-shutdownApp cfg = do
+shutdown :: Config.Config -> IO ()
+shutdown cfg = do
_ <- Katip.closeScribes (Config.configLogEnv cfg)
-- Monad.Metrics does not provide a function to destroy metrics store
-- so, it'll hopefully get torn down when async exception gets thrown
diff --git a/Com/MusicMeetsComics/Service.nix b/Com/MusicMeetsComics/Service.nix
new file mode 100644
index 0000000..9b8d91d
--- /dev/null
+++ b/Com/MusicMeetsComics/Service.nix
@@ -0,0 +1,76 @@
+{ options
+, lib
+, config
+, pkgs
+, modulesPath
+}:
+
+let
+ cfg = config.services.herocomics;
+in
+{
+ options.services.herocomics = {
+ enable = lib.mkEnableOption "Enable the herocomics service";
+ port = lib.mkOption {
+ type = lib.types.int;
+ default = 3000;
+ description = ''
+ The port on which herocomics-server will listen for incoming HTTP traffic.
+ '';
+ };
+ server = lib.mkOption {
+ type = lib.types.package;
+ description = "herocomics-server package to use";
+ };
+ client = lib.mkOption {
+ type = lib.types.package;
+ description = "herocomics-client package to use";
+ };
+ domain = lib.mkOption {
+ type = lib.types.str;
+ default = "herocomics.app";
+ description = ''
+ Domain on which to bind herocomics-server. This is passed
+ to services.nginx.virtualHosts.<name> directly.
+ '';
+ };
+ };
+ config = lib.mkIf cfg.enable {
+ systemd.services.herocomics = {
+ path = [ cfg.server ];
+ wantedBy = [ "multi-user.target" ];
+ script = ''
+ ${cfg.server}/bin/mmc
+ '';
+ description = ''
+ Hero Comics app server
+ '';
+ serviceConfig = {
+ KillSignal = "INT";
+ Environment = [
+ "CLIENT_DIR=${cfg.client}/static"
+ "PORT=${toString cfg.port}"
+ ];
+ Type = "simple";
+ Restart = "on-abort";
+ RestartSec = "1";
+ };
+ };
+ services.nginx = {
+ enable = cfg.enable;
+ recommendedGzipSettings = true;
+ recommendedOptimisation = true;
+ recommendedProxySettings = true;
+ recommendedTlsSettings = true;
+ virtualHosts = {
+ "${cfg.domain}" = {
+ forceSSL = true;
+ enableACME = true;
+ locations."/" = {
+ proxyPass = "http://localhost:${toString cfg.port}";
+ };
+ };
+ };
+ };
+ };
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-01 16:33:15 +0000