111 lines
2.9 KiB
Haskell
111 lines
2.9 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Main (main) where
|
|
|
|
import Data.FileEmbed (embedStringFile)
|
|
import Data.Text.Lazy (Text)
|
|
import Network.Wai.Handler.Warp (Port)
|
|
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
|
|
import Text.Blaze ((!))
|
|
import Text.Blaze.Html.Renderer.Text (renderHtml)
|
|
|
|
import Network.HTTP.Types
|
|
import Network.Wai.Middleware.Gzip
|
|
import Web.Scotty as S
|
|
|
|
import qualified Control.Exception as E
|
|
import qualified Text.Blaze.Html5 as H
|
|
import qualified Text.Blaze.Html5.Attributes as A
|
|
|
|
-- HTML
|
|
index :: H.Html -> Text
|
|
index compiledElmApp = renderHtml $ do
|
|
H.docTypeHtml $ do
|
|
H.head $ do
|
|
H.title "TESTING Scotty+Elm"
|
|
H.meta ! A.charset "utf-8"
|
|
H.style "body{margin:0px;}"
|
|
(H.body ! A.id "body") $ do
|
|
embedJs compiledElmApp
|
|
|
|
-- CONF
|
|
port :: Port
|
|
port = 8080
|
|
|
|
adminContact :: String
|
|
adminContact = "[Matrix] @mtgmonkey:calitabby.net"
|
|
|
|
compiledElmAppFile :: AssetPath
|
|
compiledElmAppFile = "/main.js"
|
|
|
|
boilerplateJsFile :: AssetPath
|
|
boilerplateJsFile = "/init.js"
|
|
|
|
assetsFolder :: FilePath
|
|
assetsFolder = "."
|
|
|
|
compiledElmApp :: H.Html
|
|
compiledElmApp = H.toHtml ($(embedStringFile "./main.js") :: String)
|
|
|
|
boilerplateJs :: H.Html
|
|
boilerplateJs = H.toHtml ($(embedStringFile "./init.js") :: String)
|
|
|
|
-- MAIN
|
|
main :: IO ()
|
|
main = do
|
|
scotty port $ do
|
|
|
|
middleware $ gzip $ def { gzipFiles = GzipCompress }
|
|
middleware logStdoutDev
|
|
|
|
-- GET requests
|
|
get "/" $ do
|
|
h <- header "HTTP_CLIENT_IP"
|
|
r <- header "REMOTE_ADDR"
|
|
let fromMaybe d x = case x of {Nothing -> d;Just v -> v}
|
|
shortCache
|
|
status ok200
|
|
S.html $ index $ do
|
|
compiledElmApp
|
|
boilerplateJs
|
|
H.toHtml $ fromMaybe "HTTP_CLIENT_IP: Nothing" h
|
|
H.toHtml $ fromMaybe "REMOTE_ADDR: Nothing" r
|
|
|
|
get "/favicon.ico/" $ do
|
|
shortCache
|
|
status notFound404
|
|
S.html $ "you want a favi-<i>what</i>now!?"
|
|
|
|
-- ERR
|
|
notFound $ do
|
|
noCache
|
|
status methodNotAllowed405
|
|
S.text "Verb disallowed; OR, route doesn't exist :("
|
|
|
|
|
|
-- FUNC
|
|
serverErrorReadFile :: E.IOException -> Js
|
|
serverErrorReadFile e = H.toHtml $ "document.getElementById('body').innerHTML='Server-side error occurred: "
|
|
++ (show e)
|
|
++ "; report this to a site administrator: "
|
|
++ adminContact
|
|
++ "';"
|
|
|
|
shortCache :: ActionM ()
|
|
shortCache = do
|
|
addHeader "Cache-Control" "max-age=21600"
|
|
addHeader "Onion-Location" "http://mmonkydr7laya5lsrtb4csa5tqlna62cj5qpjuvy726ti4xb3vznneid.onion"
|
|
|
|
noCache :: ActionM ()
|
|
noCache = do
|
|
addHeader "Cache-Control" "no-cache"
|
|
addHeader "Onion-Location" "http://mmonkydr7laya5lsrtb4csa5tqlna62cj5qpjuvy726ti4xb3vznneid.onion"
|
|
|
|
embedJs :: Js -> H.Html
|
|
embedJs js = H.script $ js
|
|
|
|
-- TYPES
|
|
type AssetPath = FilePath
|
|
type Js = H.Html
|