From 7e8daca015e580069357eb61acff8206a150e2ba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Johannes=20L=C3=B6tzsch?= Date: Sun, 6 Mar 2022 23:09:59 +0100 Subject: [PATCH] backend: template (from swlkup) TODO: * debug why http://localhost:4000/graphiql/index.html doesn't load * adapt tests from swlkup * adapt flake from swlkup and test build pipeline --- backend/.clj-kondo/config.edn | 4 + backend/.gitattributes | 3 + backend/.gitignore | 15 +++ backend/DB.md | 23 ++++ backend/nix/beherbergung-backend.nix | 63 +++++++++++ backend/nix/tools/updated-deps.nix | 16 +++ backend/project.clj | 52 +++++++++ backend/resources/mock/mail | 9 ++ backend/resources/public/graphiql/index.html | 60 +++++++++++ backend/src/beherbergung/auth/admin.clj | 10 ++ backend/src/beherbergung/auth/core.clj | 19 ++++ .../src/beherbergung/auth/jwt/defaults.clj | 19 ++++ backend/src/beherbergung/auth/jwt/login.clj | 11 ++ backend/src/beherbergung/auth/jwt/state.clj | 10 ++ .../auth/mail/local/mailutils.clj | 11 ++ backend/src/beherbergung/auth/mail/send.clj | 16 +++ .../beherbergung/auth/password/generate.clj | 10 ++ .../src/beherbergung/auth/password/hash.clj | 13 +++ .../beherbergung/auth/password/verify_db.clj | 24 +++++ .../src/beherbergung/auth/token/generate.clj | 11 ++ backend/src/beherbergung/auth/uuid/core.clj | 6 ++ backend/src/beherbergung/config/state.clj | 68 ++++++++++++ backend/src/beherbergung/db/export.clj | 25 +++++ backend/src/beherbergung/db/seed/example.edn | 23 ++++ backend/src/beherbergung/db/state.clj | 81 ++++++++++++++ backend/src/beherbergung/db/validate.clj | 46 ++++++++ backend/src/beherbergung/model/auth.clj | 12 +++ backend/src/beherbergung/model/export.clj | 7 ++ backend/src/beherbergung/model/login.clj | 20 ++++ backend/src/beherbergung/model/ngo.clj | 20 ++++ backend/src/beherbergung/resolver/core.clj | 40 +++++++ .../resolver/root/admin/Export.md | 10 ++ .../resolver/root/admin/export.clj | 23 ++++ .../src/beherbergung/resolver/root/login.clj | 17 +++ .../resolver/root/ngo/ngo_example.clj | 22 ++++ .../beherbergung/security/encryption/gpg.clj | 17 +++ .../src/beherbergung/webserver/handler.clj | 42 ++++++++ .../src/beherbergung/webserver/middleware.clj | 102 ++++++++++++++++++ backend/src/beherbergung/webserver/state.clj | 25 +++++ backend/src/config.edn | 24 +++++ backend/src/lib/graphql/middleware.clj | 19 ++++ backend/src/lib/resources/list_resources.clj | 41 +++++++ 42 files changed, 1089 insertions(+) create mode 100644 backend/.clj-kondo/config.edn create mode 100644 backend/.gitattributes create mode 100644 backend/.gitignore create mode 100644 backend/DB.md create mode 100644 backend/nix/beherbergung-backend.nix create mode 100644 backend/nix/tools/updated-deps.nix create mode 100644 backend/project.clj create mode 100755 backend/resources/mock/mail create mode 100644 backend/resources/public/graphiql/index.html create mode 100644 backend/src/beherbergung/auth/admin.clj create mode 100644 backend/src/beherbergung/auth/core.clj create mode 100644 backend/src/beherbergung/auth/jwt/defaults.clj create mode 100644 backend/src/beherbergung/auth/jwt/login.clj create mode 100644 backend/src/beherbergung/auth/jwt/state.clj create mode 100644 backend/src/beherbergung/auth/mail/local/mailutils.clj create mode 100644 backend/src/beherbergung/auth/mail/send.clj create mode 100644 backend/src/beherbergung/auth/password/generate.clj create mode 100644 backend/src/beherbergung/auth/password/hash.clj create mode 100644 backend/src/beherbergung/auth/password/verify_db.clj create mode 100644 backend/src/beherbergung/auth/token/generate.clj create mode 100644 backend/src/beherbergung/auth/uuid/core.clj create mode 100644 backend/src/beherbergung/config/state.clj create mode 100644 backend/src/beherbergung/db/export.clj create mode 100644 backend/src/beherbergung/db/seed/example.edn create mode 100644 backend/src/beherbergung/db/state.clj create mode 100644 backend/src/beherbergung/db/validate.clj create mode 100644 backend/src/beherbergung/model/auth.clj create mode 100644 backend/src/beherbergung/model/export.clj create mode 100644 backend/src/beherbergung/model/login.clj create mode 100644 backend/src/beherbergung/model/ngo.clj create mode 100644 backend/src/beherbergung/resolver/core.clj create mode 100644 backend/src/beherbergung/resolver/root/admin/Export.md create mode 100644 backend/src/beherbergung/resolver/root/admin/export.clj create mode 100644 backend/src/beherbergung/resolver/root/login.clj create mode 100644 backend/src/beherbergung/resolver/root/ngo/ngo_example.clj create mode 100644 backend/src/beherbergung/security/encryption/gpg.clj create mode 100644 backend/src/beherbergung/webserver/handler.clj create mode 100644 backend/src/beherbergung/webserver/middleware.clj create mode 100644 backend/src/beherbergung/webserver/state.clj create mode 100644 backend/src/config.edn create mode 100644 backend/src/lib/graphql/middleware.clj create mode 100644 backend/src/lib/resources/list_resources.clj diff --git a/backend/.clj-kondo/config.edn b/backend/.clj-kondo/config.edn new file mode 100644 index 0000000..fbb8df5 --- /dev/null +++ b/backend/.clj-kondo/config.edn @@ -0,0 +1,4 @@ +{:lint-as {mount.core/defstate clojure.core/declare + specialist-server.type/defscalar clojure.core/declare + specialist-server.type/defobject clojure.core/declare + #_#_orchestra.core/defn-spec clojure.core/declare}} diff --git a/backend/.gitattributes b/backend/.gitattributes new file mode 100644 index 0000000..7388b37 --- /dev/null +++ b/backend/.gitattributes @@ -0,0 +1,3 @@ +**/mvn2nix-lock.json linguist-generated + +target linguist-generated diff --git a/backend/.gitignore b/backend/.gitignore new file mode 100644 index 0000000..cdf2f29 --- /dev/null +++ b/backend/.gitignore @@ -0,0 +1,15 @@ +/target +/lib +/classes +/checkouts +pom.xml.asc +*.jar +*.class +/.lein-env +/.lein-repl-history +/.lein-failures +/.nrepl-port +/.lsp +/.clj-kondo/.cache +result +data diff --git a/backend/DB.md b/backend/DB.md new file mode 100644 index 0000000..7b99241 --- /dev/null +++ b/backend/DB.md @@ -0,0 +1,23 @@ +# Access via repl: + +```bash +lein repl ## from somewhere within the `backend` directory +``` + +```clojure-repl +(require '[beherbergung.db.state :refer [db_ctx]]) ;; get a database context +(require '[clojure.pprint :refer [pprint]]) + +;; This example queries all offers +(pprint ((:q db_ctx) '{:find [(pull ?e [*])] + :where [[?e :xt/spec :beherbergung.model.offers/record]]})) +``` + +To learn more about the datalog query syntax, please use the [XTDB language reference](https://docs.xtdb.com/language-reference/datalog-queries/). + + +# Web UI + +If you are looking for a Web UI for inspecting the XTDB database, you may want use [XTDB inspector](https://github.com/tatut/xtdb-inspector). + +It is a separate project and not bundled into beherbergung. To connect to your database, you will need to adjust `dev-src/user.clj`. diff --git a/backend/nix/beherbergung-backend.nix b/backend/nix/beherbergung-backend.nix new file mode 100644 index 0000000..b527dd8 --- /dev/null +++ b/backend/nix/beherbergung-backend.nix @@ -0,0 +1,63 @@ +{ pkgs ? import {}, + buildMavenRepositoryFromLockFile ? (import (fetchTarball "https://github.com/johannesloetzsch/mvn2nix/archive/master.tar.gz") {}).buildMavenRepositoryFromLockFile, + patchPublic ? null +}: +let + inherit (pkgs) lib stdenv jdk11_headless maven makeWrapper leiningen; + inherit (stdenv) mkDerivation; + + mavenRepository = buildMavenRepositoryFromLockFile { file = ./deps/mvn2nix-lock.json; }; + + src = mkDerivation { + name = "beherbergung-backend-src"; + src = lib.cleanSource ./..; + installPhase = '' + cp -r . $out + ''; + }; + + version = "0.0.1"; + pname = "beherbergung-backend"; + name = "${pname}-${version}"; + + beherbergung-backend-jar = mkDerivation rec { + inherit src version pname name; + + buildInputs = [ jdk11_headless maven leiningen ]; + patchPhase = if isNull patchPublic + then "" + else "cp -r ${patchPublic}/* resources/public/"; + buildPhase = '' + echo "Building with maven repository ${mavenRepository}" + export HOME=`pwd` + mkdir .lein + echo '{:user {:offline? true :local-repo "${mavenRepository}"}}' > ~/.lein/profiles.clj + lein uberjar + ''; + + doCheck = true; + checkPhase = '' + lein test + ''; + + installPhase = '' + mkdir $out + cp target/${name}-standalone.jar $out/ + ''; + }; +in +lib.mergeAttrs + (pkgs.writeScriptBin "${pname}" '' + #!${pkgs.runtimeShell} + + ${pkgs.which}/bin/which mail || export PATH=./backend/resources/mock:$PATH + + ## TODO: JAVA_TOOL_OPTIONS should be generated from jvm-opts in project.clj and also update beherbergung.service + export MALLOC_ARENA_MAX=2 + export JAVA_TOOL_OPTIONS='-Dclojure.tools.logging.factory=clojure.tools.logging.impl/slf4j-factory -Dorg.slf4j.simpleLogger.defaultLogLevel=warn -Dlog4j2.formatMsgNoLookups=true' + ${jdk11_headless}/bin/java -jar ${beherbergung-backend-jar}/${name}-standalone.jar $@ & + + ## We write a pid-file, so the integration test knows how to kill the server + echo $! > .pid + '') + { inherit mavenRepository; jar = beherbergung-backend-jar; } diff --git a/backend/nix/tools/updated-deps.nix b/backend/nix/tools/updated-deps.nix new file mode 100644 index 0000000..f6a6b78 --- /dev/null +++ b/backend/nix/tools/updated-deps.nix @@ -0,0 +1,16 @@ +{ pkgs ? import {}, + mvn2nix ? (import (fetchTarball "https://github.com/johannesloetzsch/mvn2nix/archive/master.tar.gz") {}).mvn2nix +}: +(pkgs.writeScriptBin "backendUpdatedDeps" '' + #!${pkgs.runtimeShell} -e + + ## TODO + #${pkgs.leiningen}/bin/lein pom + echo 'Call `lein pom` yourself and than add explicitly add maven-compiler-plugin in an up to date version' + echo + echo 'When you changed dependencies, you also want run nvd-check' + echo + + echo "Generating mvn2nix-lock.json, please wait…" + ${mvn2nix}/bin/mvn2nix --repositories https://clojars.org/repo https://repo.maven.apache.org/maven2 > nix/deps/mvn2nix-lock.json +'') diff --git a/backend/project.clj b/backend/project.clj new file mode 100644 index 0000000..6ff84e5 --- /dev/null +++ b/backend/project.clj @@ -0,0 +1,52 @@ +(defproject beherbergung-backend "0.0.1" + :description "beherbergung (private hosting of refugees) backend" + :min-lein-version "2.0.0" + :dependencies [;; core + [org.clojure/clojure "1.10.3"] + [yogthos/config "1.2.0"] + [mount "0.1.16"] + [spootnik/signal "0.2.4"] + ;; db + [com.xtdb/xtdb-core "1.20.0"] + [com.xtdb/xtdb-rocksdb "1.20.0"] + ;; graphql + http + [org.clojars.johannesloetzsch/specialist-server "0.7.0" :exclusions [com.ibm.icu/icu4j]] + [compojure "1.6.2"] + [ring/ring-core "1.9.5"] + [ring/ring-jetty-adapter "1.9.5"] + [ring/ring-devel "1.9.5"] + [ring-cors "0.1.13"] + [ring/ring-json "0.5.1" :exclusions [cheshire]] + [cheshire "5.10.2"] + [ring-json-response "0.2.0"] + [co.deps/ring-etag-middleware "0.2.1"] + ;; auth + mail + [cryptohash-clj "0.1.10"] + [likid_geimfari/secrets "1.1.1"] + [crypto-random "1.2.1"] + [buddy/buddy-sign "3.4.333"] + #_[com.draines/postal "2.0.4"] + ;; graphiql ;; TODO not required for productive build + [ring-webjars "0.2.0" :exclusions [org.webjars/webjars-locator]] + [org.webjars/webjars-locator "0.45"] + [org.webjars/graphiql "0.11.11"] + [org.webjars.npm/react "18.0.0-rc.1" :exclusions [org.webjars.npm/loose-envify org.webjars.npm/js-tokens org.webjars.npm/object-assign]] + [org.webjars.npm/react-dom "17.0.2" :exclusions [org.webjars.npm/loose-envify org.webjars.npm/js-tokens org.webjars.npm/object-assign org.webjars.npm/scheduler]] + ;; logging + [org.clojure/tools.logging "1.2.4"] + [org.slf4j/slf4j-api "2.0.0-alpha6"] + [org.slf4j/slf4j-simple "2.0.0-alpha6"] + ] + :main beherbergung.webserver.state + :profiles {:dev {:dependencies [;; helpers for testing + [javax.servlet/servlet-api "2.5"] + [ring/ring-mock "0.4.0"] + ;; additional deps to run `lein test` + [nrepl/nrepl "0.9.0"] + [clojure-complete/clojure-complete "0.2.5"]] + #_#_:jvm-opts ["-Dverbose=true"]} + :test {:jvm-opts ["-Ddb-inmemory=true" "-Ddb-export-prefix="]} + :uberjar {:aot :all}} + :jvm-opts ["-Dclojure.tools.logging.factory=clojure.tools.logging.impl/slf4j-factory" ;; used by yogthos/config and com.xtdb/xtdb-core + "-Dorg.slf4j.simpleLogger.defaultLogLevel=warn" ;; usded by jetty (via ring/ring-jetty-adapter) + "-Dlog4j2.formatMsgNoLookups=true"]) ;; not required, since log4j is no runtime dependency, but for defense-in-depth diff --git a/backend/resources/mock/mail b/backend/resources/mock/mail new file mode 100755 index 0000000..450df28 --- /dev/null +++ b/backend/resources/mock/mail @@ -0,0 +1,9 @@ +#!/usr/bin/env bash + +## During development and testing you can use this mock as a replacement for GNU Mailutils. +## Just set: PATH=$PATH:backend/resources/mock + +FILE="/tmp/mail.log" +echo $@ >> $FILE +cat >> $FILE +echo >> $FILE diff --git a/backend/resources/public/graphiql/index.html b/backend/resources/public/graphiql/index.html new file mode 100644 index 0000000..6ed64eb --- /dev/null +++ b/backend/resources/public/graphiql/index.html @@ -0,0 +1,60 @@ + + + + + + + + + + + + + + +
Loading...
+ + + diff --git a/backend/src/beherbergung/auth/admin.clj b/backend/src/beherbergung/auth/admin.clj new file mode 100644 index 0000000..2d7c0e8 --- /dev/null +++ b/backend/src/beherbergung/auth/admin.clj @@ -0,0 +1,10 @@ +(ns beherbergung.auth.admin + (:require [beherbergung.config.state :refer [env]])) + +(defn admin? + "For now, we require only one administrator login. + It can be configured by the environmment variable ADMIN_PASSPHRASE + " + [passphrase] + (and (:admin-passphrase env) + (= passphrase (:admin-passphrase env)))) diff --git a/backend/src/beherbergung/auth/core.clj b/backend/src/beherbergung/auth/core.clj new file mode 100644 index 0000000..ec2d416 --- /dev/null +++ b/backend/src/beherbergung/auth/core.clj @@ -0,0 +1,19 @@ +(ns beherbergung.auth.core + (:require [beherbergung.auth.password.verify-db :refer [login->id id->roles+entities]] + [beherbergung.auth.jwt.login :refer [jwt->id]])) + +(defn auth->id [ctx auth] + (cond (:jwt auth) + (jwt->id (:jwt auth)) + (and (:mail auth) (:password auth)) + (login->id ctx (:mail auth) (:password auth)))) + +(defn auth+role->entity + [ctx auth role] + (let [login:id (auth->id ctx auth) + roles+entities (id->roles+entities ctx login:id) + entities (->> (filter #(= role (:role %)) roles+entities) + (map :entity))] + (when (and login:id + (<= (count entities) 1)) + [(first entities) login:id]))) diff --git a/backend/src/beherbergung/auth/jwt/defaults.clj b/backend/src/beherbergung/auth/jwt/defaults.clj new file mode 100644 index 0000000..bc8d6e8 --- /dev/null +++ b/backend/src/beherbergung/auth/jwt/defaults.clj @@ -0,0 +1,19 @@ +(ns beherbergung.auth.jwt.defaults + (:require [beherbergung.auth.jwt.state :refer [secret]] + [buddy.sign.jwt] + [buddy.sign.util :refer [now]])) + +(def default_validity:seconds (* 24 60 60)) ;; 1 Day + +(defn sign + "Wrap around buddy.sign.jwt/sign, using the secret provided by mount and adds an expiration date." + ([data] + (sign data default_validity:seconds)) + ([data validity] + (when (< (count secret) beherbergung.auth.jwt.state/secret_length:bytes) + (throw (Exception. "Secret too short"))) + (buddy.sign.jwt/sign (assoc data :exp (+ (now) validity)) + secret))) + +(defn unsign [jwt] + (buddy.sign.jwt/unsign jwt secret)) diff --git a/backend/src/beherbergung/auth/jwt/login.clj b/backend/src/beherbergung/auth/jwt/login.clj new file mode 100644 index 0000000..6ba5402 --- /dev/null +++ b/backend/src/beherbergung/auth/jwt/login.clj @@ -0,0 +1,11 @@ +(ns beherbergung.auth.jwt.login + (:require [beherbergung.auth.password.verify-db :refer [login->id]] + [beherbergung.auth.jwt.defaults :refer [sign unsign]])) + +(defn login [ctx mail password] + (let [login:id (login->id ctx mail password)] + (when login:id + (sign {:sub login:id})))) + +(defn jwt->id [jwt] + (:sub (unsign jwt))) diff --git a/backend/src/beherbergung/auth/jwt/state.clj b/backend/src/beherbergung/auth/jwt/state.clj new file mode 100644 index 0000000..84c6f69 --- /dev/null +++ b/backend/src/beherbergung/auth/jwt/state.clj @@ -0,0 +1,10 @@ +(ns beherbergung.auth.jwt.state + (:require [crypto.random] + [mount.core :as mount :refer [defstate]] + [beherbergung.config.state])) + +(def secret_length:bytes 64) ;; recommended by https://cheatsheetseries.owasp.org/cheatsheets/JSON_Web_Token_for_Java_Cheat_Sheet.html#weak-token-secret + +(defstate secret + :start (or (:jwt-secret beherbergung.config.state/env) + (crypto.random/bytes secret_length:bytes))) diff --git a/backend/src/beherbergung/auth/mail/local/mailutils.clj b/backend/src/beherbergung/auth/mail/local/mailutils.clj new file mode 100644 index 0000000..536e462 --- /dev/null +++ b/backend/src/beherbergung/auth/mail/local/mailutils.clj @@ -0,0 +1,11 @@ +(ns beherbergung.auth.mail.local.mailutils + (:require [clojure.java.shell :refer [sh]])) + +(defn send-message + "A plugin replacement for com.draines/postal to be used with GNU Mailutils" + ([_server msg] (send-message msg)) + ([msg] + (sh "mail" "-s" (str (:subject msg)) + (str "-aFrom:" (:from msg)) + (str (:to msg)) + :in (str (:body msg))))) diff --git a/backend/src/beherbergung/auth/mail/send.clj b/backend/src/beherbergung/auth/mail/send.clj new file mode 100644 index 0000000..cde1824 --- /dev/null +++ b/backend/src/beherbergung/auth/mail/send.clj @@ -0,0 +1,16 @@ +(ns beherbergung.auth.mail.send + (:require ;[postal.core :refer [send-message]] + [beherbergung.auth.mail.local.mailutils :refer [send-message]] + [beherbergung.config.state :refer [env]])) + +(defn send-mail [msg*] + (let [server {:host (:mail-host env) + :user (:mail-user env) + :pass (:mail-pass env) + :port (:mail-port env) + :tls true} + msg (assoc msg* :from (or (:mail-from env) + (:mail-user-from env))) + result (send-message server msg)] + (or (= :SUCCESS (:error result)) + (= 0 (:exit result))))) diff --git a/backend/src/beherbergung/auth/password/generate.clj b/backend/src/beherbergung/auth/password/generate.clj new file mode 100644 index 0000000..42e6703 --- /dev/null +++ b/backend/src/beherbergung/auth/password/generate.clj @@ -0,0 +1,10 @@ +(ns beherbergung.auth.password.generate + (:require [secrets.core :refer [choices]] + [secrets.constants :refer [ascii-letters digits punctuation]] + [clojure.string :refer [join]])) + +(defn generate-password [] + (let [length 20 + characters (str ascii-letters digits punctuation)] + (->> (choices characters length) + (join "")))) diff --git a/backend/src/beherbergung/auth/password/hash.clj b/backend/src/beherbergung/auth/password/hash.clj new file mode 100644 index 0000000..e0e9fcd --- /dev/null +++ b/backend/src/beherbergung/auth/password/hash.clj @@ -0,0 +1,13 @@ +(ns beherbergung.auth.password.hash + (:require [cryptohash-clj.api :refer [hash-with verify-with]])) + +(defn hash-password [password] + (let [algo :argon2 + args {}] + (hash-with algo password args))) + +(defn verify-password [password pwhash] + (if (empty? pwhash) + false + (let [algo :argon2] + (verify-with algo password pwhash)))) diff --git a/backend/src/beherbergung/auth/password/verify_db.clj b/backend/src/beherbergung/auth/password/verify_db.clj new file mode 100644 index 0000000..0b0c07b --- /dev/null +++ b/backend/src/beherbergung/auth/password/verify_db.clj @@ -0,0 +1,24 @@ +(ns beherbergung.auth.password.verify-db + (:require [beherbergung.auth.password.hash :refer [verify-password]])) + +(defn login->id [ctx mail password] + (let [{:keys [q_id]} (:db_ctx ctx) + [login:id password:hash] (q_id '{:find [<-login:id <-password:hash] + :where [[?l :xt/spec :beherbergung.model.login/record] + [?l :mail ->mail] + [?l :xt/id <-login:id] + [?l :password-hash <-password:hash]] + :in [->mail]} + mail) + valid (verify-password password password:hash)] + (when valid login:id))) + +(defn id->roles+entities [ctx login:id] + (let [{:keys [q]} (:db_ctx ctx)] + (q '{:keys [role entity] + :find [<-role <-entity:id] + :where [[?e :beherbergung.model.login/login:ids <-login:id] + [?e :xt/spec <-role] + [?e :xt/id <-entity:id]] + :in [<-login:id]} + login:id))) diff --git a/backend/src/beherbergung/auth/token/generate.clj b/backend/src/beherbergung/auth/token/generate.clj new file mode 100644 index 0000000..d4c52c9 --- /dev/null +++ b/backend/src/beherbergung/auth/token/generate.clj @@ -0,0 +1,11 @@ +(ns beherbergung.auth.token.generate + (:require [crypto.random :refer [base32]])) + +(defn generate-token + "A 8 character base32 string should be user friendly. + It gives us an entropy of 40 Bit = 5 Byte. + + We never use it as cryptographic secret for encryption or signing or any other function that can be bruteforced locally by an attacker. + The entrophy is therefore only relevant for the expected amount of requests to the server an attacker would need to try." + [] + (base32 5)) diff --git a/backend/src/beherbergung/auth/uuid/core.clj b/backend/src/beherbergung/auth/uuid/core.clj new file mode 100644 index 0000000..8ab4d98 --- /dev/null +++ b/backend/src/beherbergung/auth/uuid/core.clj @@ -0,0 +1,6 @@ +(ns beherbergung.auth.uuid.core) + +(defn uuid + "Using version 4 (random) UUIDs, we avoid exposing the creation date of database records." + [] + (str (java.util.UUID/randomUUID))) diff --git a/backend/src/beherbergung/config/state.clj b/backend/src/beherbergung/config/state.clj new file mode 100644 index 0000000..caaaddc --- /dev/null +++ b/backend/src/beherbergung/config/state.clj @@ -0,0 +1,68 @@ +(ns beherbergung.config.state + "Wrapping yogthos/config with defstate allows overwriting the config at runtime and checking it at startup against a spec" + (:require [clojure.spec.alpha :as s] + [mount.core :refer [defstate args]] + [config.core] + [clojure.string])) + +(s/def ::verbose boolean?) + +(s/def ::port number?) ;; the webserver port + +(s/def ::validate-output boolean?) ;; should specialist ensure type correctness + +(s/def ::db-inmemory boolean?) ;; we run unit tests in an in-memory instance, otherwise the default db would be looked +(s/def ::db-dir string?) ;; ignored when ::db-inmemory +(s/def ::db-seed string?) ;; an edn-file to be used for seeding +(s/def ::db-export-prefix (s/nilable string?)) ;; path where during startup an export should be written +(s/def ::db-validate boolean?) + +(s/def ::mail-host string?) +(s/def ::mail-user string?) +(s/def ::mail-pass string?) +(s/def ::mail-port number?) +(s/def ::mail-from (s/nilable string?)) + +(s/def ::admin-passphrase (s/nilable string?)) ;; allows setting up ngo logins and encrypted downloads of db exports +(s/def ::admin-gpg-id string?) + +(s/def ::frontend-base-url string?) +(s/def ::frontend-backend-base-url string?) + +(s/def ::env (s/keys :req-un [::verbose + ::port + ::validate-output + ::db-inmemory ::db-dir + ::db-seed ::db-export-prefix + ::db-validate + ;::mail-host ::mail-user ::mail-pass ::mail-port ::mail-from + ::admin-passphrase + ::admin-gpg-id + ::frontend-base-url + ::frontend-backend-base-url])) + +(defn strip-secrets [env] + (assoc env :mail-pass "*" + :admin-passphrase "*")) + +(defn filter-defined [keys-spec m] + (let [req-un (last (s/form keys-spec)) + unnamespaced-keys (map #(-> (clojure.string/replace % + (if-let [n (namespace %)] + (str n "/") + "") + "") + (clojure.string/replace ":" "") + keyword) + req-un)] + (select-keys m (into [] unnamespaced-keys)))) + +(defstate env + :start (let [env (->> (merge (config.core/load-env) + (args)) ;; allows: (mount/start-with-args {…}) + (filter-defined ::env)) + config-errors (s/explain-data ::env env)] + (when (:verbose env) + (println (strip-secrets env))) + (assert (not config-errors) (with-out-str (s/explain-out config-errors))) + env)) diff --git a/backend/src/beherbergung/db/export.clj b/backend/src/beherbergung/db/export.clj new file mode 100644 index 0000000..65de278 --- /dev/null +++ b/backend/src/beherbergung/db/export.clj @@ -0,0 +1,25 @@ +(ns beherbergung.db.export + (:require [clojure.pprint :refer [pprint]] + [clojure.edn])) + +(defn all_docs [db_ctx] + (let [{:keys [sync q_unary]} db_ctx] + (sync) + (q_unary '{:find [(pull ?e [*])] :where [[?e :xt/id]]}))) + +(defn edn->pprint [edn] + (with-out-str (pprint edn))) + +(defn write-edn [file docs] + (->> (edn->pprint docs) + (spit file))) + +(defn export [file db_ctx] + (->> (all_docs db_ctx) + (write-edn file))) + +(defn seed [file db_ctx] + (let [{:keys [tx_sync]} db_ctx] + (->> (clojure.edn/read-string (slurp file)) + (map (fn [entry] [:xtdb.api/put entry])) + tx_sync))) diff --git a/backend/src/beherbergung/db/seed/example.edn b/backend/src/beherbergung/db/seed/example.edn new file mode 100644 index 0000000..cd0b8d7 --- /dev/null +++ b/backend/src/beherbergung/db/seed/example.edn @@ -0,0 +1,23 @@ +[ + {:xt/id "lifeline" + :xt/spec :beherbergung.model.ngo/record + :name "Mission Lifeline" + :beherbergung.model.login/login:ids ["login_crewing"]} + {:xt/id "warhelp" + :xt/spec :beherbergung.model.ngo/record + :name "Warhelp.eu" + :beherbergung.model.login/login:ids ["login_max_mueller"]} + {:xt/id "zentralwerk" + :xt/spec :beherbergung.model.ngo/record + :name "Zentralwerk e.V."} + + {:xt/id "login_max_mueller" + :xt/spec :beherbergung.model.login/record + :mail "praxis@max.mueller.de" + :password-hash "100$12$argon2id$v13$hq47jacLIYoiNMD9kdyy+w$ISDi+bSSTmsgqu648LQLv7ySU+lG2VGKRfa06HNfjzk$$$" #_"i!A;z\"'^G3Q)w])%83)" } + + {:xt/id "login_crewing" + :xt/spec :beherbergung.model.login/record + :mail "crewing@example-ngo.com" + :password-hash "100$12$argon2id$v13$lWXab18B+9b79jAk7noAwg$01ak9vbuyxhuKDvBnWV8wuwxIJ5GR6zjz/lJhdw1s+I$$$" #_"Vr(+cFtUG=rsj2:/]*uR" } +] diff --git a/backend/src/beherbergung/db/state.clj b/backend/src/beherbergung/db/state.clj new file mode 100644 index 0000000..694da88 --- /dev/null +++ b/backend/src/beherbergung/db/state.clj @@ -0,0 +1,81 @@ +(ns beherbergung.db.state + (:require[xtdb.api :as xtdb] + [clojure.java.io :as io] + [beherbergung.db.export :refer [export seed ]] + [mount.core :as mount :refer [defstate]] + [beherbergung.config.state :refer [env]] + [beherbergung.db.validate :refer [validate-db validate-tx]])) + +(defn export-named-by-date [db_ctx cause] + (when (:db-export-prefix env) + (let [date (.format (java.text.SimpleDateFormat. "yyyy-MM-dd_HH:mm:ss") + (.getTime (java.util.Calendar/getInstance))) + file (str (:db-export-prefix env) date "_" cause ".edn")] + (when (:verbose env) + (println "Export database to:" file)) + (io/make-parents file) + (export file db_ctx)))) + +(defn submit-tx [node tx-ops] + (xtdb/submit-tx node (validate-tx tx-ops))) + +(defn q [node & args] + (apply xtdb/q (xtdb/db node) args)) + +(defn ->db_ctx [] + (let [node (xtdb/start-node (when-not (:db-inmemory env) + {:my-rocksdb {:xtdb/module 'xtdb.rocksdb/->kv-store + :db-dir (clojure.java.io/file (:db-dir env)) + :sync? true} + :xtdb/tx-log {:kv-store :my-rocksdb} + :xtdb/document-store {:kv-store :my-rocksdb}})) ;; To optimize for read performance, we might switch to LMDB (B-Tree instead of LSM-Tree) + ;; But for our workload it doesn't matter much + db_ctx {:node node + :tx (fn [tx-ops] + (submit-tx node tx-ops)) + :tx_sync (fn [tx-ops] + (->> (submit-tx node tx-ops) + (xtdb.api/await-tx node))) + :tx-committed? (fn [transaction] + #_(println "synced" (xtdb/sync node)) + #_(println "awaited" (xtdb/await-tx node transaction)) + (xtdb/tx-committed? node transaction)) + :tx-fn-put (fn [fn-name quoted-fn] + ;; In future we may want add transaction functions only once (at startup) + (xtdb/submit-tx node [[::xtdb/put {:xt/id fn-name :xt/fn quoted-fn}]])) + :tx-fn-call (fn [fn-name & args] + (xtdb/submit-tx node [(concat [::xtdb/fn fn-name] args)])) + :sync (fn [] (xtdb/sync node)) + :q (fn [& args] + (apply q node args)) + :q_unary (fn [& args] + ;; A query returning unary results + (->> (apply q node args) + (map first))) + :q_id (fn [& args] + ;; A query returning only 1 result + (-> (apply q node args) + first)) + :q_id_unary (fn [& args] + ;; A query returning only 1 unary result + (-> (apply q node args) + ffirst))}] + + (export-named-by-date db_ctx "start") ;; before seeding + + (let [seed-file (if (not-empty (:db-seed env)) + (:db-seed env) + (io/resource "beherbergung/db/seed/example.edn"))] + (when (:verbose env) + (println "Seed the database from:" seed-file)) + (seed seed-file db_ctx)) + + (if (:db-validate env) + (or (validate-db db_ctx) + (System/exit 1)) + db_ctx))) + +(defstate db_ctx + :start (->db_ctx) + :stop (do (export-named-by-date db_ctx "stop") + (.close (:node db_ctx)))) diff --git a/backend/src/beherbergung/db/validate.clj b/backend/src/beherbergung/db/validate.clj new file mode 100644 index 0000000..598da97 --- /dev/null +++ b/backend/src/beherbergung/db/validate.clj @@ -0,0 +1,46 @@ +(ns beherbergung.db.validate + (:require [clojure.spec.alpha :as s] + [beherbergung.db.export :refer [all_docs write-edn]] + [clojure.pprint :refer [pprint]] + [clojure.tools.logging :refer [error]])) + +(defn validate + "Validate a xtdb-document or a collection of documents. + When not conforming to the spec, an explaination is associated." + [doc] + (if (map? doc) + (when-not (:xt/fn doc) + (let [spec (:xt/spec doc)] + (when-not spec + (error ":xt/spec must not be empty!" doc)) + (if (s/valid? spec doc) + doc + (assoc doc :explain (s/explain-data spec doc))))) + (map validate doc))) + +(defn validate-db + "Validate the database. + The db_ctx is only returned, when all documents have been confirmed." + [db_ctx] + (let [validated-docs (validate (all_docs db_ctx)) + errors (filter :explain validated-docs) + file "/tmp/validation-errors"] + (if (not-empty errors) + (do + (println "There have been validation errors in" (count errors) "database documents.") + (println "It seems that the latest update changed this specs:" (into [] (keys (group-by :xt/spec errors)))) + (write-edn file errors) + (println "Details have been written to:" file)) + db_ctx))) + +(defn validate-tx + "Validate docs before they are written to the database." + [tx-ops] + (let [docs (->> tx-ops + (filter #(= :xtdb.api/put (first %))) + (map second)) + errors (filter :explain (validate docs))] + (if (not-empty errors) + (do (println "Transaction canceled due to validiation errors:") + (pprint errors)) + tx-ops))) diff --git a/backend/src/beherbergung/model/auth.clj b/backend/src/beherbergung/model/auth.clj new file mode 100644 index 0000000..9357c83 --- /dev/null +++ b/backend/src/beherbergung/model/auth.clj @@ -0,0 +1,12 @@ +(ns beherbergung.model.auth + (:require [clojure.spec.alpha :as s] + [specialist-server.type :as t] + [beherbergung.model.login :as login])) + +(s/def ::jwt t/string) + +(t/defobject Auth {:name "Auth" :kind t/input-object-kind :description "Authentication requires either a valid mail+password combination or a jwt obtained by an earlier login."} + :opt-un [::login/mail ::login/password + ::jwt]) + +(s/def ::auth Auth) diff --git a/backend/src/beherbergung/model/export.clj b/backend/src/beherbergung/model/export.clj new file mode 100644 index 0000000..6effe07 --- /dev/null +++ b/backend/src/beherbergung/model/export.clj @@ -0,0 +1,7 @@ +(ns beherbergung.model.export + (:require [clojure.spec.alpha :as s] + [specialist-server.type :as t])) + +(s/def ::exit t/int) + +(s/def ::result (s/keys :req-un [::exit ::out ::err])) diff --git a/backend/src/beherbergung/model/login.clj b/backend/src/beherbergung/model/login.clj new file mode 100644 index 0000000..1bdf8e8 --- /dev/null +++ b/backend/src/beherbergung/model/login.clj @@ -0,0 +1,20 @@ +(ns beherbergung.model.login + (:require [clojure.spec.alpha :as s] + [specialist-server.type :as t])) + +(s/def ::mail t/string) ;; Used as login-name +(s/def ::password-hash t/string) + +(s/def ::invited-by t/string) + +(s/def ::record (s/keys :req-un [::mail ::password-hash] :opt-un [::invited-by])) + + +(s/def ::login (s/keys :req-un [::mail ::password-hash])) + +(s/def ::login:id t/string) + +(s/def ::password t/string) ;; The unhashed password is not part of the login schema + +(s/def ::login:ids (s/or :1 ::login:id + :* (s/* ::login:id))) diff --git a/backend/src/beherbergung/model/ngo.clj b/backend/src/beherbergung/model/ngo.clj new file mode 100644 index 0000000..a1ca138 --- /dev/null +++ b/backend/src/beherbergung/model/ngo.clj @@ -0,0 +1,20 @@ +(ns beherbergung.model.ngo + (:require [clojure.spec.alpha :as s] + [specialist-server.type :as t])) + +(s/def ::ngo (s/keys :req-un [::id ::name])) + +(s/def ::ngo:id t/id) + +(t/defscalar NgoRefs + {:name "NgoRefs" :description "Either a collection of ngo-ids or `any`"} + (s/conformer #(cond (coll? %) (set %) + (= "any" (name %)) :any + :else :clojure.spec.alpha/invalid))) + +(s/def ::record (s/keys :req-un [::name])) + +(defn db->graphql [record] + (some-> record + (select-keys [:xt/id :name]) + (assoc :id (:xt/id record)))) diff --git a/backend/src/beherbergung/resolver/core.clj b/backend/src/beherbergung/resolver/core.clj new file mode 100644 index 0000000..8b2da8b --- /dev/null +++ b/backend/src/beherbergung/resolver/core.clj @@ -0,0 +1,40 @@ +(ns beherbergung.resolver.core + (:require [specialist-server.core :refer [executor]] + [mount.core :as mount :refer [defstate]] + [beherbergung.config.state :refer [env]] + [beherbergung.db.state :refer [->db_ctx db_ctx]] + ;; public + ;; any login + [beherbergung.resolver.root.login :refer [login]] + ;; ngo login + [beherbergung.resolver.root.ngo.ngo-example :refer [ngo_example]] + ;; admin passphrase + [beherbergung.resolver.root.admin.export :refer [export]])) + +(def graphql* (executor {:query {:login #'login + :ngo_example #'ngo_example + :export #'export} + :mutation {}})) + +(defn ->graphql + "Create a wrapped graphql-executor, that merges context into the request. + + For default usage in the app, the db_ctx should be a singleton handled by mount. + When {:singleton? true} is used, closing the db (deleting the lock) is provided by mount. + + Since all testcases within a file run in parallel, several db instances are wanted to avoid race conditions. + It's easy to get an executor with a new db-instance by (->graphql) for testcases with mutations. + The easiest way of having several instances without worrying about locks is using the config option {:db-inmemory true}." + + [& {:keys [singleton?] :or {singleton? false}}] + (let [db_ctx (if singleton? db_ctx (->db_ctx))] + (fn [query] + (graphql* (-> query + (assoc-in [:context :db_ctx] + db_ctx) + (assoc-in [:context :validate-output?] + (or (get-in query [:context :validate-output?]) + (:validate-output env)))))))) + +(defstate graphql + :start (beherbergung.resolver.core/->graphql :singleton? true)) diff --git a/backend/src/beherbergung/resolver/root/admin/Export.md b/backend/src/beherbergung/resolver/root/admin/Export.md new file mode 100644 index 0000000..8fac295 --- /dev/null +++ b/backend/src/beherbergung/resolver/root/admin/Export.md @@ -0,0 +1,10 @@ +This can be used for debugging or to test with a dump of the productive database before releasing a new software version: + +```sh +curl 'https://URL/graphql' -H 'Content-Type: application/json' --data '{"query": "query Export{ export(password: \"ADMIN_PASSPHRASE\"){out err} }"}' | jq '.data.export.out' -r > /tmp/export.gpg +``` + +```sh +cd backend +gpg --decrypt /tmp/export.gpg | DB_SEED=/dev/stdin DB_INMEMORY=true lein run +``` diff --git a/backend/src/beherbergung/resolver/root/admin/export.clj b/backend/src/beherbergung/resolver/root/admin/export.clj new file mode 100644 index 0000000..dad80c5 --- /dev/null +++ b/backend/src/beherbergung/resolver/root/admin/export.clj @@ -0,0 +1,23 @@ +(ns beherbergung.resolver.root.admin.export + (:require [clojure.spec.alpha :as s] + [specialist-server.type :as t] + [beherbergung.model.login :as login] + [beherbergung.model.export :as export] + [beherbergung.auth.admin :refer [admin?]] + [beherbergung.db.export :refer [all_docs edn->pprint]] + [beherbergung.security.encryption.gpg :refer [encrypt]] + [beherbergung.config.state :refer [env]])) + +(s/fdef export + :args (s/tuple map? (s/keys :req-un [::login/password]) map? map?) + :ret (s/nilable ::export/result)) + +(defn export + "Export an encrypted database dump" + [_node opt ctx _info] + (when (admin? (:password opt)) + (-> (all_docs (:db_ctx ctx)) + (edn->pprint) + (encrypt (:admin-gpg-id env))))) + +(s/def ::export (t/resolver #'export)) diff --git a/backend/src/beherbergung/resolver/root/login.clj b/backend/src/beherbergung/resolver/root/login.clj new file mode 100644 index 0000000..e49c575 --- /dev/null +++ b/backend/src/beherbergung/resolver/root/login.clj @@ -0,0 +1,17 @@ +(ns beherbergung.resolver.root.login + (:require [clojure.spec.alpha :as s] + [specialist-server.type :as t] + [beherbergung.model.auth :as auth] + [beherbergung.auth.jwt.login])) + +(s/fdef login + :args (s/tuple map? (s/keys :req-un [::auth/auth]) map? map?) + :ret (s/keys :opt-un [:auth/jwt])) + +(defn login + "For a username+password get a jwt containing the login:id" + [_node opt ctx _info] + (let [auth (:auth opt)] + {:jwt (beherbergung.auth.jwt.login/login ctx (:mail auth) (:password auth))})) + +(s/def ::login (t/resolver #'login)) diff --git a/backend/src/beherbergung/resolver/root/ngo/ngo_example.clj b/backend/src/beherbergung/resolver/root/ngo/ngo_example.clj new file mode 100644 index 0000000..3a7ced5 --- /dev/null +++ b/backend/src/beherbergung/resolver/root/ngo/ngo_example.clj @@ -0,0 +1,22 @@ +(ns beherbergung.resolver.root.ngo.ngo-example + (:require [clojure.spec.alpha :as s] + [specialist-server.type :as t] + [beherbergung.auth.core :refer [auth+role->entity]] + [beherbergung.model.auth :as auth] + [beherbergung.model.ngo :as ngo])) + +(s/def ::my_result_type t/string) + +(s/fdef ngo_example + :args (s/tuple map? (s/keys :req-un [::auth/auth]) map? map?) + :ret (s/nilable ::my_result_type)) + +(defn ngo_example + "For an ngo login, we get a greeting" + [_node opt ctx _info] + (let [{:keys [_TODO]} (:db_ctx ctx) + [ngo:id] (auth+role->entity ctx (:auth opt) ::ngo/record)] + (when ngo:id + "hallo welt :)"))) + +(s/def ::ngo_example (t/resolver #'ngo_example)) diff --git a/backend/src/beherbergung/security/encryption/gpg.clj b/backend/src/beherbergung/security/encryption/gpg.clj new file mode 100644 index 0000000..6684409 --- /dev/null +++ b/backend/src/beherbergung/security/encryption/gpg.clj @@ -0,0 +1,17 @@ +(ns beherbergung.security.encryption.gpg + (:require [clojure.java.shell :refer [sh]])) + +(defn encrypt + "Requires `gpg` to be installed and the keyid to be in the keyring" + [plaintext keyid] + (sh "gpg" "--batch" "--encrypt" "--recipient" keyid "--armor" + :in plaintext)) + +#_(defn encrypt + "This version should better be audited before using it" + [plaintext keyids] + (let [recipient_args (interleave (repeatedly (constantly "--recipient")) + (map str keyids)) + sh_options [:in plaintext] + args (concat ["gpg" "--batch" "--encrypt"] recipient_args ["--armor"] sh_options)] + (apply sh args))) diff --git a/backend/src/beherbergung/webserver/handler.clj b/backend/src/beherbergung/webserver/handler.clj new file mode 100644 index 0000000..7f37181 --- /dev/null +++ b/backend/src/beherbergung/webserver/handler.clj @@ -0,0 +1,42 @@ +(ns beherbergung.webserver.handler + (:require [compojure.core :refer [defroutes GET POST]] + [compojure.route :as route] + [ring.util.response :refer [response]] + [ring.middleware.cors :refer [wrap-cors]] + [beherbergung.webserver.middleware :refer [wrap-graphql wrap-graphiql wrap-nextjs-frontend wrap-frontend-config wrap-defaults]] + [beherbergung.resolver.core :refer [graphql]] + [beherbergung.config.state :refer [env]])) + +(def frontend-url (:frontend-base-url env)) + + +(defroutes app-routes + (GET "/" [] ;; When using a fullstack-build, this route is overwritten by `wrap-nextjs-frontend` + (str "

The backend takes care of data storage and securing its access.
" + " It provides a Graphql-API Endpoint.
" + " You may want explore the schema and send queries using GraphiQL." + "

" + "

This build doesn't include the frontend.
" + " You may want start it independently and open " frontend-url ".
" + " Alternatively production builds including the frontend are available via nix." + "

")) + + (-> + (POST "/graphql" req + (response (graphql (:body req)))) + wrap-graphql + wrap-graphiql) + + (route/not-found "Not Found")) + + +(def app + (-> app-routes + + (wrap-nextjs-frontend) + (wrap-frontend-config) + + (wrap-defaults) + + (wrap-cors :access-control-allow-origin [#"http://localhost:3000"] + :access-control-allow-methods [:get :put :post :delete]))) diff --git a/backend/src/beherbergung/webserver/middleware.clj b/backend/src/beherbergung/webserver/middleware.clj new file mode 100644 index 0000000..94ef367 --- /dev/null +++ b/backend/src/beherbergung/webserver/middleware.clj @@ -0,0 +1,102 @@ +(ns beherbergung.webserver.middleware + (:require [beherbergung.config.state :refer [env]] + [ring.middleware.resource :refer [wrap-resource]] + [ring.middleware.webjars :refer [wrap-webjars]] + [ring.middleware.json :refer [wrap-json-response wrap-json-body]] + [ring.middleware.content-type :refer [wrap-content-type]] + [ring.middleware.not-modified :refer [wrap-not-modified]] + [ring.util.json-response :refer [json-response]] + [ring.util.response :refer [resource-response content-type]] + [lib.graphql.middleware :refer [wrap-graphql-error]] + [co.deps.ring-etag-middleware :as etag] + [lib.resources.list-resources :refer [list-resources]] + [clojure.string :as string :refer [ends-with?]])) + +(defn wrap-debug + [handler] + (fn [req] + (let [res (handler req) + selected_headers ["if-modified-since" "if-none-match"]] + (when (:verbose env) + (prn) + (println (:uri req)) + (prn (keys (sort (:headers req)))) + (prn (select-keys (:headers req) selected_headers)) + (prn (:status res) (:headers res))) + res))) + +(defn wrap-graphiql + "Add graphqli using org.webjars/graphiql and resources/public/graphiql/index.html" + [handler] + (-> handler + (wrap-webjars) + (wrap-resource "public"))) + +(defn wrap-graphql + "Handle Content-Type and Errors of graphql-endpoint" + [handler] + (-> handler + (wrap-graphql-error) + (wrap-json-body {:keywords? true :bigdecimals? false}) ;; java.math.BigDecimal doesn't conform to t/float or float? + (wrap-json-response))) + +#_(defn wrap-rest + "Use the same error handling as for graphql" + [handler] + (-> handler + (wrap-graphql-error))) + +(defn wrap-nextjs-frontend + "Serve the frontend: + 1. Everything from the backend that is not the mocked / + 2. Any directory should serve the index.html when existing + 3. Serve an .html file instead of a requested file without extension + 4. When a not existing file is accessed in a directory with only 1 .html (probably a route with a variable), serve that instead + 5. If all attempts failed, pass the 404" + [handler] + (fn [req] + (let [res (handler req) + path (string/replace (:uri req) #"/[^/]*$" "/") + file (string/replace (:uri req) #".*/" "") + html (->> (list-resources (str "public" path)) + (remove #(re-matches #".+[/].*" %)) ;; Only files that are not in a subdirectory + (filter #(re-matches #".*\.html" %)))] + (cond (not (or (= 404 (:status res)) + (= "/" (:uri req)))) + res + (and (ends-with? (:uri req) "/") + (some #{"index.html"} html)) + {:status 302 + :headers {"Location" (str (:uri req) "index.html")} + :body ""} + (some #{(str file ".html")} html) + {:status 302 + :headers {"Location" (str (:uri req) ".html")} + :body ""} + (= 1 (count html)) + (-> (resource-response (str "public" path (first html))) + (content-type "text/html")) + :else + res)))) + +(defn wrap-frontend-config + "Provide config for static build of frontend" + [handler] + (fn [req] + (if (= "/config.json" (:uri req)) + ;; If the config would become larger, we should calc an ETag header + ;; For using `etag/wrap-file-etag`, body would need to be of instance? File + (json-response {:base_url (:frontend-base-url env) + :backend_base_url (:frontend-backend-base-url env)}) + (handler req)))) + + +(defn wrap-defaults [handler] + (-> handler + (wrap-content-type) + (wrap-json-response) + + (etag/wrap-file-etag) + (wrap-not-modified) + + (wrap-debug))) diff --git a/backend/src/beherbergung/webserver/state.clj b/backend/src/beherbergung/webserver/state.clj new file mode 100644 index 0000000..13ebc69 --- /dev/null +++ b/backend/src/beherbergung/webserver/state.clj @@ -0,0 +1,25 @@ +(ns beherbergung.webserver.state + (:gen-class) ;; this Class contains our -main function + (:require [ring.adapter.jetty] + [ring.middleware.reload] + [beherbergung.webserver.handler] + [mount.core :as mount :refer [defstate]] + [beherbergung.config.state] + [signal.handler :refer [with-handler]])) + +(defstate ^{:on-reload :noop} ;; When the app is recompiled, mount should not care, but we use ring.middleware.reload/wrap-reload + webserver + :start (do (println (str "Start server at http://localhost:" (:port beherbergung.config.state/env))) + (ring.adapter.jetty/run-jetty (ring.middleware.reload/wrap-reload #'beherbergung.webserver.handler/app) + {:port (:port beherbergung.config.state/env) :join? false})) + :stop (.stop webserver)) + +(defn -main [& _args] + (mount/start) + + (let [finaly (fn [] (mount/stop) ;; Export the database + (System/exit 0))] + (with-handler :term (finaly)) ;; kill + (with-handler :int (finaly))) ;; Ctrl+C + + (mount.core/running-states)) ;; Return value for debugging when called on repl diff --git a/backend/src/config.edn b/backend/src/config.edn new file mode 100644 index 0000000..c93217a --- /dev/null +++ b/backend/src/config.edn @@ -0,0 +1,24 @@ +{:verbose false + + :port 4000 + + :validate-output true + + :db-inmemory false + :db-dir "./data/xtdb/rocksdb" + :db-seed "" + :db-export-prefix "./data/export/" + :db-validate true + + ;:mail-host "" + ;:mail-user "" + ;:mail-pass "" + ;:mail-port 587 + ;:mail-from nil + + :admin-passphrase nil + :admin-gpg-id "9EA68B7F21204979645182E4287B083353C3241C" + + :frontend-base-url "http://localhost:4000" + :frontend-backend-base-url "http://localhost:4000" +} diff --git a/backend/src/lib/graphql/middleware.clj b/backend/src/lib/graphql/middleware.clj new file mode 100644 index 0000000..6e4bd8b --- /dev/null +++ b/backend/src/lib/graphql/middleware.clj @@ -0,0 +1,19 @@ +(ns lib.graphql.middleware + (:require [ring.util.response :refer [status]] + [ring.util.json-response :refer [json-response]] + [clojure.stacktrace :refer [print-stack-trace]])) + +(defn wrap-graphql-error + "An alternative to ring.middleware.stacktrace/wrap-stacktrace, but more compliant with graphql. + The response is a json datastructure with an `errors` key. + + specialist-server.core only catches ExceptionInfo" + + [handler] + (fn [request] + (try + (handler request) + (catch Throwable e + (-> (json-response {:errors [{:message (ex-message e) + :trace (with-out-str (print-stack-trace e))}]}) + (status 500)))))) diff --git a/backend/src/lib/resources/list_resources.clj b/backend/src/lib/resources/list_resources.clj new file mode 100644 index 0000000..d496c47 --- /dev/null +++ b/backend/src/lib/resources/list_resources.clj @@ -0,0 +1,41 @@ +(ns lib.resources.list-resources + (:require [clojure.java.io :as io] + [clojure.string :as s] + [clojure.set :refer [subset?]])) + +(def ^:private running-jar + (-> :keyword class (.. getProtectionDomain getCodeSource getLocation getPath))) + +(defn list-jar-resources [prefix] + (let [jar (java.util.jar.JarFile. running-jar) + entries (.entries jar) + entries-rec (loop [result []] + (if (.hasMoreElements entries) + (recur (conj result (.. entries nextElement getName))) + result))] + (->> entries-rec + (filter #(s/starts-with? % prefix)) + (drop 1) + (map #(s/replace % prefix ""))))) + +(defn getPath [f] + (when f (.getPath f))) + +(defn list-dev-resources [prefix] + (let [root-path (getPath (io/resource prefix))] + (some->> (io/file (io/resource prefix)) + file-seq + (drop 1) + (map #(if (.isDirectory %) + (str (getPath %) "/") + (getPath %))) + (map #(s/replace % root-path ""))))) + +(defn list-resources [prefix] + (try (list-dev-resources prefix) + (catch java.lang.IllegalArgumentException _ + (list-jar-resources prefix)))) + +(defn selftest [] + (and (subset? #{"/graphiql/" "/graphiql/index.html"} (set (list-resources "public"))) + (subset? #{"graphiql/" "graphiql/index.html"} (set (list-resources "public/")))))