├── .gitignore
├── README.md
├── dogfort-template
├── project.clj
└── src
│ └── leiningen
│ └── new
│ ├── dogfort.clj
│ └── dogfort
│ ├── Procfile
│ ├── brepl
│ ├── brepl.bat
│ ├── brepl.clj
│ ├── build
│ ├── build.bat
│ ├── build.clj
│ ├── core.cljs
│ ├── gitignore
│ ├── index.html
│ ├── package.json
│ ├── project.clj
│ ├── release
│ ├── release.bat
│ ├── release.clj
│ ├── repl
│ ├── repl.bat
│ ├── repl.clj
│ ├── watch
│ ├── watch.bat
│ └── watch.clj
├── dogfort.jpg
├── project.clj
├── src
└── dogfort
│ ├── build.clj
│ ├── dev
│ ├── nrepl.cljs
│ ├── test.cljs
│ └── testmain.cljs
│ ├── http.cljs
│ ├── middleware
│ ├── body_parser.cljs
│ ├── cookies.cljs
│ ├── defaults.cljs
│ ├── defaults_macros.clj
│ ├── edn.cljs
│ ├── file.cljs
│ ├── keyword_params.cljs
│ ├── multipart_params.cljs
│ ├── nested_params.cljs
│ ├── nested_params_test.cljs
│ ├── params.cljs
│ ├── routes.cljs
│ ├── routes_macros.clj
│ ├── session.cljs
│ └── session
│ │ ├── cookie.cljs
│ │ ├── memory.cljs
│ │ └── store.cljs
│ └── util
│ ├── codec.cljs
│ ├── data.cljs
│ ├── macros.clj
│ ├── mime_type.cljs
│ ├── parsing.cljs
│ ├── request.cljs
│ ├── response.cljs
│ └── time.cljs
└── static
├── exclusive_paper.png
├── gloriahallelujah.ttf
├── index.html
├── permanentmarker.ttf
└── screen.css
/.gitignore:
--------------------------------------------------------------------------------
1 | /target
2 | /lib
3 | /classes
4 | /checkouts
5 | /js
6 | pom.xml
7 | *.jar
8 | *.class
9 | .lein-deps-sum
10 | .lein-failures
11 | .lein-plugins
12 | /.repl
13 | /node_modules
14 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # Dog Fort
2 |
3 | 
4 |
5 | ## Quick Start
6 |
7 | Install [node](https://nodejs.org/en/).
8 |
9 | ```
10 | lein new dogfort my-project
11 | cd my-project
12 | lein npm install
13 | lein build
14 | ```
15 | then in another terminal
16 | ```
17 | cd my-project
18 | node main.js
19 | ```
20 | For easy development install supervisor
21 | ```
22 | npm install supervisor -g
23 |
24 | cd my-project
25 | supervisor main.js
26 | ```
27 | Supervisor will restart the node.process whenever you make changes.
28 |
29 | ## Usage
30 |
31 | Dog Fort uses Ring's concept of handlers and adapters, the only
32 | difference being that the handler should return a promise of a
33 | response structure, not the response itself, due to the asynchronous
34 | nature of Node. See [Red Lobster](https://github.com/bodil/redlobster)
35 | for documentation on promises.
36 |
37 | ```clojure
38 | (ns user
39 | (:use [dogfort.http :only [run-http]])
40 | (:require [redlobster.promise :as p]))
41 |
42 | (defn handler [request]
43 | (p/promise {:status 200
44 | :headers {:content-type "text/html"}
45 | :body "
This is Dog Fort
"}))
46 |
47 | (run-http handler {:port 1337})
48 | ```
49 |
50 | The body of a response can also be a Node stream. Here's an example
51 | that serves a file directly from the file system using a Node `Stream`
52 | object.
53 |
54 | ```clojure
55 | (ns user
56 | (:use [dogfort.http :only [run-http]])
57 | (:require [redlobster.stream :as stream]
58 | [redlobster.promise :as p])
59 |
60 |
61 | (defn handler [request]
62 | (p/promise {:status 200
63 | :headers {:content-type "text/plain"}
64 | :body (stream/slurp "README.md")}))
65 |
66 | (run-http handler {:port 1337})
67 | ```
68 |
69 | ## Routing
70 |
71 | Dog Fort includes a request routing mechanism heavily inspired by
72 | [Compojure](https://github.com/weavejester/compojure). It introduces
73 | the `defroutes` macro for building handlers with routing.
74 |
75 | ```clojure
76 | (ns user
77 | (:use [dogfort.http :only [run-http]])
78 | (:require [dogfort.middleware.routing])
79 | (:use-macros [dogfort.middleware.routing-macros :only [defroutes GET]]))
80 |
81 | (defroutes app
82 | (GET "/hello/:name" [name]
83 | ["Hello " name "!
"]))
84 |
85 | (run-http app {:port 1337})
86 | ```
87 |
88 | The `defroutes` macro takes a symbol name, and a series of sub-handler
89 | definitions, which are created using the `GET` macro and its
90 | corresponding macros for other request methods: `POST`, `HEAD`, etc.
91 |
92 | This macro takes a path expression in the Rails style, a vector of
93 | variable bindings that should match the variables used in the path
94 | expression, and a series of forms constituting the handler's body, and
95 | should return a response as usual.
96 |
97 | Notice, however, that routing sub-handlers don't need to return a
98 | promise. For convenience, you can also return a response map directly,
99 | or dispense with the map altogether and just return the response body,
100 | either as a string, a sequence or a Node `Stream` object. The routing
101 | middleware will automatically wrap it as appropriate, defaulting to a
102 | `Content-Type` of `text/html` if you only provide the body. Note that
103 | if you need to perform asynchronous calls, you will still have to
104 | return a promise and realise it to a response map as usual.
105 |
106 | # License
107 |
108 | Copyright 2012 Bodil Stokke and Matthew Molloy
109 |
110 | Licensed under the Apache License, Version 2.0 (the "License"); you
111 | may not use this file except in compliance with the License. You may
112 | obtain a copy of the License at
113 | [http://www.apache.org/licenses/LICENSE-2.0](http://www.apache.org/licenses/LICENSE-2.0).
114 |
115 | Unless required by applicable law or agreed to in writing, software
116 | distributed under the License is distributed on an "AS IS" BASIS,
117 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
118 | implied. See the License for the specific language governing
119 | permissions and limitations under the License.
120 |
--------------------------------------------------------------------------------
/dogfort-template/project.clj:
--------------------------------------------------------------------------------
1 | (defproject dogfort/lein-template "0.6.8"
2 | :description "A minimal ClojureScript project template"
3 | :url "https://github.com/whamtet/dogfort"
4 | :license {:name "Eclipse Public License"
5 | :url "http://www.eclipse.org/legal/epl-v10.html"}
6 | :scm {:name "git"
7 | :url "https://github.com/whamtet/dogfort"}
8 | :repositories [["clojars" {:sign-releases false}]]
9 | :eval-in-leiningen true)
10 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort.clj:
--------------------------------------------------------------------------------
1 | (ns leiningen.new.dogfort
2 | (:require [leiningen.new.templates :refer
3 | [renderer name-to-path ->files]]))
4 |
5 | (def render (renderer "dogfort"))
6 |
7 | (defn dogfort [name]
8 | (println "creating new dogfort project" name)
9 | (let [data {:name name
10 | :sanitized (name-to-path name)}]
11 | (->files data
12 | ; ["package.json" (render "package.json" data)] ;conflicting with lein npm
13 | ["Procfile" (render "Procfile" data)]
14 | ["static/index.html" (render "index.html" data)]
15 | ["project.clj" (render "project.clj" data)]
16 | ["src/{{sanitized}}/core.cljs" (render "core.cljs" data)]
17 | [".gitignore" (render "gitignore" data)]
18 | ["scripts/repl" (render "repl" data) :executable true]
19 | ["scripts/repl.bat" (render "repl.bat" data)]
20 | ["scripts/repl.clj" (render "repl.clj" data)]
21 | ["scripts/brepl" (render "brepl" data) :executable true]
22 | ["scripts/brepl.bat" (render "brepl.bat" data)]
23 | ["scripts/brepl.clj" (render "brepl.clj" data)]
24 | ["scripts/watch" (render "watch" data) :executable true]
25 | ["scripts/watch.bat" (render "watch.bat" data)]
26 | ["scripts/watch.clj" (render "watch.clj" data)]
27 | ["scripts/build" (render "build" data) :executable true]
28 | ["scripts/build.bat" (render "build.bat" data)]
29 | ["scripts/build.clj" (render "build.clj" data)]
30 | ["scripts/release" (render "release" data) :executable true]
31 | ["scripts/release.bat" (render "release.bat" data)]
32 | ["scripts/release.clj" (render "release.clj" data)])))
33 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/Procfile:
--------------------------------------------------------------------------------
1 | web: node main.js
2 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/brepl:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 | rlwrap lein trampoline run -m clojure.main scripts/brepl.clj
3 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/brepl.bat:
--------------------------------------------------------------------------------
1 | @echo off
2 | lein trampoline run -m clojure.main scripts\brepl.clj
3 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/brepl.clj:
--------------------------------------------------------------------------------
1 | (require
2 | '[cljs.build.api :as b]
3 | '[cljs.repl :as repl]
4 | '[cljs.repl.browser :as browser])
5 |
6 | (b/build "src"
7 | {:main '{{name}}.core
8 | :output-to "out/{{sanitized}}.js"
9 | :output-dir "out"
10 | :verbose true})
11 |
12 | (repl/repl (browser/repl-env)
13 | :output-dir "out")
14 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/build:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 | rlwrap lein trampoline run -m clojure.main scripts/build.clj
3 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/build.bat:
--------------------------------------------------------------------------------
1 | @echo off
2 | lein trampoline run -m clojure.main scripts\build.clj
3 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/build.clj:
--------------------------------------------------------------------------------
1 | (require '[cljs.build.api :as b])
2 |
3 | (println "Building ...")
4 |
5 | (let [start (System/nanoTime)]
6 | (b/build "src"
7 | {:main '{{name}}.core
8 | :output-to "out/{{sanitized}}.js"
9 | :output-dir "out"
10 | :verbose true})
11 | (println "... done. Elapsed" (/ (- (System/nanoTime) start) 1e9) "seconds"))
12 |
13 |
14 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/core.cljs:
--------------------------------------------------------------------------------
1 | (ns {{name}}.core
2 | (:use-macros [dogfort.middleware.routes-macros :only [defroutes GET POST ANY]])
3 | (:require-macros)
4 | (:use [dogfort.http :only [run-http]]
5 | )
6 | (:require [cljs.nodejs]
7 | [dogfort.middleware.defaults :as defaults]
8 | [dogfort.middleware.routes]))
9 |
10 | (cljs.nodejs/enable-util-print!)
11 |
12 | (defroutes handler
13 | (ANY "/" req
14 | {:status 200
15 | :body (pr-str req)
16 | :session {:hi "there"}})
17 | )
18 |
19 | (defn main [& args]
20 | (println "starting")
21 | (-> handler
22 | (defaults/wrap-defaults {:wrap-file "static"})
23 | (run-http {:port (or (.-PORT (.-env js/process)) 5000)})))
24 |
25 | (set! *main-cli-fn* main)
26 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/gitignore:
--------------------------------------------------------------------------------
1 | pom.xml
2 | *jar
3 | /lib/
4 | /classes/
5 | /release/
6 | /target/
7 | .lein-deps-sum
8 | .lein-repl-history
9 | .lein-plugins/
10 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | Hi there
6 |
7 |
8 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "name": "node-js-getting-started",
3 | "version": "0.1.4",
4 | "description": "A sample Node.js app using Express 4",
5 | "main": "main.js",
6 | "dependencies": {
7 | "nrepl-client": "0.2.3",
8 | "mongodb": "2.0.42",
9 | "ws": "0.8.0"
10 | },
11 | "engines": {
12 | "node": "0.12.2"
13 | },
14 | "repository": {
15 | "type": "git",
16 | "url": "https://github.com/heroku/node-js-getting-started"
17 | },
18 | "keywords": [
19 | "node",
20 | "heroku",
21 | "express"
22 | ],
23 | "license": "MIT"
24 | }
25 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/project.clj:
--------------------------------------------------------------------------------
1 | (defproject {{name}} "0.1.0-SNAPSHOT"
2 | :description "FIXME: write this!"
3 | :url "http://example.com/FIXME"
4 | :dependencies [[org.clojure/clojure "1.7.0"]
5 | [org.clojure/clojurescript "1.7.48" :classifier "aot"
6 | :exclusion [org.clojure/data.json]]
7 | [org.clojure/data.json "0.2.6" :classifier "aot"]
8 | [dogfort "0.2.0-SNAPSHOT"]
9 | ]
10 | :jvm-opts ^:replace ["-Xmx1g" "-server"]
11 | :plugins [[lein-npm "0.6.1"]]
12 | :npm {:dependencies [[source-map-support "0.3.2"]]}
13 | :source-paths ["src" "target/classes"]
14 | :clean-targets ["out" "release"]
15 | :target-path "target"
16 | :aliases
17 | {"build" ["run" "-m" "dogfort.build" "{{name}}.core"]})
18 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/release:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 | rlwrap lein trampoline run -m clojure.main scripts/release.clj
3 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/release.bat:
--------------------------------------------------------------------------------
1 | @echo off
2 | lein trampoline run -m clojure.main scripts\release.clj
3 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/release.clj:
--------------------------------------------------------------------------------
1 | (require '[cljs.build.api :as b])
2 |
3 | (println "Building ...")
4 |
5 | (let [start (System/nanoTime)]
6 | (b/build "src"
7 | {:output-to "release/{{sanitized}}.js"
8 | :output-dir "release"
9 | :optimizations :advanced
10 | :verbose true})
11 | (println "... done. Elapsed" (/ (- (System/nanoTime) start) 1e9) "seconds"))
12 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/repl:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 | rlwrap lein trampoline run -m clojure.main scripts/repl.clj
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/repl.bat:
--------------------------------------------------------------------------------
1 | @echo off
2 | lein trampoline run -m clojure.main scripts\repl.clj
3 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/repl.clj:
--------------------------------------------------------------------------------
1 | (require
2 | '[cljs.repl :as repl]
3 | '[cljs.repl.node :as node])
4 |
5 | (repl/repl (node/repl-env))
6 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/watch:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 | rlwrap lein trampoline run -m clojure.main scripts/watch.clj
3 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/watch.bat:
--------------------------------------------------------------------------------
1 | @echo off
2 | lein trampoline run -m clojure.main scripts\watch.clj
3 |
--------------------------------------------------------------------------------
/dogfort-template/src/leiningen/new/dogfort/watch.clj:
--------------------------------------------------------------------------------
1 | (require '[cljs.build.api :as b])
2 |
3 | (b/watch "src"
4 | {:main '{{name}}.core
5 | :output-to "out/{{sanitized}}.js"
6 | :output-dir "out"})
7 |
--------------------------------------------------------------------------------
/dogfort.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/whamtet/dogfort/75c2908355cc18bf350a5b761d2906e013ee9f94/dogfort.jpg
--------------------------------------------------------------------------------
/project.clj:
--------------------------------------------------------------------------------
1 | (defproject dogfort "0.2.3"
2 | :description "A web server framework for Clojurescript on Node"
3 | :url "https://github.com/bodil/dogfort"
4 | :license {:name "Apache License, version 2.0"
5 | :url "http://www.apache.org/licenses/LICENSE-2.0.html"}
6 | :dependencies [[org.clojure/clojure "1.7.0"]
7 | [redlobster "0.2.3"]
8 | [org.clojure/clojurescript "1.7.48"]
9 | [org.clojure/tools.nrepl "0.2.10"]
10 | [org.clojars.whamtet/hiccups "0.4.1"]]
11 | :plugins [
12 | [lein-cljsbuild "1.1.0"]
13 | [org.bodil/lein-noderepl "0.1.11"]
14 | [lein-npm "0.6.1"]
15 | [com.cemerick/clojurescript.test "0.3.3"]
16 | ]
17 | :npm {:dependencies [
18 | [nrepl-client "0.2.3"]
19 | [ws "0.8.0"]
20 | [busboy "0.2.12"]
21 | ]}
22 |
23 | ;using dogfort.build instead
24 |
25 | :cljsbuild {:builds [{:source-paths ["src" "test"]
26 | :compiler {:output-to "target/cljs/testable.js"
27 | :target :nodejs
28 | :optimizations :simple
29 | :pretty-print true}}]
30 | :test-commands {"unit-tests" ["node" :node-runner
31 | ;"this.literal_js_was_evaluated=true"
32 | "target/cljs/testable.js"
33 | ;"test/cemerick/cljs/test/extra_test_command_file.js"
34 | ]}}
35 | :aliases
36 | {"build" ["run" "-m" "dogfort.build" "dogfort.dev.testmain"]}
37 | )
38 |
--------------------------------------------------------------------------------
/src/dogfort/build.clj:
--------------------------------------------------------------------------------
1 | (ns dogfort.build)
2 |
3 | (require 'cljs.build.api)
4 |
5 | (defn -main [& [main]]
6 | (cljs.build.api/watch
7 | "src"
8 | {:main (symbol main)
9 | :output-to "main.js"
10 | :target :nodejs}))
11 |
--------------------------------------------------------------------------------
/src/dogfort/dev/nrepl.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.dev.nrepl
2 | (:use-macros [redlobster.macros :only [promise]])
3 | (:use [cljs.reader :only [read-string]])
4 | )
5 |
6 | ;; var nreplClient = require('nrepl-client');
7 | ;; nreplClient.connect({port: 7889}).once('connect', function() {
8 | ;; var expr = '(+ 3 4)';
9 | ;; client.eval(expr, function(err, result) {
10 | ;; console.log('%s => ', expr, err || result);
11 | ;; client.end();
12 | ;; });
13 | ;; });
14 |
15 | (def nrepl (js/require "nrepl-client"))
16 | ;(def conn (.connect nrepl (clj->js {:port 50000})))
17 |
18 | (defn my-eval [form]
19 | (promise
20 | (.eval conn
21 | (pr-str form)
22 | (fn [err result]
23 | (if err
24 | (realise-error "erz")
25 | (-> result js->clj (get-in [0 "value"]) read-string realise))))))
26 |
--------------------------------------------------------------------------------
/src/dogfort/dev/test.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.dev.test
2 | (:require
3 | [dogfort.util.codec :refer [percent-encode url-encode url-decode
4 | percent-decode
5 | form-encode*
6 | base64-decode
7 | base64-encode
8 | form-encode form-decode-str form-decode]])
9 | (:require-macros
10 | [dogfort.util.macros :refer [is are]])
11 | )
12 |
13 | (defn run []
14 | (is (= (percent-encode " ") "%20"))
15 | (is (= (percent-encode "+") "%2B"))
16 | (is (= (percent-encode "foo") "%66%6F%6F"))
17 |
18 | (is (= (percent-decode "%s/") "%s/")) ;does it matter?
19 | (is (= (percent-decode "%20") " "))
20 | (is (= (percent-decode "foo%20bar") "foo bar"))
21 | ; (is (= (percent-decode "foo%FE%FF%00%2Fbar" "ucs2") "foo/bar"))
22 | (is (= (percent-decode "%24") "$"))
23 |
24 | (is (= (url-encode "foo/bar") "foo%2Fbar"))
25 | ; (is (= (url-encode "foo/bar" "UTF-16") "foo%FE%FF%00%2Fbar"))
26 | (is (= (url-encode "foo+bar") "foo+bar"))
27 | (is (= (url-encode "foo bar") "foo%20bar"))
28 |
29 | (is (= (url-decode "foo%2Fbar") "foo/bar" ))
30 | ; (is (= (url-decode "foo%FE%FF%00%2Fbar" "UTF-16") "foo/bar"))
31 | (is (= (url-decode "%") "%"))
32 |
33 | (let [str-bytes (js/Buffer. "foo?/+")]
34 | (is (.equals str-bytes (base64-decode (base64-encode str-bytes)))))
35 |
36 | (are [x y] (= (form-encode x) y)
37 | "foo bar" "foo+bar"
38 | "foo+bar" "foo%2Bbar"
39 | "foo/bar" "foo%2Fbar")
40 | ; (is (= (form-encode "foo/bar" "UTF-16") "foo%FE%FF%00%2Fbar"))
41 |
42 | (are [x y] (= (form-encode x) y)
43 | {"a" "b"} "a=b"
44 | {:a "b"} "a=b"
45 | {"a" 1} "a=1"
46 | {"a" "b" "c" "d"} "a=b&c=d"
47 | {"a" "b c"} "a=b+c")
48 | ; (is (= (form-encode {"a" "foo/bar"} "UTF-16") "a=foo%FE%FF%00%2Fbar"))
49 |
50 |
51 | (is (= (form-decode-str "foo=bar+baz") "foo=bar baz"))
52 | ; (is (nil? (form-decode-str "%D"))) ;wtf?
53 |
54 | (are [x y] (= (form-decode x) y)
55 | "foo" "foo"
56 | "a=b" {"a" "b"}
57 | "a=b&c=d" {"a" "b" "c" "d"}
58 | "foo+bar" "foo bar"
59 | "a=b+c" {"a" "b c"}
60 | "a=b%2Fc" {"a" "b/c"})
61 | #_(is (= (form-decode "a=foo%FE%FF%00%2Fbar" "UTF-16")
62 | {"a" "foo/bar"}))
63 | )
64 |
--------------------------------------------------------------------------------
/src/dogfort/dev/testmain.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.dev.testmain
2 | (:use-macros [redlobster.macros :only [promise defer-node waitp
3 | when-realised let-realised]]
4 | [dogfort.middleware.routes-macros :only [defroutes GET POST ANY]])
5 | (:require-macros [cljs.node-macros :as n]
6 | [hiccups.core :as hiccups])
7 | (:use [dogfort.http :only [run-http]]
8 | [dogfort.middleware.file :only [wrap-file]]
9 | [dogfort.middleware.body-parser :only [wrap-body-parser]]
10 | [cljs.node :only [log]]
11 | )
12 | (:require [cljs.nodejs]
13 | dogfort.middleware.nested-params-test
14 | [dogfort.middleware.defaults :as defaults]
15 | [redlobster.promise :as p]
16 | [redlobster.mongo :as mongo]
17 | [dogfort.middleware.routes]
18 | [dogfort.util.response :as response]
19 | [dogfort.dev.nrepl :as nrepl]
20 | [hiccups.runtime]))
21 |
22 | (cljs.nodejs/enable-util-print!)
23 |
24 | (defn concept-item [item]
25 | [:li {:class (if (item "done") "done" "open")}
26 | [:form {:method "POST" :action (str "/check/" (item "_id"))}
27 | [:input.check {:type "submit" :value (if (item "done") "\u2611" "\u2610")}]]
28 | [:form {:method "POST" :action (str "/delete/" (item "_id"))}
29 | [:input.delete {:type "submit" :value "x"}]]
30 | [:span.todo (item "name")]])
31 |
32 | (defn page-template [items]
33 | (hiccups/html
34 | [:html
35 | [:head
36 | [:link {:rel "stylesheet" :href "/screen.css"}]]
37 | [:body
38 | [:h1 "Cat Fort Assault Plan"]
39 | [:ul (map concept-item items)]
40 | [:form {:method "POST" :action "/new"}
41 | [:input {:type "text" :name "new"}]]]]))
42 |
43 | (defroutes handler
44 | (ANY "/" req
45 | {:status 200
46 | :body (pr-str req)
47 | :session {:hi {:value "therez"}}})
48 | )
49 |
50 | (defn main [& args]
51 | (println "starting")
52 | (-> handler
53 | (defaults/wrap-defaults)
54 | (run-http {:port 5000})))
55 |
56 | (set! *main-cli-fn* main)
57 |
--------------------------------------------------------------------------------
/src/dogfort/http.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.http
2 | (:require-macros [cljs.node-macros :as n])
3 | (:require [cljs.node :as node]
4 | [redlobster.events :as e]
5 | [redlobster.stream :as s]
6 | [redlobster.promise :as p]
7 | [dogfort.util.response :as response]))
8 |
9 | (n/require "http" http)
10 | (n/require "url" url)
11 | (n/require "stream" Stream)
12 | (n/require "ws" ws)
13 |
14 | (defprotocol IHTTPResponseWriter
15 | (-write-response [data res] "Write data to a http.ServerResponse"))
16 |
17 | (defn- send-result [res ring-result]
18 | (if-not (:keep-alive ring-result)
19 | (if ring-result
20 | (let [{:keys [status headers body end-stream?]} ring-result]
21 | (set! (.-statusCode res) status)
22 | (doseq [[header value] headers]
23 | (.setHeader res (clj->js header) (clj->js value)))
24 | (when (-write-response body res)
25 | (.end res))
26 | (when (and (s/stream? body) end-stream?)
27 | (.end body))))))
28 |
29 | (defn- send-error-page [res status err]
30 | (send-result res (response/default-response 500)))
31 |
32 | (extend-protocol IHTTPResponseWriter
33 |
34 | nil
35 | (-write-response [data res] true)
36 |
37 | string
38 | (-write-response [data res]
39 | (.write res data)
40 | true)
41 |
42 | PersistentVector
43 | (-write-response [data res]
44 | (doseq [i data] (-write-response i res))
45 | true)
46 |
47 | List
48 | (-write-response [data res]
49 | (doseq [i data] (-write-response i res))
50 | true)
51 |
52 | LazySeq
53 | (-write-response [data res]
54 | (doseq [i data] (-write-response i res))
55 | true)
56 |
57 | js/Buffer
58 | (-write-response [data res]
59 | (.write res data)
60 | true)
61 |
62 | Stream
63 | (-write-response [data res]
64 | (e/on data :error #(send-error-page res 500 %))
65 | (.pipe data res)
66 | false))
67 |
68 | (defn- build-listener [handler options]
69 | (fn [req res]
70 | (let [
71 | url (.parse url (.-url req))
72 | uri (.-pathname url)
73 | query (.-search url)
74 | query (if query (.substring query 1))
75 | headers (js->clj (.-headers req))
76 | conn (.-connection req)
77 | address (js->clj (.address conn))
78 | peer-cert-fn (.-getPeerCertificate conn)
79 | ring-req
80 | {:server-port (address "port")
81 | :server-name (address "address")
82 | :remote-addr (.-remoteAddress conn)
83 | :uri uri
84 | :query-string query
85 | :scheme "http"
86 | :request-method (keyword (.toLowerCase (.-method req)))
87 | :content-type (headers "content-type")
88 | :content-length (headers "content-length")
89 | :character-encoding nil
90 | :ssl-client-cert (when peer-cert-fn (peer-cert-fn))
91 | :headers headers
92 | :body req
93 | :response res
94 | }
95 | result (handler ring-req)]
96 | (p/on-realised result
97 | #(send-result res %)
98 | #(send-error-page res 500 %)))))
99 |
100 | (defn ws-handler [handler websocket]
101 | (let [
102 | upgrade-req (.-upgradeReq websocket)
103 | url (.parse url (.-url upgrade-req))
104 | uri (.-pathname url)
105 | query (.-search url)
106 | query (if query (.substring query 1))
107 | headers (js->clj (.-headers upgrade-req))
108 | conn (.-connection upgrade-req)
109 | address (js->clj (.address conn))
110 | ]
111 | (handler {:server-port (address "port")
112 | :server-name (address "address")
113 | :uri uri
114 | :query-string query
115 | :headers headers
116 | :websocket websocket
117 | :websocket? true
118 | :request-method :get
119 | })))
120 |
121 | (defn run-http [handler options]
122 | (let [server (.createServer http (build-listener handler options))
123 | wss (ws.Server. #js{:server server})
124 | ]
125 | (.on wss "connection" #(ws-handler handler %))
126 | (.listen server (:port options))))
127 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/body_parser.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.body-parser
2 | (:use [cljs.node :only [log]])
3 | (:use-macros [redlobster.macros :only [let-realised]])
4 | (:require [redlobster.stream :as s]
5 | [dogfort.util.codec :as codec]))
6 |
7 | (defn- merge-params [request params]
8 | (assoc request :params (merge (:params request {}) params)))
9 |
10 | (defn- is-form-encoded? [request]
11 | (and
12 | (= (:request-method request) :post)
13 | (= (:content-type request) "application/x-www-form-urlencoded")))
14 |
15 | (defn wrap-body-parser [handler]
16 | (fn [request]
17 | (if-not (is-form-encoded? request)
18 | (handler request)
19 | (let-realised
20 | [body (s/read-stream (:body request))]
21 | (let [form-params (codec/form-decode @body)]
22 | (handler (merge-params request form-params)))))))
23 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/cookies.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.cookies
2 | "Middleware for parsing and generating cookies."
3 | #_(:import [org.joda.time DateTime Interval])
4 | (:require [dogfort.util.codec :as codec]
5 | [clojure.string :as str]
6 | [redlobster.promise :as p])
7 | (:use-macros
8 | [redlobster.macros :only [promise let-realised]]
9 | ))
10 |
11 | (def ^{:doc "HTTP token: 1*. See RFC2068"
12 | :added "1.3"}
13 | re-token
14 | #"[!#$%&'*\-+.0-9A-Z\^_`a-z\|~]+")
15 |
16 | (def ^{:private true, :doc "RFC6265 cookie-octet"}
17 | re-cookie-octet
18 | #"[!#$%&'()*+\-./0-9:<=>?@A-Z\[\]\^_`a-z\{\|\}~]")
19 |
20 | (def ^{:private true, :doc "RFC6265 cookie-value"}
21 | re-cookie-value
22 | (re-pattern (str "\"" (.-source re-cookie-octet) "*\"|" (.-source re-cookie-octet) "*")))
23 |
24 | (def ^{:private true, :doc "RFC6265 set-cookie-string"}
25 | re-cookie
26 | (re-pattern (str "\\s*(" (.-source re-token) ")=(" (.-source re-cookie-value) ")\\s*[;,]?")))
27 |
28 | (def ^{:private true
29 | :doc "Attributes defined by RFC6265 that apply to the Set-Cookie header."}
30 | set-cookie-attrs
31 | {:domain "Domain", :max-age "Max-Age", :path "Path"
32 | :secure "Secure", :expires "Expires", :http-only "HttpOnly"})
33 |
34 | #_(def ^:private rfc822-formatter
35 | (with-locale (formatters :rfc822) java.util.Locale/US))
36 |
37 | (defn- parse-cookie-header
38 | "Turn a HTTP Cookie header into a list of name/value pairs."
39 | [header]
40 | (for [[_ name value] (re-seq re-cookie header)]
41 | [name value]))
42 |
43 | (defn- strip-quotes
44 | "Strip quotes from a cookie value."
45 | [value]
46 | (str/replace value #"^\"|\"$" ""))
47 |
48 | (defn- decode-values [cookies decoder]
49 | (for [[name value] cookies]
50 | (if-let [value (decoder (strip-quotes value))]
51 | [name {:value value}])))
52 |
53 | (defn- parse-cookies
54 | "Parse the cookies from a request map."
55 | [request encoder]
56 | (if-let [cookie (get-in request [:headers "cookie"])]
57 | (->> cookie
58 | parse-cookie-header
59 | ((fn [c] (decode-values c encoder)))
60 | (remove nil?)
61 | (into {}))
62 | {}))
63 |
64 | (defn- write-value
65 | "Write the main cookie value."
66 | [key value encoder]
67 | (encoder {key value}))
68 |
69 | (defn- valid-attr?
70 | "Is the attribute valid?"
71 | [[key value]]
72 | (and (contains? set-cookie-attrs key)
73 | (= -1 (.indexOf (str value) ";"))
74 | (case key
75 | :max-age (or #_(instance? Interval value) (integer? value))
76 | :expires (or (instance? js/Date value) (string? value))
77 | true)))
78 |
79 | (defn- write-attr-map
80 | "Write a map of cookie attributes to a string."
81 | [attrs]
82 | {:pre [(every? valid-attr? attrs)]}
83 | (for [[key value] attrs]
84 | (let [attr-name (name (set-cookie-attrs key))]
85 | (cond
86 | ; (instance? Interval value) (str ";" attr-name "=" (in-seconds value))
87 | ; (instance? js/Date value) (str ";" attr-name "=" (unparse rfc822-formatter value))
88 | (true? value) (str ";" attr-name)
89 | (false? value) ""
90 | :else (str ";" attr-name "=" value)))))
91 |
92 | (defn- write-cookies
93 | "Turn a map of cookies into a seq of strings for a Set-Cookie header."
94 | [cookies encoder]
95 | (for [[key value] cookies]
96 | (if (map? value)
97 | (apply str (write-value key (:value value) encoder)
98 | (write-attr-map (dissoc value :value)))
99 | (write-value key value encoder))))
100 |
101 | (defn- set-cookies
102 | "Add a Set-Cookie header to a response if there is a :cookies key."
103 | [response encoder]
104 | (if-let [cookies (:cookies response)]
105 | (update-in response
106 | [:headers "Set-Cookie"]
107 | concat
108 | (doall (write-cookies cookies encoder)))
109 | response))
110 |
111 | (defn cookies-request
112 | "Parses cookies in the request map. See: wrap-cookies."
113 | {:arglists '([request] [request options])
114 | :added "1.2"}
115 | [request & [{:keys [decoder] :or {decoder codec/form-decode-str}}]]
116 | (if (request :cookies)
117 | request
118 | (assoc request :cookies (parse-cookies request decoder))))
119 |
120 | (defn cookies-response
121 | "For responses with :cookies, adds Set-Cookie header and returns response
122 | without :cookies. See: wrap-cookies."
123 | {:arglists '([response] [response options])
124 | :added "1.2"}
125 | [response & [{:keys [encoder] :or {encoder codec/form-encode}}]]
126 | (let-realised [response response]
127 | (-> @response (set-cookies encoder) (dissoc :cookies))))
128 |
129 | #_(defn wrap-cookies2 [handler]
130 | (fn [request]
131 | (let-realised
132 | [request (nrepl/my-eval `(cookies/cookies-request ~(dissoc request :body)))]
133 | (let-realised
134 | [response (handler @request)]
135 | (let-realised
136 | [response (nrepl/my-eval `(cookies/cookies-response ~(deref response)))]
137 | @response)))))
138 |
139 | (defn wrap-cookies
140 | "Parses the cookies in the request map, then assocs the resulting map
141 | to the :cookies key on the request.
142 |
143 | Accepts the following options:
144 |
145 | :decoder - a function to decode the cookie value. Expects a function that
146 | takes a string and returns a string. Defaults to URL-decoding.
147 |
148 | :encoder - a function to encode the cookie name and value. Expects a
149 | function that takes a name/value map and returns a string.
150 | Defaults to URL-encoding.
151 |
152 | Each cookie is represented as a map, with its value being held in the
153 | :value key. A cookie may optionally contain a :path, :domain or :port
154 | attribute.
155 |
156 | To set cookies, add a map to the :cookies key on the response. The values
157 | of the cookie map can either be strings, or maps containing the following
158 | keys:
159 |
160 | :value - the new value of the cookie
161 | :path - the subpath the cookie is valid for
162 | :domain - the domain the cookie is valid for
163 | :max-age - the maximum age in seconds of the cookie
164 | :expires - a date string at which the cookie will expire
165 | :secure - set to true if the cookie requires HTTPS, prevent HTTP access
166 | :http-only - set to true if the cookie is valid for HTTP and HTTPS only
167 | (ie. prevent JavaScript access)"
168 | {:arglists '([handler] [handler options])}
169 | [handler & [{:keys [decoder encoder]
170 | :or {decoder codec/form-decode-str
171 | encoder codec/form-encode}}]]
172 | (fn [request]
173 | (-> request
174 | (cookies-request {:decoder decoder})
175 | handler
176 | (cookies-response {:encoder encoder}))))
177 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/defaults.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.defaults
2 | (:require
3 | [dogfort.middleware.file :as file]
4 | [dogfort.middleware.params :as params]
5 | [dogfort.middleware.keyword-params :as keyword-params]
6 | [dogfort.middleware.session :as session]
7 | [dogfort.middleware.cookies :as cookies]
8 | [dogfort.middleware.edn :as edn]
9 | [dogfort.middleware.multipart-params :as multipart-params]
10 | )
11 | (:require-macros
12 | [dogfort.middleware.defaults-macros :refer [wrap]]))
13 |
14 | (defn wrap-defaults [handler options]
15 | (wrap (file/wrap-file handler (:wrap-file options "static"))
16 | session/wrap-session
17 | cookies/wrap-cookies
18 | keyword-params/wrap-keyword-params
19 | params/wrap-params
20 | edn/wrap-edn-params
21 | multipart-params/wrap-multipart-params
22 | ))
23 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/defaults_macros.clj:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.defaults-macros)
2 |
3 | (defmacro wrap [handler & syms]
4 | `(->
5 | ~handler
6 | ~@(for [sym syms]
7 | `(~sym (get ~'options ~(-> sym str (.split "/") last keyword))))))
8 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/edn.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.edn
2 | (:require
3 | [redlobster.promise]
4 | [redlobster.stream :as stream]
5 | [cljs.reader :refer [read-string]]
6 | )
7 | (:require-macros
8 | [redlobster.macros :refer [let-realised]])
9 | )
10 |
11 | (defn- edn-request?
12 | [req]
13 | (if-let [type (get-in req [:headers "content-type"] "")]
14 | (not (empty? (re-find #"^application/(vnd.+)?edn" type)))))
15 |
16 | (defn wrap-edn-params
17 | "If the request has the edn content-type, it will attempt to read
18 | the body as edn and then assoc it to the request under :edn-params
19 | and merged to :params.
20 |
21 | It may take an opts map to pass to clojure.edn/read-string"
22 | ([handler] (wrap-edn-params handler {}))
23 | ([handler opts]
24 | (fn [req]
25 | (if-let [body (and (edn-request? req) (:body req))]
26 | (let-realised
27 | [s (stream/read-stream body)]
28 | (let [
29 | edn-params (read-string @s)
30 | ]
31 | (handler (assoc req :edn-params edn-params :params (merge (:params req) edn-params)))))
32 | (handler req)))))
33 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/file.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.file
2 | (:require-macros [cljs.node-macros :as n])
3 | (:use-macros [redlobster.macros :only [promise waitp let-realised]])
4 | (:require [redlobster.io :as io]
5 | [redlobster.promise :as p]
6 | [dogfort.util.codec :as codec]
7 | [dogfort.util.mime-type :as mime]
8 | [dogfort.util.time :as time]
9 | [cljs.node :as node]))
10 |
11 | (n/require "fs" fs)
12 | (n/require "path" path)
13 | (n/require "crypto" crypto)
14 |
15 | (defn- normalise-path [^string file ^string root]
16 | (let [file (.join path root file)]
17 | (if (and (> (count file) (count root))
18 | (= root (.slice file 0 (count root))))
19 | file nil)))
20 |
21 | (defn- stat-file [^string file opts]
22 | (promise
23 | (if-let [file (normalise-path file (:root opts))]
24 | (.stat fs file
25 | (fn [err stats]
26 | (if err (realise-error err)
27 | (do (aset stats "path" file)
28 | (realise stats)))))
29 | (realise-error nil))))
30 |
31 | (defn- etag [stats]
32 | (-> (.createHash crypto "md5")
33 | (.update (str (.-ino stats) "/" (.-mtime stats) "/" (.-size stats)))
34 | (.digest "hex")))
35 |
36 | (defn- last-modified [stats]
37 | (time/rfc822-date (.-mtime stats)))
38 |
39 | (defn- expand-dir [^string path]
40 | (try
41 | (.realpathSync fs path)
42 | (catch :default e (throw (str "Directory does not exist: " path)))))
43 |
44 | (defn- file-response [stats]
45 | (let [file (.-path stats)]
46 | (let-realised [s (io/binary-slurp file)]
47 | {:status 200
48 | :headers {:content-type (mime/ext-mime-type file)
49 | :content-length (.-size stats)
50 | :last-modified (last-modified stats)
51 | :etag (etag stats)}
52 | :body @s})))
53 |
54 | (defn wrap-file [app ^string root-path & [opts]]
55 | (let [opts (merge {:root (expand-dir root-path)
56 | :index-files? true
57 | :allow-symlinks? false}
58 | opts)]
59 | (fn [req]
60 | (if-not (or (= :get (:request-method req))
61 | (= :head (:request-method req)))
62 | (app req)
63 | (let [file (.slice (codec/url-decode (:uri req)) 1)
64 | stat-p (stat-file file opts)]
65 | (waitp stat-p
66 | #(realise (file-response %))
67 | #(realise (app req))))))))
68 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/keyword_params.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.keyword-params
2 | "Middleware that converts parameter keys in the request to keywords.")
3 |
4 | (defn- keyword-syntax? [s]
5 | (re-matches #"[A-Za-z*+!_?-][A-Za-z0-9*+!_?-]*" s))
6 |
7 | (defn- keyify-params [target]
8 | (cond
9 | (map? target)
10 | (into {}
11 | (for [[k v] target]
12 | [(if (and (string? k) (keyword-syntax? k))
13 | (keyword k)
14 | k)
15 | (keyify-params v)]))
16 | (vector? target)
17 | (vec (map keyify-params target))
18 | :else
19 | target))
20 |
21 | (defn keyword-params-request
22 | "Converts string keys in :params map to keywords. See: wrap-keyword-params."
23 | {:added "1.2"}
24 | [request]
25 | (update-in request [:params] keyify-params))
26 |
27 | (defn wrap-keyword-params
28 | "Middleware that converts the any string keys in the :params map to keywords.
29 | Only keys that can be turned into valid keywords are converted.
30 |
31 | This middleware does not alter the maps under :*-params keys. These are left
32 | as strings."
33 | [handler]
34 | (fn [request]
35 | (handler (keyword-params-request request))))
36 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/multipart_params.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.multipart-params
2 | (:require [redlobster.stream :as stream]
3 | [redlobster.promise :as promise]
4 | )
5 | (:require-macros [dogfort.util.macros :refer [symzip]]
6 | [redlobster.macros :refer [promise let-realised]]
7 | ))
8 |
9 | (def Busboy (js/require "busboy"))
10 |
11 | (defn value-map [f m]
12 | (zipmap (keys m) (map f (vals m))))
13 |
14 | (defn wrap-multipart-params [handler]
15 | (fn [{:keys [body request-method] :as req}]
16 | (if (= :post request-method)
17 | (try
18 | (let [
19 | busboy (Busboy. (clj->js {:headers (.-headers body)}))
20 | params (atom {})
21 | handler-promise (promise/promise)
22 | ]
23 | (.on busboy "file"
24 | (fn [fieldname file filename encoding mimetype]
25 | (let-realised
26 | [data (stream/read-binary-stream file)]
27 | (let [data @data]
28 | (swap! params assoc (keyword fieldname) (symzip data filename encoding mimetype))))))
29 | (.on busboy "field"
30 | (fn [fieldname val fieldname-truncated val-truncated encoding mimetype]
31 | (swap! params assoc (keyword fieldname) val)))
32 | (.on busboy "finish"
33 | (fn []
34 | (promise/realise
35 | handler-promise
36 | (handler
37 | (assoc
38 | (update-in req [:params] merge @params)
39 | :multipart-params @params)))))
40 | (.pipe body busboy)
41 | handler-promise
42 | )
43 | (catch :default e
44 | (handler req)))
45 | (handler req))))
46 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/nested_params.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.nested-params
2 | "Middleware to convert a single-depth map of parameters to a nested map."
3 | )
4 |
5 | (defn assoc-conj
6 | "Associate a key with a value in a map. If the key already exists in the map,
7 | a vector of values is associated with the key."
8 | [map key val]
9 | (assoc map key
10 | (if-let [cur (get map key)]
11 | (if (vector? cur)
12 | (conj cur val)
13 | [cur val])
14 | val)))
15 |
16 | (defn parse-nested-keys
17 | "Parse a parameter name into a list of keys using a 'C'-like index
18 | notation.
19 |
20 | For example:
21 |
22 | \"foo[bar][][baz]\"
23 | => [\"foo\" \"bar\" \"\" \"baz\"]"
24 | [param-name]
25 | (let [[_ k ks] (re-find #"^([\s\S]*?)((?:\[[\s\S]*?\])*)$" (name param-name))
26 | keys (if ks (map second (re-seq #"\[(.*?)\]" ks)))]
27 | (cons k keys)))
28 |
29 | (defn- assoc-vec [m k v]
30 | (let [m (if (contains? m k) m (assoc m k []))]
31 | (assoc-conj m k v)))
32 |
33 | (defn- assoc-nested
34 | "Similar to assoc-in, but treats values of blank keys as elements in a
35 | list."
36 | [m [k & ks] v]
37 | (if k
38 | (if ks
39 | (let [[j & js] ks]
40 | (if (= j "")
41 | (assoc-vec m k (assoc-nested {} js v))
42 | (assoc m k (assoc-nested (get m k {}) ks v))))
43 | (assoc-conj m k v))
44 | v))
45 |
46 | (defn- param-pairs
47 | "Return a list of name-value pairs for a parameter map."
48 | [params]
49 | (mapcat
50 | (fn [[name value]]
51 | (if (and (sequential? value) (not (coll? (first value))))
52 | (for [v value] [name v])
53 | [[name value]]))
54 | params))
55 |
56 | (defn- nest-params
57 | "Takes a flat map of parameters and turns it into a nested map of
58 | parameters, using the function parse to split the parameter names
59 | into keys."
60 | [params parse]
61 | (reduce
62 | (fn [m [k v]]
63 | (assoc-nested m (parse k) v))
64 | {}
65 | (param-pairs params)))
66 |
67 | (defn nested-params-request
68 | "Converts a request with a flat map of parameters to a nested map.
69 | See: wrap-nested-params."
70 | {:arglists '([request] [request options])
71 | :added "1.2"}
72 | [request & [opts]]
73 | (let [parse (:key-parser opts parse-nested-keys)]
74 | (update-in request [:params] nest-params parse)))
75 |
76 | (defn wrap-nested-params
77 | "Middleware to converts a flat map of parameters into a nested map.
78 | Accepts the following options:
79 |
80 | :key-parser - the function to use to parse the parameter names into a list
81 | of keys. Keys that are empty strings are treated as elements in
82 | a vector, non-empty keys are treated as elements in a map.
83 | Defaults to the parse-nested-keys function.
84 |
85 | For example:
86 |
87 | {\"foo[bar]\" \"baz\"}
88 | => {\"foo\" {\"bar\" \"baz\"}}
89 |
90 | {\"foo[]\" \"bar\"}
91 | => {\"foo\" [\"bar\"]}"
92 | {:arglists '([handler] [handler options])}
93 | [handler & [options]]
94 | (fn [request]
95 | (handler (nested-params-request request options))))
96 |
97 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/nested_params_test.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.nested-params-test
2 | (:require-macros
3 | [dogfort.util.macros :refer [is are testing]])
4 | (:require
5 | [dogfort.middleware.nested-params :refer [wrap-nested-params nested-params-request]]
6 | [clojure.string :as string]
7 | ))
8 |
9 | (let [handler (wrap-nested-params :params)]
10 | (testing "nested parameter maps"
11 | (are [p r] (= (handler {:params p}) r)
12 | {"foo" "bar"} {"foo" "bar"}
13 | {"x[y]" "z"} {"x" {"y" "z"}}
14 | {"a[b][c]" "d"} {"a" {"b" {"c" "d"}}}
15 | {"a" "b", "c" "d"} {"a" "b", "c" "d"}))
16 | (testing "nested parameter lists"
17 | (are [p r] (= (handler {:params p}) r)
18 | {"foo[]" "bar"} {"foo" ["bar"]}
19 | {"foo[]" ["bar" "baz"]} {"foo" ["bar" "baz"]})
20 | (let [params (handler {:params {"a[x][]" ["b"], "a[x][][y]" "c"}})]
21 | (is (= (keys params) ["a"]))
22 | (is (= (keys (params "a")) ["x"]))
23 | (is (= (set (get-in params ["a" "x"])) #{"b" {"y" "c"}})))
24 | (let [params (handler {:params {"a[][x]" "c", "a[][y]" "d"}})]
25 | (is (= (keys params) ["a"]))
26 | (is (= (set (params "a")) #{{"x" "c"} {"y" "d"}}))))
27 | (testing "duplicate parameters"
28 | (are [p r] (= (handler {:params p}) r)
29 | {"a" ["b" "c"]} {"a" ["b" "c"]}
30 | {"a[b]" ["c" "d"]} {"a" {"b" ["c" "d"]}}))
31 | (testing "parameters with newlines"
32 | (are [p r] (= (handler {:params p}) r)
33 | {"foo\nbar" "baz"} {"foo\nbar" "baz"}))
34 | (testing "parameters are already nested"
35 | (is (= {"foo" [["bar" "baz"] ["asdf" "zxcv"]]}
36 | (handler {:params {"foo" [["bar" "baz"] ["asdf" "zxcv"]]}}))))
37 | (testing "pre-nested vector of maps"
38 | (is (= {"foo" [{"bar" "baz"} {"asdf" "zxcv"}]}
39 | (handler {:params {"foo" [{"bar" "baz"} {"asdf" "zxcv"}]}}))))
40 | (testing "pre-nested map"
41 | (is (= {"foo" [{"bar" "baz" "asdf" "zxcv"}]}
42 | (handler {:params {"foo" [{"bar" "baz" "asdf" "zxcv"}]}}))))
43 | (testing "double-nested map"
44 | (is (= {"foo" {"key" {"bar" "baz" "asdf" "zxcv"}}}
45 | (handler {:params {"foo" {"key" {"bar" "baz" "asdf" "zxcv"}}}})))))
46 |
47 | #_(let [handler (wrap-nested-params :params
48 | {:key-parser #(string/split % #"\.")})]
49 | (testing ":key-parser option"
50 | (are [p r] (= (handler {:params p}) r)
51 | {"foo" "bar"} {"foo" "bar"}
52 | {"x.y" "z"} {"x" {"y" "z"}}
53 | {"a.b.c" "d"} {"a" {"b" {"c" "d"}}}
54 | {"a" "b", "c" "d"} {"a" "b", "c" "d"})))
55 |
56 | ;(is (fn? nested-params-request))
57 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/params.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.params
2 | "Middleware to parse url-encoded parameters from the query string and request
3 | body."
4 | (:require [dogfort.util.codec :as codec]
5 | [dogfort.util.request :as req]
6 | [redlobster.stream :as stream]
7 | [redlobster.promise :as p])
8 | (:use-macros [redlobster.macros :only [promise let-realised]]))
9 |
10 | (defn- parse-params [params encoding]
11 | (let [params (codec/form-decode params encoding)]
12 | (if (map? params) params {})))
13 |
14 | (defn assoc-query-params
15 | "Parse and assoc parameters from the query string with the request."
16 | {:added "1.3"}
17 | [request encoding]
18 | (merge-with merge request
19 | (if-let [query-string (:query-string request)]
20 | (let [params (parse-params query-string encoding)]
21 | {:query-params params, :params params})
22 | {:query-params {}, :params {}})))
23 |
24 | #_(defn slurp [body]
25 | (println "slurping")
26 | (promise
27 | (let [sb (js/Array.)]
28 | (.on body "data" #(.push sb %))
29 | (.on body "end" #(realise (.join sb ""))))))
30 |
31 | #_(defn assoc-form-params
32 | "Parse and assoc parameters from the request body with the request."
33 | {:added "1.2"}
34 | [handler request encoding]
35 | (if-let [body (and (req/urlencoded-form? request) (:body request))]
36 | (let-realised
37 | [body (slurp body)]
38 | (println "slurped")
39 | (let [params (parse-params @body encoding)
40 | request (merge-with merge request {:form-params params, :params params})]
41 | (let-realised [response (handler request)]
42 | @response)))
43 | (handler
44 | (merge-with
45 | merge
46 | request
47 | {:form-params {}, :params {}}))))
48 |
49 | (defn params-request
50 | "Adds parameters from the query string and the request body to the request
51 | map. See: wrap-params."
52 | {:arglists '([request] [request options])
53 | :added "1.2"}
54 | [handler request & [opts]]
55 | (let [encoding (or (:encoding opts)
56 | (req/character-encoding request)
57 | "UTF-8")
58 | request (if (:query-params request)
59 | request
60 | (assoc-query-params request encoding))
61 | ]
62 | (handler request)))
63 |
64 | (defn wrap-params
65 | "Middleware to parse urlencoded parameters from the query string and form
66 | body (if the request is a url-encoded form). Adds the following keys to
67 | the request map:
68 |
69 | :query-params - a map of parameters from the query string
70 | :form-params - a map of parameters from the body
71 | :params - a merged map of all types of parameter
72 |
73 | Accepts the following options:
74 |
75 | :encoding - encoding to use for url-decoding. If not specified, uses
76 | the request character encoding, or \"UTF-8\" if no request
77 | character encoding is set."
78 | {:arglists '([handler] [handler options])}
79 | [handler & [options]]
80 | (fn [request]
81 | (params-request handler request options)))
82 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/routes.cljs:
--------------------------------------------------------------------------------
1 | ; From https://github.com/eduardoejp/snout/blob/master/src/snout/core.cljs
2 |
3 | (ns dogfort.middleware.routes
4 | (:use-macros [dogfort.middleware.routes-macros :only [compile-route ANY]]
5 | [redlobster.macros :only [promise]])
6 | (:use [cljs.node :only [log]])
7 | (:require [redlobster.promise :as p]
8 | [dogfort.util.response :as response]
9 | [dogfort.util.codec :as codec]
10 | ))
11 |
12 | (defn- route-match
13 | "Matches the URL to the matcher and (if they coincide) returns a set of
14 | route bindings."
15 | [url matcher]
16 | (let [
17 | url (rest (.split url "/"))
18 | ]
19 | (loop [[m & matcher] matcher
20 | [u & url] url
21 | res {}]
22 | (cond
23 | (not (or m u)) res
24 | (not (and m u)) nil
25 | (= "*" m) (assoc res :* (apply str (interpose "/" (list* u url))))
26 | (.startsWith m ":")
27 | (recur matcher url (assoc res
28 | (keyword (.substring m 1))
29 | (codec/url-decode u)))
30 | (= m u)
31 | (recur matcher url res)))))
32 |
33 | (defn- merge-params [request params]
34 | (assoc request :params (merge (:params request {}) params)))
35 |
36 | (defn eval-route [request method matcher handler]
37 | (when (or (not method) (= (:request-method request) method))
38 | (when-let [matches (route-match (:uri request) matcher)]
39 | (handler (merge-params request matches)))))
40 |
41 | (defn routing [request & handlers]
42 | (let [response (some #(% request) handlers)]
43 | (cond (p/promise? response) response
44 | (map? response) (p/promise response)
45 | response (p/promise (response/response 200 response)))))
46 |
47 | (defn routes [& handlers]
48 | #(apply routing % handlers))
49 |
50 | (def not-found
51 | (ANY "*" []
52 | (response/default-response 404)))
53 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/routes_macros.clj:
--------------------------------------------------------------------------------
1 | ; Not so much code from Compojure and Snout here
2 |
3 | (ns dogfort.middleware.routes-macros)
4 |
5 | (defn- make-matcher [route]
6 | (cond
7 | (= route "/") [""]
8 | (.contains route "/")
9 | (vec (rest (.split route "/")))
10 | :default route))
11 |
12 | (defn- assoc-&-binding [binds req sym]
13 | (assoc binds sym `(dissoc (:params ~req)
14 | ~@(map keyword (keys binds))
15 | ~@(map str (keys binds)))))
16 |
17 | (defn- assoc-symbol-binding [binds req sym]
18 | (assoc binds sym `(get-in ~req [:params ~(keyword sym)]
19 | (get-in ~req [:params ~(str sym)]))))
20 |
21 | (defn- vector-bindings
22 | "Create the bindings for a vector of parameters."
23 | [args req]
24 | (loop [args args, binds {}]
25 | (if-let [sym (first args)]
26 | (cond
27 | (= '& sym)
28 | (recur (nnext args) (assoc-&-binding binds req (second args)))
29 | (= :as sym)
30 | (recur (nnext args) (assoc binds (second args) req))
31 | (symbol? sym)
32 | (recur (next args) (assoc-symbol-binding binds req sym))
33 | :else
34 | (throw (Exception. (str "Unexpected binding: " sym))))
35 | (mapcat identity binds))))
36 |
37 | (defmacro let-request [[bindings request] & forms]
38 | (if (vector? bindings)
39 | `(let [~@(vector-bindings bindings request)] ~@forms)
40 | `(let [~bindings ~request] ~@forms)))
41 |
42 | (defn- compile-route [method route bindings forms]
43 | `(fn [request#]
44 | (dogfort.middleware.routes/eval-route
45 | request# ~method ~(make-matcher route)
46 | (fn [request#]
47 | (let-request [~bindings request#]
48 | ~@forms)))))
49 |
50 | (defmacro GET [route bindings & forms]
51 | (compile-route :get route bindings forms))
52 |
53 | (defmacro POST [route bindings & forms]
54 | (compile-route :post route bindings forms))
55 |
56 | (defmacro PUT [route bindings & forms]
57 | (compile-route :lout route bindings forms))
58 |
59 | (defmacro DELETE [route bindings & forms]
60 | (compile-route :delete route bindings forms))
61 |
62 | (defmacro HEAD [route bindings & forms]
63 | (compile-route :head route bindings forms))
64 |
65 | (defmacro OPTIONS [route bindings & forms]
66 | (compile-route :options route bindings forms))
67 |
68 | (defmacro PATCH [route bindings & forms]
69 | (compile-route :patch route bindings forms))
70 |
71 | (defmacro ANY [route bindings & forms]
72 | (compile-route nil route bindings forms))
73 |
74 | (defmacro defroutes [name & routes]
75 | `(def ~name (dogfort.middleware.routes/routes ~@routes)))
76 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/session.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.session
2 | "Middleware for maintaining browser sessions using cookies.
3 |
4 | Sessions are stored using types that adhere to the
5 | dogfort.middleware.session.store/SessionStore protocol.
6 | Ring comes with two stores included:
7 |
8 | dogfort.middleware.session.memory/memory-store
9 | dogfort.middleware.session.cookie/cookie-store"
10 | (:require [dogfort.middleware.cookies :as cookies]
11 | [dogfort.middleware.session.store :as store]
12 | [dogfort.middleware.session.memory :as mem]
13 | [redlobster.promise :as p])
14 | (:use-macros
15 | [redlobster.macros :only [promise waitp let-realised]]
16 | ))
17 |
18 | (defn- session-options
19 | [options]
20 | {:store (:store options (mem/memory-store))
21 | :cookie-name (:cookie-name options "ring-session")
22 | :cookie-attrs (merge {:path "/"
23 | :http-only true}
24 | (:cookie-attrs options)
25 | (if-let [root (:root options)]
26 | {:path root}))})
27 |
28 | (defn- bare-session-request
29 | [request & [{:keys [store cookie-name]}]]
30 | (let [req-key (get-in request [:cookies cookie-name :value])
31 | session (store/read-session store req-key)
32 | session-key (if session req-key)]
33 | (merge request {:session (or session {})
34 | :session/key session-key})))
35 |
36 | (defn session-request
37 | "Reads current HTTP session map and adds it to :session key of the request.
38 | See: wrap-session."
39 | {:arglists '([request] [request options])
40 | :added "1.2"}
41 | [request & [options]]
42 | (-> request
43 | cookies/cookies-request
44 | (bare-session-request options)))
45 |
46 | (defn- bare-session-response
47 | [response {session-key :session/key} & [{:keys [store cookie-name cookie-attrs]}]]
48 | (let [new-session-key (if (contains? response :session)
49 | (if-let [session (response :session)]
50 | (if (:recreate (meta session))
51 | (do
52 | (store/delete-session store session-key)
53 | (store/write-session store nil session))
54 | (store/write-session store session-key session))
55 | (if session-key
56 | (store/delete-session store session-key))))
57 | session-attrs (:session-cookie-attrs response)
58 | cookie {cookie-name
59 | (merge cookie-attrs
60 | session-attrs
61 | {:value (or new-session-key session-key)})}
62 | response (dissoc response :session :session-cookie-attrs)]
63 | (if (or (and new-session-key (not= session-key new-session-key))
64 | (and session-attrs (or new-session-key session-key)))
65 | (assoc response :cookies (merge (response :cookies) cookie))
66 | response)))
67 |
68 | (defn session-response
69 | "Updates session based on :session key in response. See: wrap-session."
70 | {:arglists '([response request] [response request options])
71 | :added "1.2"}
72 | [response request & [options]]
73 | (let-realised
74 | [response response]
75 | (bare-session-response @response request options)))
76 |
77 | (defn wrap-session
78 | "Reads in the current HTTP session map, and adds it to the :session key on
79 | the request. If a :session key is added to the response by the handler, the
80 | session is updated with the new value. If the value is nil, the session is
81 | deleted.
82 |
83 | Accepts the following options:
84 |
85 | :store - An implementation of the SessionStore protocol in the
86 | dogfort.middleware.session.store namespace. This determines how
87 | the session is stored. Defaults to in-memory storage using
88 | dogfort.middleware.session.store/memory-store.
89 |
90 | :root - The root path of the session. Any path above this will not be
91 | able to see this session. Equivalent to setting the cookie's
92 | path attribute. Defaults to \"/\".
93 |
94 | :cookie-name - The name of the cookie that holds the session key. Defaults to
95 | \"ring-session\"
96 |
97 | :cookie-attrs - A map of attributes to associate with the session cookie.
98 | Defaults to {:http-only true}."
99 | ([handler]
100 | (wrap-session handler {}))
101 | ([handler options]
102 | (let [options (session-options options)]
103 | (fn [request]
104 | (let [new-request (session-request request options)]
105 | (-> (handler new-request)
106 | (session-response new-request options)))))))
107 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/session/cookie.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.session.cookie
2 | "A session storage engine that stores session data in encrypted cookies.
3 | Less secure than the ring version. Woof woof!
4 | "
5 | (:require [dogfort.middleware.session.store :refer [SessionStore]]
6 | [dogfort.util.codec :as codec]
7 | ;[clojure.tools.reader.edn :as edn]
8 | ;[crypto.random :as random]
9 | ;[crypto.equality :as crypto]
10 | [cljs.reader :refer [read-string]]
11 | [cljs.nodejs]
12 | )
13 | #_(:import [java.security SecureRandom]
14 | [javax.crypto Cipher Mac]
15 | [javax.crypto.spec SecretKeySpec IvParameterSpec]))
16 |
17 | (cljs.nodejs/enable-util-print!)
18 |
19 | (def crypto (js/require "crypto"))
20 |
21 | (def ^{:private true
22 | :doc "Algorithm to generate a HMAC."}
23 | hmac-algorithm
24 | "HmacSHA256")
25 |
26 | (def ^{:private true
27 | :doc "Type of encryption to use."}
28 | crypt-type
29 | "AES")
30 |
31 | (def ^{:private true
32 | :doc "Full algorithm to encrypt data with."}
33 | crypt-algorithm
34 | "aes-256-ctr")
35 |
36 | #_(defn- hmac
37 | "Generates a Base64 HMAC with the supplied key on a string of data."
38 | [key data]
39 | (doto
40 | (.createHmac crypto hmac-algorithm key)
41 | (.update data)
42 | (.digest "base64")))
43 |
44 | (def hmac (js/Function. "key" "text" "return dogfort.middleware.session.cookie.crypto.createHmac('sha1', key).update(text).digest('base64')"))
45 |
46 | (defn- encrypt
47 | "Encrypt a string with a key."
48 | [key data]
49 | (let [cipher (.createCipher crypto crypt-algorithm key)] ;incorrect
50 | (str
51 | (.update cipher data "utf8" "base64")
52 | (.final cipher "base64"))))
53 |
54 | (defn- decrypt
55 | "Decrypt an array of bytes with a key."
56 | [key data]
57 | (let [decipher (.createDecipher crypto crypt-algorithm key)] ;incorrect
58 | (str
59 | (.update decipher data "base64" "utf8")
60 | (.final decipher "utf8"))))
61 |
62 | (defn- get-secret-key
63 | "Get a valid secret key from a map of options, or create a random one from
64 | scratch."
65 | [options]
66 | (or (:key options) (apply str (repeat 16 #(rand-nth "abcdefghikjlmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890")))))
67 |
68 | (defn- ^String serialize [x]
69 | (pr-str x))
70 |
71 | (defn- seal
72 | "Seal a Clojure data structure into an encrypted and HMACed string."
73 | [key data]
74 | (let [data (encrypt key (pr-str data))]
75 | (str data "--" (hmac key data))))
76 |
77 | (defn- unseal
78 | "Retrieve a sealed Clojure data structure from a string"
79 | [key string]
80 | (let [[data mac] (.split string "--")]
81 | (if (= mac (hmac key data))
82 | (read-string (decrypt key data))
83 | (println string mac (hmac key data) "fail")
84 | )))
85 |
86 | (deftype CookieStore [secret-key]
87 | SessionStore
88 | (read-session [_ data]
89 | (if data (unseal secret-key data)))
90 | (write-session [_ _ data]
91 | (seal secret-key data))
92 | (delete-session [_ _]
93 | (seal secret-key {})))
94 |
95 | #_(defn- valid-secret-key? [key]
96 | (and (= (type (byte-array 0)) (type key))
97 | (= (count key) 16)))
98 |
99 | (defn cookie-store
100 | "Creates an encrypted cookie storage engine. Accepts the following options:
101 |
102 | :key - The secret key to encrypt the session cookie. Must be exactly 16 bytes
103 | If no key is provided then a random key will be generated. Note that in
104 | that case a server restart will invalidate all existing session
105 | cookies."
106 | ([] (cookie-store {}))
107 | ([options]
108 | (let [key (get-secret-key options)]
109 | ; (assert (valid-secret-key? key) "the secret key must be exactly 16 bytes")
110 | (CookieStore. key))))
111 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/session/memory.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.session.memory
2 | "A session storage engine that stores session data in memory."
3 | (:require [dogfort.middleware.session.store :refer [SessionStore]]))
4 |
5 | (deftype MemoryStore [session-map]
6 | SessionStore
7 | (read-session [_ key]
8 | (@session-map key))
9 | (write-session [_ key data]
10 | (let [key (or key (str (gensym)))]
11 | (swap! session-map assoc key data)
12 | key))
13 | (delete-session [_ key]
14 | (swap! session-map dissoc key)
15 | nil))
16 |
17 | (defn memory-store
18 | "Creates an in-memory session storage engine. Accepts an atom as an optional
19 | argument; if supplied, the atom is used to hold the session data."
20 | ([] (memory-store (atom {})))
21 | ([session-atom] (MemoryStore. session-atom)))
22 |
--------------------------------------------------------------------------------
/src/dogfort/middleware/session/store.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.middleware.session.store
2 | "Contains the protocol used to define all Ring session storage engines.")
3 |
4 | (defprotocol SessionStore
5 | "An interface to a session storage engine. Implementing this protocol allows
6 | Ring session data to be stored in different places.
7 |
8 | Session keys are exposed to end users via a cookie, and therefore must be
9 | unguessable. A random UUID is a good choice for a session key.
10 |
11 | Session stores should come with a mechanism for expiring old session data."
12 | (read-session [store key]
13 | "Read a session map from the store. If the key is not found, nil
14 | is returned.")
15 | (write-session [store key data]
16 | "Write a session map to the store. Returns the (possibly changed) key under
17 | which the data was stored. If the key is nil, the session is considered
18 | to be new, and a fresh key should be generated.")
19 | (delete-session [store key]
20 | "Delete a session map from the store, and returns the session key. If the
21 | returned key is nil, the session cookie will be removed."))
22 |
--------------------------------------------------------------------------------
/src/dogfort/util/codec.cljs:
--------------------------------------------------------------------------------
1 | ;; Ported from Ring
2 |
3 | (ns dogfort.util.codec
4 | "Encoding and decoding utilities."
5 | (:use [dogfort.util.data :only [assoc-conj]])
6 | (:require [clojure.string :as str]
7 | [cljs.nodejs]
8 | ))
9 |
10 | (cljs.nodejs/enable-util-print!)
11 |
12 | (defn- double-escape [^String x]
13 | (.replace (.replace x "\\" "\\\\") "$" "\\$"))
14 |
15 | (defn- number->hex [num]
16 | (.toUpperCase (.toString num 16)))
17 |
18 | (defn percent-encode
19 | "Percent-encode every character in the given string using either the specified
20 | encoding, or UTF-8 by default."
21 | [^String unencoded & [^String encoding]]
22 | (let [buf (js/Buffer. unencoded (or encoding "utf8"))
23 | bytes (map #(str "%" (number->hex (aget buf %))) (range (.-length buf)))]
24 | (str/join bytes)))
25 |
26 | (defn- parse-bytes [encoded-bytes]
27 | (->> (re-seq #"%.." encoded-bytes)
28 | (map #(subs % 1))
29 | (map #(js/parseInt % 16))
30 | (clj->js)
31 | (js/Buffer.)))
32 |
33 | (defn percent-decode
34 | "Decode every percent-encoded character in the given string using the
35 | specified encoding, or UTF-8 by default."
36 | [^String encoded & [^String encoding]]
37 | (str/replace encoded
38 | #"(?:%..)+"
39 | (fn [chars]
40 | (-> (parse-bytes chars)
41 | (.toString (or encoding "utf8"))
42 | (.replace "\\" "\\\\")
43 | #_(double-escape)))))
44 |
45 | (defn url-encode
46 | "Returns the url-encoded version of the given string, using either a specified
47 | encoding or UTF-8 by default."
48 | [unencoded & [encoding]]
49 | (str/replace
50 | unencoded
51 | #"[^A-Za-z0-9_~.+-]+"
52 | #(double-escape (percent-encode % encoding))))
53 |
54 | (defn ^String url-decode
55 | "Returns the url-decoded version of the given string, using either a specified
56 | encoding or UTF-8 by default. If the encoding is invalid, nil is returned."
57 | [encoded & [encoding]]
58 | (percent-decode (str/replace encoded #"[+]" " ") encoding))
59 |
60 | (defn base64-encode
61 | "Encode a Buffer into a base64 encoded string."
62 | [unencoded]
63 | (.toString unencoded "base64"))
64 |
65 | (defn base64-decode
66 | "Decode a base64 encoded string into a Buffer."
67 | [^string encoded]
68 | (js/Buffer. encoded "base64"))
69 |
70 | #_(defprotocol FormEncodeable
71 | (form-encode* [x encoding]))
72 |
73 | #_(extend-protocol FormEncodeable
74 | string
75 | (form-encode* [unencoded encoding]
76 | (url-encode unencoded encoding))
77 | PersistentHashMap
78 | (form-encode* [params encoding]
79 | (letfn [(encode [x] (form-encode* x encoding))
80 | (encode-param [[k v]] (str (encode (name k)) "=" (encode v)))]
81 | (->> params
82 | (mapcat
83 | (fn [[k v]]
84 | (if (or (seq? v) (sequential? v) )
85 | (map #(encode-param [k %]) v)
86 | [(encode-param [k v])])))
87 | (str/join "&"))))
88 | default
89 | (form-encode* [x encoding]
90 | (form-encode* (str x) encoding)))
91 |
92 | (defn form-encode* [params encoding]
93 | (if (map? params)
94 | (letfn [(encode [x] (form-encode* x encoding))
95 | (encode-param [[k v]] (str (encode (name k)) "=" (encode v)))]
96 | (->> params
97 | (mapcat
98 | (fn [[k v]]
99 | (if (or (seq? v) (sequential? v) )
100 | (map #(encode-param [k %]) v)
101 | [(encode-param [k v])])))
102 | (str/join "&")))
103 | (url-encode (str params) encoding)))
104 |
105 | (defn form-encode
106 | "Encode the supplied value into www-form-urlencoded format, often used in
107 | URL query strings and POST request bodies, using the specified encoding.
108 | If the encoding is not specified, it defaults to UTF-8"
109 | [x & [encoding]]
110 | (->
111 | (form-encode* x (or encoding "utf8"))
112 | (str/replace #"\+" "%2B")
113 | (str/replace #"%20" "+")))
114 |
115 | (defn form-decode-str
116 | "Decode the supplied www-form-urlencoded string using the specified encoding,
117 | or UTF-8 by default."
118 | [^String encoded & [encoding]]
119 | (url-decode encoded (or encoding "utf8")))
120 |
121 | (defn form-decode
122 | "Decode the supplied www-form-urlencoded string using the specified encoding,
123 | or UTF-8 by default. If the encoded value is a string, a string is returned.
124 | If the encoded value is a map of parameters, a map is returned."
125 | [^String encoded & [encoding]]
126 | (if (< (.indexOf encoded "=") 0)
127 | (form-decode-str encoded encoding)
128 | (reduce
129 | (fn [m param]
130 | (if-let [[k v] (str/split param #"=" 2)]
131 | (assoc-conj m (form-decode-str k encoding) (form-decode-str v encoding))
132 | m))
133 | {}
134 | (str/split encoded #"&"))))
135 |
--------------------------------------------------------------------------------
/src/dogfort/util/data.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.util.data
2 | "Miscellaneous functions for manipulating data structures.")
3 |
4 | (defn assoc-conj
5 | "Associate a key with a value in a map. If the key already exists in the map,
6 | a vector of values is associated with the key."
7 | [map key val]
8 | (assoc map key
9 | (if-let [cur (get map key)]
10 | (if (vector? cur)
11 | (conj cur val)
12 | [cur val])
13 | val)))
14 |
--------------------------------------------------------------------------------
/src/dogfort/util/macros.clj:
--------------------------------------------------------------------------------
1 | (ns dogfort.util.macros)
2 |
3 | (defmacro are [v body & rest]
4 | (let [
5 | [_ a b] body
6 | f `(fn ~v (if-not ~body (prn ~v ~a ~b)))
7 | a (vec (take-nth 2 rest))
8 | b (vec (take-nth 2 (drop 1 rest)))
9 | ]
10 | `(dorun (map ~f ~a ~b))))
11 |
12 | (defmacro is [assert]
13 | `(if-not ~assert (prn '~assert)))
14 |
15 | (defmacro testing [msg & body]
16 | `(do
17 | (println "testing" ~msg)
18 | ~@body))
19 |
20 | (defmacro symzip [& syms]
21 | `(zipmap ~(mapv name syms) ~(vec syms)))
22 |
--------------------------------------------------------------------------------
/src/dogfort/util/mime_type.cljs:
--------------------------------------------------------------------------------
1 | ;; Copied from Ring
2 |
3 | (ns dogfort.util.mime-type
4 | "Utility functions for finding out the mime-type of a file.")
5 |
6 | (def default-mime-types
7 | {"7z" "application/x-7z-compressed"
8 | "aac" "audio/aac"
9 | "ai" "application/postscript"
10 | "asc" "text/plain"
11 | "atom" "application/atom+xml"
12 | "avi" "video/x-msvideo"
13 | "bin" "application/octet-stream"
14 | "bmp" "image/bmp"
15 | "bz2" "application/x-bzip"
16 | "class" "application/octet-stream"
17 | "cer" "application/pkix-cert"
18 | "crl" "application/pkix-crl"
19 | "crt" "application/x-x509-ca-cert"
20 | "css" "text/css"
21 | "csv" "text/csv"
22 | "deb" "application/x-deb"
23 | "dll" "application/octet-stream"
24 | "dmg" "application/octet-stream"
25 | "dms" "application/octet-stream"
26 | "doc" "application/msword"
27 | "dvi" "application/x-dvi"
28 | "eps" "application/postscript"
29 | "etx" "text/x-setext"
30 | "exe" "application/octet-stream"
31 | "flv" "video/x-flv"
32 | "flac" "audio/flac"
33 | "gif" "image/gif"
34 | "gz" "application/gzip"
35 | "htm" "text/html"
36 | "html" "text/html"
37 | "ico" "image/x-icon"
38 | "iso" "application/x-iso9660-image"
39 | "jar" "application/java-archive"
40 | "jpe" "image/jpeg"
41 | "jpeg" "image/jpeg"
42 | "jpg" "image/jpeg"
43 | "js" "text/javascript"
44 | "json" "application/json"
45 | "lha" "application/octet-stream"
46 | "lzh" "application/octet-stream"
47 | "mov" "video/quicktime"
48 | "m4v" "video/mp4"
49 | "mp3" "audio/mpeg"
50 | "mp4" "video/mp4"
51 | "mpe" "video/mpeg"
52 | "mpeg" "video/mpeg"
53 | "mpg" "video/mpeg"
54 | "oga" "audio/ogg"
55 | "ogg" "audio/ogg"
56 | "ogv" "video/ogg"
57 | "pbm" "image/x-portable-bitmap"
58 | "pdf" "application/pdf"
59 | "pgm" "image/x-portable-graymap"
60 | "png" "image/png"
61 | "pnm" "image/x-portable-anymap"
62 | "ppm" "image/x-portable-pixmap"
63 | "ppt" "application/vnd.ms-powerpoint"
64 | "ps" "application/postscript"
65 | "qt" "video/quicktime"
66 | "rar" "application/x-rar-compressed"
67 | "ras" "image/x-cmu-raster"
68 | "rb" "text/plain"
69 | "rd" "text/plain"
70 | "rss" "application/rss+xml"
71 | "rtf" "application/rtf"
72 | "sgm" "text/sgml"
73 | "sgml" "text/sgml"
74 | "svg" "image/svg+xml"
75 | "swf" "application/x-shockwave-flash"
76 | "tar" "application/x-tar"
77 | "tif" "image/tiff"
78 | "tiff" "image/tiff"
79 | "txt" "text/plain"
80 | "webm" "video/webm"
81 | "wmv" "video/x-ms-wmv"
82 | "xbm" "image/x-xbitmap"
83 | "xls" "application/vnd.ms-excel"
84 | "xml" "text/xml"
85 | "xpm" "image/x-xpixmap"
86 | "xwd" "image/x-xwindowdump"
87 | "zip" "application/zip"})
88 |
89 | (defn- filename-ext
90 | "Returns the file extension of a filename or filepath."
91 | [filename]
92 | (second (re-find #"\.([^./\\]+)$" filename)))
93 |
94 | (defn ext-mime-type
95 | "Get the mimetype from the filename extension. Takes an optional map of
96 | extensions to mimetypes that overrides values in the default-mime-types map."
97 | [filename & [mime-types]]
98 | (let [mime-types (merge default-mime-types mime-types)]
99 | (mime-types (filename-ext filename))))
100 |
--------------------------------------------------------------------------------
/src/dogfort/util/parsing.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.util.parsing
2 | "Regular expressions for parsing HTTP.
3 |
4 | For internal use.")
5 |
6 | (def ^{:doc "HTTP token: 1*. See RFC2068"
7 | :added "1.3"}
8 | re-token
9 | #"[!#$%&'*\-+.0-9A-Z\^_`a-z\|~]+")
10 |
11 | (def ^{:doc "HTTP quoted-string: <\"> * <\">. See RFC2068."
12 | :added "1.3"}
13 | re-quoted
14 | #"\"(\\\"|[^\"])*\"")
15 |
16 | (def ^{:doc "HTTP value: token | quoted-string. See RFC2109"
17 | :added "1.3"}
18 | re-value
19 | (str (.-source re-token) "|" (.-source re-quoted)))
20 |
--------------------------------------------------------------------------------
/src/dogfort/util/request.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.util.request
2 | "Functions for augmenting and pulling information from request maps."
3 | (:require [dogfort.util.parsing :refer [re-value]]))
4 |
5 | (defn request-url
6 | "Return the full URL of the request."
7 | {:added "1.2"}
8 | [request]
9 | (str (-> request :scheme name)
10 | "://"
11 | (get-in request [:headers "host"])
12 | (:uri request)
13 | (if-let [query (:query-string request)]
14 | (str "?" query))))
15 |
16 | (defn content-type
17 | "Return the content-type of the request, or nil if no content-type is set."
18 | {:added "1.3"}
19 | [request]
20 | (if-let [type (get-in request [:headers "content-type"])]
21 | (second (re-find #"^(.*?)(?:;|$)" type))))
22 |
23 | (defn content-length
24 | "Return the content-length of the request, or nil no content-length is set."
25 | {:added "1.3"}
26 | [request]
27 | (if-let [^String length (get-in request [:headers "content-length"])]
28 | (Long. length)))
29 |
30 | #_(def ^:private charset-pattern
31 | (re-pattern (str ";(?:.*\\s)?(?i:charset)=(" re-value ")\\s*(?:;|$)")))
32 |
33 | (defn character-encoding
34 | "Return the character encoding for the request, or nil if it is not set."
35 | {:added "1.3"}
36 | [request]
37 | (if-let [type (get-in request [:headers "content-type"])]
38 | (second (.split type "charset="))
39 | #_(second (re-find charset-pattern type))))
40 |
41 | (defn urlencoded-form?
42 | "True if a request contains a urlencoded form in the body."
43 | {:added "1.3"}
44 | [request]
45 | (if-let [^String type (content-type request)]
46 | (.startsWith type "application/x-www-form-urlencoded")))
47 |
48 | (defmulti body-string
49 | "Return the request body as a string."
50 | {:arglists '([request]), :added "1.2"}
51 | (comp class :body))
52 |
53 | #_(defmethod body-string nil [_] nil)
54 |
55 | #_(defmethod body-string String [request]
56 | (:body request))
57 |
58 | #_(defmethod body-string clojure.lang.ISeq [request]
59 | (apply str (:body request)))
60 |
61 | #_(defmethod body-string java.io.File [request]
62 | (slurp (:body request)))
63 |
64 | #_(defmethod body-string java.io.InputStream [request]
65 | (slurp (:body request)))
66 |
67 | (defn path-info
68 | "Returns the relative path of the request."
69 | {:added "1.2"}
70 | [request]
71 | (or (:path-info request)
72 | (:uri request)))
73 |
74 | (defn in-context?
75 | "Returns true if the URI of the request is a subpath of the supplied context."
76 | {:added "1.2"}
77 | [request context]
78 | (.startsWith ^String (:uri request) context))
79 |
80 | (defn set-context
81 | "Associate a context and path-info with the request. The request URI must be
82 | a subpath of the supplied context."
83 | {:added "1.2"}
84 | [request ^String context]
85 | {:pre [(in-context? request context)]}
86 | (assoc request
87 | :context context
88 | :path-info (subs (:uri request) (.length context))))
89 |
--------------------------------------------------------------------------------
/src/dogfort/util/response.cljs:
--------------------------------------------------------------------------------
1 | (ns dogfort.util.response)
2 |
3 | (def status-codes
4 | {100 "Continue"
5 | 101 "Switching Protocols"
6 | 200 "OK"
7 | 201 "Created"
8 | 202 "Accepted"
9 | 203 "Non-Authoritative Information"
10 | 204 "No Content"
11 | 205 "Reset Content"
12 | 206 "Partial Content"
13 | 300 "Multiple Choices"
14 | 301 "Moved Permanently"
15 | 302 "Found"
16 | 303 "See Other"
17 | 304 "Not Modified"
18 | 305 "Use Proxy"
19 | 307 "Temporary Redirect"
20 | 400 "Bad Request"
21 | 401 "Unauthorized"
22 | 402 "Payment Required"
23 | 403 "Forbidden"
24 | 404 "Not Found"
25 | 405 "Method Not Allowed"
26 | 406 "Not Acceptable"
27 | 407 "Proxy Authentication Required"
28 | 408 "Request Timeout"
29 | 409 "Conflict"
30 | 410 "Gone"
31 | 411 "Length Required"
32 | 412 "Precondition Failed"
33 | 413 "Request Entity Too Large"
34 | 414 "Request-URI Too Long"
35 | 415 "Unsupported Media Type"
36 | 416 "Requested Range Not Satisfiable"
37 | 417 "Expectation Failed"
38 | 500 "Internal Server Error"
39 | 501 "Not Implemented"
40 | 502 "Bad Gateway"
41 | 503 "Service Unavailable"
42 | 504 "Gateway Timeout"
43 | 505 "HTTP Version Not Supported"})
44 |
45 | (def status-cats
46 | {100 "http://25.media.tumblr.com/tumblr_lwjgzc5VCs1qzhbl2o1_1280.jpg"
47 | 101 "http://24.media.tumblr.com/tumblr_lwjgzc5VCs1qzhbl2o2_1280.jpg"
48 | 200 "http://24.media.tumblr.com/tumblr_lwjgxg7jrJ1qzhbl2o1_1280.jpg"
49 | 201 "http://25.media.tumblr.com/tumblr_lwjgxg7jrJ1qzhbl2o2_1280.jpg"
50 | 202 "http://25.media.tumblr.com/tumblr_lwjgxg7jrJ1qzhbl2o3_1280.jpg"
51 | 204 "http://24.media.tumblr.com/tumblr_lwjgxg7jrJ1qzhbl2o4_1280.jpg"
52 | 206 "http://25.media.tumblr.com/tumblr_lwjgxg7jrJ1qzhbl2o5_1280.jpg"
53 | 207 "http://25.media.tumblr.com/tumblr_lwjgxg7jrJ1qzhbl2o6_1280.jpg"
54 | 300 "http://25.media.tumblr.com/tumblr_lwjgtfRJGj1qzhbl2o2_1280.jpg"
55 | 301 "http://25.media.tumblr.com/tumblr_lwjgtfRJGj1qzhbl2o3_1280.jpg"
56 | 302 "http://24.media.tumblr.com/tumblr_lwjgtfRJGj1qzhbl2o1_1280.jpg"
57 | 303 "http://25.media.tumblr.com/tumblr_lwjgtfRJGj1qzhbl2o4_1280.jpg"
58 | 304 "http://25.media.tumblr.com/tumblr_lwjgtfRJGj1qzhbl2o5_1280.jpg"
59 | 305 "http://24.media.tumblr.com/tumblr_lwjgtfRJGj1qzhbl2o6_1280.jpg"
60 | 307 "http://25.media.tumblr.com/tumblr_lwjgtfRJGj1qzhbl2o7_1280.jpg"
61 | 400 "http://24.media.tumblr.com/tumblr_lwjgmsfFs31qzhbl2o1_1280.jpg"
62 | 401 "http://24.media.tumblr.com/tumblr_lwjgmsfFs31qzhbl2o2_1280.jpg"
63 | 402 "http://24.media.tumblr.com/tumblr_lwjgmsfFs31qzhbl2o3_1280.jpg"
64 | 403 "http://25.media.tumblr.com/tumblr_lwjgmsfFs31qzhbl2o4_1280.jpg"
65 | 404 "http://25.media.tumblr.com/tumblr_lwjgmsfFs31qzhbl2o5_1280.jpg"
66 | 405 "http://25.media.tumblr.com/tumblr_lwjgmsfFs31qzhbl2o6_1280.jpg"
67 | 406 "http://25.media.tumblr.com/tumblr_lwjgmsfFs31qzhbl2o7_1280.jpg"
68 | 408 "http://24.media.tumblr.com/tumblr_lwjgmsfFs31qzhbl2o8_1280.jpg"
69 | 409 "http://24.media.tumblr.com/tumblr_lwjgmsfFs31qzhbl2o9_1280.jpg"
70 | 410 "http://25.media.tumblr.com/tumblr_lwjgd4GlG21qzhbl2o7_1280.jpg"
71 | 411 "http://24.media.tumblr.com/tumblr_lwjgd4GlG21qzhbl2o6_1280.jpg"
72 | 413 "http://25.media.tumblr.com/tumblr_lwjgd4GlG21qzhbl2o5_1280.jpg"
73 | 414 "http://25.media.tumblr.com/tumblr_lwjgd4GlG21qzhbl2o4_1280.jpg"
74 | 416 "http://24.media.tumblr.com/tumblr_lwjgd4GlG21qzhbl2o3_1280.jpg"
75 | 417 "http://25.media.tumblr.com/tumblr_lwjgd4GlG21qzhbl2o2_1280.jpg"
76 | 418 "http://25.media.tumblr.com/tumblr_lwjgd4GlG21qzhbl2o1_1280.jpg"
77 | 422 "http://24.media.tumblr.com/tumblr_lwjg4pjFFI1qzhbl2o1_1280.jpg"
78 | 423 "http://24.media.tumblr.com/tumblr_lwjg4pjFFI1qzhbl2o2_1280.jpg"
79 | 424 "http://24.media.tumblr.com/tumblr_lwjg4pjFFI1qzhbl2o3_1280.jpg"
80 | 425 "http://24.media.tumblr.com/tumblr_lwjg4pjFFI1qzhbl2o4_1280.jpg"
81 | 426 "http://25.media.tumblr.com/tumblr_lwjg4pjFFI1qzhbl2o5_1280.jpg"
82 | 429 "http://25.media.tumblr.com/tumblr_lwjg4pjFFI1qzhbl2o6_1280.jpg"
83 | 431 "http://24.media.tumblr.com/tumblr_lwjg4pjFFI1qzhbl2o7_1280.jpg"
84 | 444 "http://24.media.tumblr.com/tumblr_lwjg4pjFFI1qzhbl2o8_1280.jpg"
85 | 450 "http://25.media.tumblr.com/tumblr_lwjg4pjFFI1qzhbl2o9_1280.jpg"
86 | 500 "http://25.media.tumblr.com/tumblr_lwjfwtx7P81qzhbl2o1_1280.jpg"
87 | 502 "http://24.media.tumblr.com/tumblr_lwjfwtx7P81qzhbl2o2_1280.jpg"
88 | 503 "http://24.media.tumblr.com/tumblr_lwjfwtx7P81qzhbl2o11_1280.jpg"
89 | 506 "http://25.media.tumblr.com/tumblr_lwjfwtx7P81qzhbl2o12_1280.jpg"
90 | 507 "http://25.media.tumblr.com/tumblr_lwjfwtx7P81qzhbl2o3_1280.jpg"
91 | 508 "http://24.media.tumblr.com/tumblr_lwjfwtx7P81qzhbl2o4_1280.jpg"
92 | 509 "http://24.media.tumblr.com/tumblr_lwjfwtx7P81qzhbl2o5_1280.jpg"
93 | 599 "http://25.media.tumblr.com/tumblr_lwjfwtx7P81qzhbl2o6_1280.jpg"})
94 |
95 | (defn response [status body & [content-type]]
96 | {:status status
97 | :headers (if content-type {:content-type content-type} {})
98 | :body body})
99 |
100 | (defn default-response [status]
101 | (response status
102 | (flatten
103 | [""
104 | ""
108 | (let [label (str status " " (status-codes status))]
109 | ["" label ""
110 | (if-let [cat (status-cats status)]
111 | ["
"]
112 | ["" label "
"])
113 | ""])])
114 | "text/html"))
115 |
116 | (defn redirect [url]
117 | {:status 302
118 | :headers {:location url}
119 | :body ""})
120 |
121 | (defn redirect-after-post [url]
122 | {:status 303
123 | :headers {:location url}
124 | :body ""})
125 |
--------------------------------------------------------------------------------
/src/dogfort/util/time.cljs:
--------------------------------------------------------------------------------
1 | ;; A straight port of https://github.com/mikeal/filed/blob/master/rfc822.js
2 |
3 | (ns dogfort.util.time
4 | (:require-macros [cljs.node-macros :as n]))
5 |
6 | (def months ["Jan" "Feb" "Mar" "Apr" "May" "Jun"
7 | "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"])
8 | (def days ["Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"])
9 |
10 | (defn- pad-with-zero [val]
11 | (if (< (js/parseInt val 10) 10)
12 | (str "0" val) val))
13 |
14 | (defn- get-tzo-string [tzo]
15 | (let [hours (.floor js/Math (/ tzo 60))
16 | mod-min (.abs js/Math (rem tzo 60))
17 | abs-hours (.abs js/Math hours)
18 | sign (if (> hours 0) "-" "+")]
19 | (str sign (pad-with-zero abs-hours)
20 | (pad-with-zero mod-min))))
21 |
22 | (defn rfc822-date [^js/Date date]
23 | (str
24 | (days (.getDay date)) ", "
25 | (pad-with-zero (.getDate date)) " "
26 | (months (.getMonth date)) " "
27 | (.getFullYear date) " "
28 | (pad-with-zero (.getHours date)) ":"
29 | (pad-with-zero (.getMinutes date)) ":"
30 | (pad-with-zero (.getSeconds date)) " "
31 | (get-tzo-string (.getTimezoneOffset date))))
32 |
--------------------------------------------------------------------------------
/static/exclusive_paper.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/whamtet/dogfort/75c2908355cc18bf350a5b761d2906e013ee9f94/static/exclusive_paper.png
--------------------------------------------------------------------------------
/static/gloriahallelujah.ttf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/whamtet/dogfort/75c2908355cc18bf350a5b761d2906e013ee9f94/static/gloriahallelujah.ttf
--------------------------------------------------------------------------------
/static/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
8 |
9 |
10 |
--------------------------------------------------------------------------------
/static/permanentmarker.ttf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/whamtet/dogfort/75c2908355cc18bf350a5b761d2906e013ee9f94/static/permanentmarker.ttf
--------------------------------------------------------------------------------
/static/screen.css:
--------------------------------------------------------------------------------
1 | @font-face {
2 | font-family: 'Permanent Marker';
3 | font-style: normal;
4 | font-weight: normal;
5 | src: local('Permanent Marker'), local('PermanentMarker'), url('permanentmarker.ttf') format('truetype');
6 | }
7 |
8 | @font-face {
9 | font-family: 'Gloria Hallelujah';
10 | font-style: normal;
11 | font-weight: normal;
12 | src: local('Gloria Hallelujah'), local('GloriaHallelujah'), url('gloriahallelujah.ttf') format('truetype');
13 | }
14 |
15 | html {
16 | margin: 0;
17 | }
18 |
19 | body {
20 | margin: 0;
21 | background: url(exclusive_paper.png);
22 | font-family: 'Gloria Hallelujah', cursive, sans-serif;
23 | font-size: 1.4em;
24 | }
25 |
26 | h1 {
27 | margin: 1em 0;
28 | padding: 0.3em 0;
29 | text-align: center;
30 | background: rgba(128, 128, 128, 0.2);
31 | color: black;
32 | font-family: 'Permanent Marker', cursive, sans-serif;
33 | font-size: 1.8em;
34 | text-shadow: rgba(0, 0, 0, 0.2) 0 2px 5px;
35 | box-shadow: 0 0 16px rgba(128, 128, 128, 0.4);
36 | }
37 |
38 | ul {
39 | margin: 0;
40 | padding: 0 2em;
41 | }
42 |
43 | li {
44 | list-style: none;
45 | margin: 0.2em;
46 | }
47 |
48 | li form {
49 | display: inline;
50 | margin: 0 0.2em 0 0;
51 | }
52 |
53 | li span {
54 | margin: 0;
55 | padding: 0 0.2em;
56 | }
57 |
58 | li form input {
59 | border: none;
60 | background: none;
61 | }
62 |
63 | li input.check, span.check {
64 | color: green;
65 | }
66 |
67 | span.delete, span.check, li form input {
68 | cursor: pointer;
69 | font-size: 1.1em;
70 | }
71 |
72 | li.done span.todo {
73 | text-decoration: line-through;
74 | }
75 |
76 | body > form {
77 | margin: 0 2em 0 3.8em;
78 | }
79 |
80 | body > form:before {
81 | font-size: 1.6em;
82 | content: "✍ ";
83 | }
84 |
85 | body > form input {
86 | font-family: 'Gloria Hallelujah', cursive, sans-serif;
87 | font-size: 1em;
88 | width: 75%;
89 | border-top: 1px solid rgba(128, 128, 128, 0.4);
90 | border-left: 1px solid rgba(128, 128, 128, 0.4);
91 | border-right: 1px solid rgba(255, 255, 255, 0.4);
92 | border-bottom: 1px solid rgba(255, 255, 255, 0.4);
93 | }
94 |
95 | body > form input, li {
96 | background: rgba(255, 255, 255, 0.4);
97 | box-shadow: 0 0 16px rgba(128, 128, 128, 0.2);
98 | }
99 |
100 | li:hover {
101 | background: rgba(255, 255, 255, 0.7);
102 | }
103 |
104 |
--------------------------------------------------------------------------------