From 277314a26087276cfef83abbeb8b61bcd3d039fa Mon Sep 17 00:00:00 2001
From: Eduardo Trujillo <ed@chromabits.com>
Date: Sat, 13 Feb 2016 23:16:20 -0500
Subject: [PATCH] New experimental server
---
blog.cabal | 24 ++++++++---
css/app.css | 4 +-
scss/app.scss | 2 +-
server.hs | 108 ++++++++++++++++++++++++++++++++++++++++++++++++++
stack.yaml | 2 +-
5 files changed, 130 insertions(+), 10 deletions(-)
create mode 100644 server.hs
diff --git a/blog.cabal b/blog.cabal
index 7e9888a..e0f37d9 100644
--- a/blog.cabal
+++ b/blog.cabal
@@ -1,13 +1,13 @@
name: blog
version: 0.1.0.0
-synopsis: Hakyll project template from stack
+synopsis: Chromabits blog generator and server
description: Please see README.md
-homepage: http://github.com/githubuser/blog#readme
-license: BSD3
+homepage: http://chromabits.com
+license: MIT
license-file: LICENSE
-author: Author name here
-maintainer: example@example.com
-copyright: 2010 Author Here
+author: Eduardo Trujillo
+maintainer: ed@chromabits.com
+copyright: 2015-2016 Eduardo Trujillo
category: Web
build-type: Simple
cabal-version: >=1.10
@@ -25,3 +25,15 @@ executable blog
containers == 0.5.*,
pandoc == 1.*,
highlighting-kate == 0.6.*
+
+executable server
+ main-is: server.hs
+ default-language: Haskell2010
+ ghc-options: -threaded
+ build-depends: base == 4.*,
+ text,
+ bytestring == 0.10.*,
+ warp == 3.*,
+ wai == 3.*,
+ wai-extra <= 3.0.14,
+ wai-app-static == 3.*
diff --git a/css/app.css b/css/app.css
index a96b461..93cf186 100644
--- a/css/app.css
+++ b/css/app.css
@@ -2895,8 +2895,8 @@ table.hover tr:nth-of-type(even):hover {
* -------------------------- */
@font-face {
font-family: 'FontAwesome';
- src: url("/fonts//fontawesome-webfont.eot?v=4.5.0");
- src: url("/fonts//fontawesome-webfont.eot?#iefix&v=4.5.0") format("embedded-opentype"), url("/fonts//fontawesome-webfont.woff2?v=4.5.0") format("woff2"), url("/fonts//fontawesome-webfont.woff?v=4.5.0") format("woff"), url("/fonts//fontawesome-webfont.ttf?v=4.5.0") format("truetype"), url("/fonts//fontawesome-webfont.svg?v=4.5.0#fontawesomeregular") format("svg");
+ src: url("/fonts/fontawesome-webfont.eot?v=4.5.0");
+ src: url("/fonts/fontawesome-webfont.eot?#iefix&v=4.5.0") format("embedded-opentype"), url("/fonts/fontawesome-webfont.woff2?v=4.5.0") format("woff2"), url("/fonts/fontawesome-webfont.woff?v=4.5.0") format("woff"), url("/fonts/fontawesome-webfont.ttf?v=4.5.0") format("truetype"), url("/fonts/fontawesome-webfont.svg?v=4.5.0#fontawesomeregular") format("svg");
font-weight: normal;
font-style: normal; }
diff --git a/scss/app.scss b/scss/app.scss
index 7eeebdb..f7b71e6 100644
--- a/scss/app.scss
+++ b/scss/app.scss
@@ -39,7 +39,7 @@
@include foundation-tooltip;
@include foundation-top-bar;
-$fa-font-path: "/fonts/";
+$fa-font-path: "/fonts";
@import "font-awesome";
@import "code";
diff --git a/server.hs b/server.hs
new file mode 100644
index 0000000..b7d3f1b
--- /dev/null
+++ b/server.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import qualified Data.ByteString as BS (ByteString, pack)
+import Data.String (fromString)
+import qualified Data.Text as T (Text, concat, pack)
+import qualified Data.Text.Encoding as TE (encodeUtf8)
+import Data.Maybe (mapMaybe, fromMaybe)
+import System.Environment (lookupEnv)
+import Network.Wai (Application, Middleware, pathInfo)
+import Network.Wai.Handler.Warp (run)
+import Network.Wai.Application.Static (staticApp
+ , defaultWebAppSettings
+ , ssIndices
+ , ssRedirectToIndex
+ , ssAddTrailingSlash
+ , ss404Handler
+ )
+import WaiAppStatic.Types (toPiece)
+import Network.Wai.Middleware.RequestLogger (logStdout)
+import Network.Wai.Middleware.Gzip (gzip, def)
+import Network.Wai.Middleware.ForceSSL (forceSSL)
+import Network.Wai.Middleware.ForceDomain (forceDomain)
+import Network.Wai.Middleware.Vhost (redirectTo)
+
+-- | The core application.
+-- It serves files from `_site` whic is where Hakyll will place the generated
+-- site.
+staticSite :: Application
+staticSite = staticApp
+ (defaultWebAppSettings $ fromString "_site")
+ { ssIndices = mapMaybe (toPiece . T.pack) ["index.html"]
+ , ssRedirectToIndex = False
+ , ssAddTrailingSlash = True
+ , ss404Handler = Just redirectApp
+ }
+
+-- | 404 handler.
+-- We will redirect users back to the homepage if the reosurce they are looking
+-- for is not found.
+redirectApp :: Application
+redirectApp req sendResponse = sendResponse $ redirectTo "/"
+
+-- | Gzip compression middleware.
+gzipMiddleware :: Middleware
+gzipMiddleware = gzip def
+
+-- | Domain redirection middleware.
+-- When the site is live, we want to redirect users to the right domain name
+-- regarles of whether they arrive from a www. domain, the server's IP address
+-- or a spoof domain which is pointing to this server.
+domainMiddleware :: Middleware
+domainMiddleware = forceDomain
+ (\domain -> case domain of
+ "localhost" -> Nothing
+ "chromabits.com" -> Nothing
+ _ -> Just "chromabits.com")
+
+-- | De-indefify middleware.
+-- Redirects any path ending in `/index.html` to just `/`.
+deindexifyMiddleware :: Middleware
+deindexifyMiddleware app req sendResponse =
+ if maybeLast (pathInfo req) == Just "index.html"
+ then sendResponse $ redirectTo newPath
+ else app req sendResponse
+ where
+ newPath :: BS.ByteString
+ newPath = TE.encodeUtf8 $ T.concat (map prefixSlash oldPath)
+
+ oldPath :: [T.Text]
+ oldPath = init $ pathInfo req
+
+ prefixSlash :: T.Text -> T.Text
+ prefixSlash x = T.concat ["/", x]
+
+maybeLast :: [a] -> Maybe a
+maybeLast xs = case xs of
+ [] -> Nothing
+ _ -> Just (last xs)
+
+-- | Serves a WAI Application on the specified port.
+-- The target port is printed to stdout before hand, which can be useful for
+-- debugging purposes.
+listen :: Int -> Application -> IO ()
+listen port app = do
+ -- Inform which port we will be listening on.
+ putStrLn $ "Listening on port " ++ show port ++ "..."
+ -- Serve the WAI app using Warp
+ run port app
+
+-- | The entry point of the server application.
+main :: IO ()
+main = do
+ stage <- lookupEnv "BLOG_STAGE"
+
+ -- Depending on the stage we will choose a different set of middleware to
+ -- apply to the application.
+ case fromMaybe "dev" stage of
+ -- "Production"
+ "live" -> listen 80 (logStdout
+ $ domainMiddleware
+ $ deindexifyMiddleware
+ $ gzipMiddleware staticSite
+ )
+ -- "Development"
+ _ -> listen 9090 (logStdout
+ $ deindexifyMiddleware
+ $ gzipMiddleware staticSite
+ )
diff --git a/stack.yaml b/stack.yaml
index ed00a51..e64e9f5 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,7 +1,7 @@
# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md
# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
-resolver: lts-3.14
+resolver: lts-5.2
# Local packages, usually specified by relative directory name
packages:
--
GitLab