This commit is contained in:
mtgmonkey 2025-04-24 22:32:10 -04:00
commit f4e4e2eae1
30 changed files with 11452 additions and 0 deletions

25
Makefile Normal file
View file

@ -0,0 +1,25 @@
all: frontend backend
produce: frontend-produce backend
run:
stack exec ~/.local/bin/hs-server-exe
backend:
cd backend && stack install
frontend: frontend-format
cd frontend && elm make src/Main.elm --output=../assets/js/main.js
frontend-produce: frontend-format
cd frontend && elm make src/Main.elm --optimize --output=../assets/js/main
uglifyjs assets/js/main.js --compress "pure_funcs=[F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9],pure_getters,keep_fargs=false,unsafe_comps,unsafe" | uglifyjs --mangle --output assets/js/main.js
frontend-format:
elm-format frontend/src/Main.elm --yes
clean:
touch assets/js/main.js
rm assets/js/main.js
.PHONY: all produce run backend frontend frontend-produce frontend-format clean

1
assets/js/init.js Normal file
View file

@ -0,0 +1 @@
app=Elm.Main.init({flags:localStorage.getItem('cookies')?JSON.parse(localStorage.getItem('cookies')):''});app.ports.setStorage.subscribe(function(c){localStorage.setItem('cookies',JSON.stringify(c))});

9744
assets/js/main.js Normal file

File diff suppressed because it is too large Load diff

2
assets/json/init.json Normal file
View file

@ -0,0 +1,2 @@
{
}

4
assets/json/test.json Normal file
View file

@ -0,0 +1,4 @@
{
"message0": "Hello World!",
"message1": "This is another message. Hello World!"
}

2
backend/.gitignore vendored Normal file
View file

@ -0,0 +1,2 @@
.stack-work/
*~

11
backend/CHANGELOG.md Normal file
View file

@ -0,0 +1,11 @@
# Changelog for `hs-server`
All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
and this project adheres to the
[Haskell Package Versioning Policy](https://pvp.haskell.org/).
## Unreleased
## 0.1.0.0 - YYYY-MM-DD

26
backend/LICENSE Normal file
View file

@ -0,0 +1,26 @@
Copyright 2025 Author name here
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
3. Neither the name of the copyright holder nor the names of its contributors
may be used to endorse or promote products derived from this software
without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

2
backend/README.md Normal file
View file

@ -0,0 +1,2 @@
# hs-server
this is a custom-built single-purpose server infrastructure based on Scorry, Warp, and Wai. It holds up MTGmonkey's personal website

2
backend/Setup.hs Normal file
View file

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

90
backend/app/Main.hs Normal file
View file

@ -0,0 +1,90 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
-- import Lib
import Data.Text.Lazy (Text)
import Network.Wai.Handler.Warp (Port)
import Text.Blaze ((!))
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Network.HTTP.Types
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.style "body{margin:0px;}"
(H.body ! A.id "body") $ do
embedJs compiledElmApp
-- CONF
port :: Port
port = 3000
adminContact :: String
adminContact = "[Matrix] @mtgmonkey:calitabby.net"
compiledElmAppFile :: AssetPath
compiledElmAppFile = "/js/main.js"
boilerplateJsFile :: AssetPath
boilerplateJsFile = "/js/init.js"
assetsFolder :: FilePath
assetsFolder = "./assets"
-- MAIN
main :: IO ()
main = do
compiledElmAppOrExc <- E.try $ readFile $ assetsFolder ++ compiledElmAppFile :: IO (Either E.IOException String)
let compiledElmApp = case compiledElmAppOrExc of
Left e -> serverErrorReadFile e
Right contents -> H.toHtml $ contents
boilerplateJsOrExc <- E.try $ readFile $ assetsFolder ++ boilerplateJsFile :: IO (Either E.IOException String)
let boilerplateJs = case boilerplateJsOrExc of
Left e -> serverErrorReadFile e
Right contents -> H.toHtml $ contents
let anyRoute = regex "^.*$"
scotty port $ do
-- GET requests
get "/" $ do
status ok200
S.html $ index $ do
compiledElmApp
"\n"
boilerplateJs
get "/favicon.ico/" $ do
status notFound404
S.html $ "you want a favi-<i>what</i>now!?"
-- ERR
notFound $ do
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 htis to a site administrator: "
++ adminContact
++ "';"
embedJs :: Js -> H.Html
embedJs js = H.script $ js
-- TYPES
type AssetPath = FilePath
type Js = H.Html

80
backend/hs-server.cabal Normal file
View file

@ -0,0 +1,80 @@
cabal-version: 2.2
-- This file has been generated from package.yaml by hpack version 0.37.0.
--
-- see: https://github.com/sol/hpack
name: hs-server
version: 0.1.0.0
description: Please see README.md
author: mtgmonkey
maintainer: mtgmonkey
copyright: 2025 mtgmonkey
license: BSD-3-Clause
license-file: LICENSE
build-type: Simple
extra-source-files:
README.md
CHANGELOG.md
library
other-modules:
Paths_hs_server
autogen-modules:
Paths_hs_server
hs-source-dirs:
src
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
build-depends:
base >=4.19.2 && <4.20
, blaze-html >=0.9.2 && <0.10
, blaze-markup >=0.8.3 && <0.9
, directory >=1.3.8 && <1.4
, http-types >=0.12.4 && <0.13
, scotty ==0.22.*
, text >=2.1.1 && <2.2
, warp >=3.4.7 && <3.5
default-language: Haskell2010
executable hs-server-exe
main-is: Main.hs
other-modules:
Paths_hs_server
autogen-modules:
Paths_hs_server
hs-source-dirs:
app
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends:
base >=4.19.2 && <4.20
, blaze-html >=0.9.2 && <0.10
, blaze-markup >=0.8.3 && <0.9
, directory >=1.3.8 && <1.4
, hs-server
, http-types >=0.12.4 && <0.13
, scotty ==0.22.*
, text >=2.1.1 && <2.2
, warp >=3.4.7 && <3.5
default-language: Haskell2010
test-suite hs-server-test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
Paths_hs_server
autogen-modules:
Paths_hs_server
hs-source-dirs:
test
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends:
base >=4.19.2 && <4.20
, blaze-html >=0.9.2 && <0.10
, blaze-markup >=0.8.3 && <0.9
, directory >=1.3.8 && <1.4
, hs-server
, http-types >=0.12.4 && <0.13
, scotty ==0.22.*
, text >=2.1.1 && <2.2
, warp >=3.4.7 && <3.5
default-language: Haskell2010

65
backend/package.yaml Normal file
View file

@ -0,0 +1,65 @@
name: hs-server
version: 0.1.0.0
license: BSD-3-Clause
author: "mtgmonkey"
maintainer: "mtgmonkey"
copyright: "2025 mtgmonkey"
extra-source-files:
- README.md
- CHANGELOG.md
# Metadata used when publishing your package
# synopsis: Short description of your package
# category: Web
# To avoid duplicated efforts in documentation and dealing with the
# complications of embedding Haddock markup inside cabal files, it is
# common to point users to the README.md file.
description: Please see README.md
dependencies:
- base >= 4.19.2 && < 4.20
- blaze-html >= 0.9.2 && < 0.10
- blaze-markup >= 0.8.3 && < 0.9
- directory >= 1.3.8 && < 1.4
- http-types >= 0.12.4 && < 0.13
- scotty >= 0.22 && < 0.23
- text >= 2.1.1 && < 2.2
- warp >= 3.4.7 && < 3.5
ghc-options:
- -Wall
- -Wcompat
- -Widentities
- -Wincomplete-record-updates
- -Wincomplete-uni-patterns
- -Wmissing-export-lists
- -Wmissing-home-modules
- -Wpartial-fields
- -Wredundant-constraints
library:
source-dirs: src
executables:
hs-server-exe:
main: Main.hs
source-dirs: app
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- hs-server
tests:
hs-server-test:
main: Spec.hs
source-dirs: test
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- hs-server

74
backend/stack.yaml Normal file
View file

@ -0,0 +1,74 @@
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# https://docs.haskellstack.org/en/stable/yaml_configuration/
# A 'specific' Stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# snapshot: lts-22.28
# snapshot: nightly-2024-07-05
# snapshot: ghc-9.6.6
#
# The location of a snapshot can be provided as a file or url. Stack assumes
# a snapshot provided as a file might change, whereas a url resource does not.
#
# snapshot: ./custom-snapshot.yaml
# snapshot: https://example.com/snapshots/2024-01-01.yaml
snapshot:
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/19.yaml
# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# subdirs:
# - auto-update
# - wai
#
# packages is represented in package.yaml
packages:
- .
nix:
enable: true
packages: [zlib]
# Dependency packages to be pulled from upstream that are not in the snapshot.
# These entries can reference officially published versions as well as
# forks / in-progress versions pinned to a git hash. For example:
#
# extra-deps:
# - acme-missiles-0.3
# - git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#
# extra-deps: []
# Override default flag values for project packages and extra-deps
# flags: {}
# Extra package databases containing global packages
# extra-package-dbs: []
# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of Stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=3.1"
#
# Override the architecture used by Stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by Stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor

13
backend/stack.yaml.lock Normal file
View file

@ -0,0 +1,13 @@
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
packages: []
snapshots:
- completed:
sha256: 296a7960c37efa382432ab497161a092684191815eb92a608c5d6ea5f894ace3
size: 683835
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/19.yaml
original:
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/19.yaml

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View file

Binary file not shown.

33
frontend/elm.json Normal file
View file

@ -0,0 +1,33 @@
{
"type": "application",
"source-directories": [
"src"
],
"elm-version": "0.19.1",
"dependencies": {
"direct": {
"elm/browser": "1.0.2",
"elm/core": "1.0.5",
"elm/html": "1.0.0",
"elm/json": "1.1.3",
"elm/url": "1.0.0",
"lobanov/elm-localstorage": "1.0.1",
"rtfeldman/elm-css": "18.0.0"
},
"indirect": {
"elm/bytes": "1.0.8",
"elm/file": "1.0.5",
"elm/http": "2.0.0",
"elm/random": "1.0.0",
"elm/time": "1.0.0",
"elm/virtual-dom": "1.0.3",
"lobanov/elm-taskport": "2.0.1",
"robinheghan/murmur3": "1.0.0",
"rtfeldman/elm-hex": "1.0.0"
}
},
"test-dependencies": {
"direct": {},
"indirect": {}
}
}

81
frontend/index.def.html Normal file
View file

@ -0,0 +1,81 @@
<!DOCTYPE HTML>
<html>
<head>
<meta charset="utf8">
<title>Main</title>
<style>
body {
margin: 0;
padding: 0;
background-color: #000000;
}
</style>
<script src="main.js"></script>
</head>
<body>
<script>
var app;
// call main with data from ./init.json and initialisation function
callWithServerData('./init.json', main, init)
// FUNCTIONS
// takes pertinent data and returns an app
// serverData : Object
// cookies : Object
function init(serverData, cookies) {
const flags = {...serverData, ...cookies};
app = Elm.Main.init({
flags: flags
});
app.ports.setStorage.subscribe(setStorage);
app.ports.refresh.subscribe(main);
}
// main 'loop'
// serverData : Object
// init : Function
function main(serverData, init) {
const cookies = localStorage.getItem('cookies') ? JSON.parse(localStorage.getItem('cookies')) : "";
init(serverData, cookies);
// XXX send test server data to getTestFromServer
// callWithServerData('./test.json', app.ports.getTestFromServer.send);
}
// passes the content of json at path to the function toCall
// path : String
// toCall : Function
function callWithServerData(path, toCall, ...args) {
fetch(path)
.then(response => response.json())
.then(data => {
if (toCall === main) {
toCall(data, args[0]);
} else {
toCall(data, args);
}
})
.catch(err => {
console.error('Err ', err.message);
const data = "";
if (toCall === main) {
toCall(data, args[0]);
} else {
toCall(data, args);
}
});
}
// sets localStorage cookies to passed cookies value
// cookies : Object
function setStorage(cookies) {
localStorage.setItem('cookies', JSON.stringify(cookies));
}
</script>
</body>
</html>

9
frontend/shell.nix Normal file
View file

@ -0,0 +1,9 @@
{pkgs ? import <nixpkgs> {}}:
pkgs.mkShell {
nativeBuildInputs = [
pkgs.elmPackages.elm
pkgs.elmPackages.elm-format
pkgs.uglify-js
pkgs.ungoogled-chromium
];
}

1165
frontend/src/Main.elm Normal file

File diff suppressed because it is too large Load diff

21
shell.nix Normal file
View file

@ -0,0 +1,21 @@
{pkgs ? import <nixpkgs> {}}: let
elmInputs = [
pkgs.elmPackages.elm
pkgs.elmPackages.elm-format
pkgs.uglify-js
];
haskellInputs = [
pkgs.stack
];
cliTools = [
pkgs.httpie
pkgs.ungoogled-chromium
];
in
pkgs.mkShell {
nativeBuildInputs = [
elmInputs
haskellInputs
cliTools
];
}

1
src/Main.elm Symbolic link
View file

@ -0,0 +1 @@
../frontend/src/Main.elm

1
src/Main.hs Symbolic link
View file

@ -0,0 +1 @@
../backend/app/Main.hs