diff options
| -rw-r--r-- | Com/MusicMeetsComics/App.hs | 4 | ||||
| -rw-r--r-- | Com/MusicMeetsComics/Database.hs | 23 | ||||
| -rw-r--r-- | Com/MusicMeetsComics/Look/Typography.hs | 78 | ||||
| -rw-r--r-- | Com/MusicMeetsComics/Prod.nix | 43 | ||||
| -rw-r--r-- | Com/MusicMeetsComics/Server.hs | 189 | ||||
| -rw-r--r-- | Com/MusicMeetsComics/Server/Config.hs | 102 | ||||
| -rw-r--r-- | Com/MusicMeetsComics/Server/Init.hs | 6 | ||||
| -rw-r--r-- | Com/MusicMeetsComics/Service.nix | 76 | ||||
| -rw-r--r-- | default.nix | 17 |
9 files changed, 353 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}"; + }; + }; + }; + }; + }; +} diff --git a/default.nix b/default.nix index ea20799..33ba285 100644 --- a/default.nix +++ b/default.nix @@ -69,6 +69,23 @@ in rec { networking.domain = "que.run"; }; }; + # Production server for musicmeetscomics.com + Com.MusicMeetsComics.Prod = buildOS { + deps = { + herocomics-server = Com.MusicMeetsComics.Server; + herocomics-client = Com.MusicMeetsComics.Client; + }; + configuration = { + imports = [ + ./Com/Simatime/packages.nix + ./Com/Simatime/users.nix + ./Com/MusicMeetsComics/Service.nix + ./Com/MusicMeetsComics/Prod.nix + ]; + networking.hostName = "prod.herocomics.app"; + networking.domain = "herocomcis.app"; + }; + }; # Haskell targets # Com.InfluencedByBooks.Server = biz.buildGhc Com/InfluencedByBooks/Server.hs; |