Merge pull request #245 from asciinema/next

Bounded (thread-pool based) & asynchronous (Aleph) PNG generation

.gitignore

@@ -23,10 +23,16 @@ public/uploads/*
 .rbx
 .env
 
-/.dir-locals.el
+/target
-/.lein-env
+/classes
-/.lein-repl-history
+/checkouts
+pom.xml
+pom.xml.asc
+*.jar
+*.class
+/.lein-*
 /.nrepl-port
-/dev/
+/.dir-locals.el
 /profiles.clj
-/target/
+/dev/resources/local.edn
+/dev/src/local.clj

dev/resources/dev.edn

@@ -0,0 +1,12 @@
+{:components
+ {:file-store #var asciinema.component.local-file-store/local-file-store
+  :exp-set #var asciinema.component.mem-expiring-set/mem-expiring-set}
+ :config
+ {:http
+  {:port 4000}
+  :db
+  {:uri "jdbc:postgresql://localhost:15432/asciinema_development?user=vagrant"}
+  :file-store
+  {:path "uploads/"}
+  :png-gen
+  {:bin-path "a2png/a2png.sh"}}}

dev/src/dev.clj

@@ -0,0 +1,25 @@
+(ns dev
+  (:refer-clojure :exclude [test])
+  (:require [clojure.repl :refer :all]
+            [clojure.pprint :refer [pprint]]
+            [clojure.tools.namespace.repl :refer [refresh]]
+            [clojure.java.io :as io]
+            [com.stuartsierra.component :as component]
+            [duct.generate :as gen]
+            [duct.util.repl :refer [setup test cljs-repl migrate rollback]]
+            [duct.util.system :refer [load-system]]
+            [reloaded.repl :refer [system init start stop go reset]]
+            [asciinema.boundary.file-store :as file-store]
+            [asciinema.boundary.asciicast-database :as asciicast-database]
+            [asciinema.component.local-file-store :refer [->LocalFileStore]]
+            [asciinema.component.s3-file-store :refer [->S3FileStore]]))
+
+(defn new-system []
+  (load-system (keep io/resource ["asciinema/system.edn" "dev.edn" "local.edn"])))
+
+(when (io/resource "local.clj")
+  (load "local"))
+
+(gen/set-ns-prefix 'asciinema)
+
+(reloaded.repl/set-init! new-system)

dev/src/user.clj

@@ -0,0 +1,8 @@
+(ns user)
+
+(defn dev
+  "Load and switch to the 'dev' namespace."
+  []
+  (require 'dev)
+  (in-ns 'dev)
+  :loaded)

project.clj

@@ -0,0 +1,47 @@
+(defproject asciinema "0.1.0-SNAPSHOT"
+  :description "FIXME: write description"
+  :url "http://example.com/FIXME"
+  :min-lein-version "2.0.0"
+  :dependencies [[org.clojure/clojure "1.8.0"]
+                 [com.stuartsierra/component "0.3.1"]
+                 [clj-time "0.13.0"]
+                 [duct "0.8.2"]
+                 [yada "1.2.0"]
+                 [aleph "0.4.1"]
+                 [bidi "2.0.16"]
+                 [prismatic/schema "1.1.3"]
+                 [environ "1.1.0"]
+                 [ring "1.5.0"]
+                 [clj-bugsnag "0.2.9"]
+                 [clj-aws-s3 "0.3.10" :exclusions [joda-time]]
+                 [cheshire "5.7.0"]
+                 [pandect "0.6.1"]
+                 [com.taoensso/timbre "4.8.0"]
+                 [com.taoensso/carmine "2.15.1"]
+                 [org.slf4j/slf4j-nop "1.7.21"]
+                 [duct/hikaricp-component "0.1.0"]
+                 [org.postgresql/postgresql "9.4.1211"]
+                 [duct/ragtime-component "0.1.4"]
+                 [me.raynes/conch "0.8.0"]]
+  :plugins [[lein-environ "1.0.3"]]
+  :main ^:skip-aot asciinema.main
+  :target-path "target/%s/"
+  :aliases {"setup"  ["run" "-m" "duct.util.repl/setup"]}
+  :profiles
+  {:dev  [:project/dev  :profiles/dev]
+   :test [:project/test :profiles/test]
+   :uberjar {:aot :all}
+   :profiles/dev  {}
+   :profiles/test {}
+   :project/dev   {:dependencies [[duct/generate "0.8.2"]
+                                  [reloaded.repl "0.2.3"]
+                                  [org.clojure/tools.namespace "0.2.11"]
+                                  [org.clojure/tools.nrepl "0.2.12"]
+                                  [eftest "0.1.1"]
+                                  [com.gearswithingears/shrubbery "0.4.1"]
+                                  [kerodon "0.8.0"]]
+                   :source-paths   ["dev/src"]
+                   :resource-paths ["dev/resources"]
+                   :repl-options {:init-ns user}
+                   :env {:port "3000"}}
+   :project/test  {}})

resources/asciinema/endpoint/example/example.html

@@ -0,0 +1,11 @@
+<!DOCTYPE html>
+<html lang="en" class="example">
+  <head>
+    <title>Example Endpoint</title>
+    <link rel="stylesheet" href="/assets/normalize.css/normalize.css">
+    <link rel="stylesheet" href="/css/site.css">
+  </head>
+  <body>
+    <h1>This is an example endpoint</h1>
+  </body>
+</html>

resources/asciinema/errors/404.html

@@ -0,0 +1,12 @@
+<!DOCTYPE html>
+<html lang="en" class="error-page">
+  <head>
+    <title>Server Error</title>
+    <link rel="stylesheet" href="/assets/normalize.css/normalize.css">
+    <link rel="stylesheet" href="/css/site.css">
+  </head>
+  <body>
+    <h1>Resource Not Found</h1>
+    <h2>The requested page does not exist.</h2>
+  </body>
+</html>

resources/asciinema/errors/500.html

@@ -0,0 +1,12 @@
+<!DOCTYPE html>
+<html lang="en" class="error-page">
+  <head>
+    <title>Server Error</title>
+    <link rel="stylesheet" href="/assets/normalize.css/normalize.css">
+    <link rel="stylesheet" href="/css/site.css">
+  </head>
+  <body>
+    <h1>Internal Server Error</h1>
+    <h2>Sorry, something went wrong.</h2>
+  </body>
+</html>

resources/asciinema/public/css/site.css

@@ -0,0 +1,103 @@
+.error-page body {
+    background: #eee;
+}
+
+.error-page h1 {
+    margin: 15% 0 0 0;
+    text-align: center;
+    font-size: 42px;
+    color: #900;
+}
+
+.error-page h2 {
+    text-align: center;
+    font-size: 32px;
+    font-weight: normal;
+    color: #333;
+}
+
+.welcome body {
+    background: #eee;
+    color: #333;
+    font-family: Helvetica, Arial, sans-serif;
+    max-width: 700px;
+    padding: 15px;
+    margin: auto;
+}
+
+.welcome p {
+    line-height: 1.4em;
+}
+
+.welcome code {
+    font-family: Menlo, DejaVu Sans Mono, Lucida Console, monospace;
+    font-size: 12px;
+    background: #ddd;
+    color: #111;
+}
+
+.welcome h1 {
+    text-align: center;
+    font-size: 36px;
+    font-weight: lighter;
+    margin: 40px 0 30px 0;
+}
+
+.welcome h1 .outer {
+    border: solid 4px #555;
+    padding: 3px;
+    display: inline-block;
+}
+
+.welcome h1 .inner {
+    border: solid 2px #555;
+    padding: 0 3px;
+    display: inline-block;
+    font-weight: normal;
+    color: #444;
+}
+
+.welcome .project-name {
+    font-weight: bold;
+}
+
+.welcome .profiles {
+    margin-top: 30px;
+}
+
+.welcome .profiles code {
+    font-size: 11px;
+}
+
+.welcome .profiles h2 {
+    font-weight: normal;
+    font-size: 23px;
+    margin-bottom: 0;
+    color: #333;
+}
+
+.welcome .profiles dl {
+    margin: 0 10px;
+}
+
+.welcome .profiles dt {
+    font-weight: normal;
+    font-size: 19px;
+    margin: 18px 0 5px 0;
+}
+
+.welcome .profiles dd {
+    font-size: 14px;
+    margin: 8px 0 8px 0;
+}
+
+.example body {
+    background: #eee;
+}
+
+.example h1 {
+    margin: 15% 0 0 0;
+    text-align: center;
+    font-size: 36px;
+    font-weight: normal;
+}

resources/asciinema/public/index.html

@@ -0,0 +1,36 @@
+<!DOCTYPE html>
+<html lang="en" class="welcome">
+  <head>
+    <title>Welcome to Duct</title>
+    <link rel="stylesheet" href="/assets/normalize.css/normalize.css">
+    <link rel="stylesheet" href="/css/site.css">
+  </head>
+  <body>
+    <h1>Welcome to <span class="outer"><span class="inner">Duct</span></span></h1>
+    <div class="intro">
+      <p>Congratulations! Your project <span class="project-name">asciinema</span> is
+        ready and running.</p>
+      <p>This is a static welcome page located at <code>resources/asciinema/public/index.html</code>
+        in the project directory. Remove or replace it when you start developing.
+        If you remove the index page entirely, be sure to change the
+        <code>:route-aliases</code> map in <code>resources/asciinema/system.edn</code>.
+    </div>
+    <div class="profiles">
+      <h2>Template profiles used:</h2>
+      <dl>
+        <dt>+example</dt>
+        <dd>Adds an example endpoint at <a href="/example">/example</a>.</dd>
+        <dt>+postgres</dt>
+        <dd>Adds a PostgreSQL dependency and database component. The database used for
+          development defaults to <code>postgres</code> on <code>localhost</code>.</dd>
+        <dt>+ragtime</dt>
+        <dd>Adds Ragtime migrations. Use <code>(migrate)</code> and <code>(rollback)</code>
+          in the REPL. Migrations are stored in <code>resources/asciinema/migrations</code>.
+        </dd>
+        <dt>+site</dt>
+        <dd>Adds middleware and configuration suited for a user-facing website.</dd>
+      </dl>
+    </div>
+    
+  </body>
+</html>

resources/asciinema/public/robots.txt

@@ -0,0 +1,2 @@
+User-agent: *
+Disallow:

resources/asciinema/system.edn

@@ -0,0 +1,34 @@
+{:components
+ {:http #var asciinema.component.yada-listener/yada-listener
+  :db   #var asciinema.component.db/hikaricp
+  :ragtime #var duct.component.ragtime/ragtime
+  :file-store #var asciinema.component.s3-file-store/s3-file-store
+  :exp-set #var asciinema.component.redis-client/redis-client
+  :png-gen #var asciinema.component.a2png/a2png
+  :executor #var asciinema.component.fixed-thread-executor/fixed-thread-executor}
+ :endpoints
+ {:asciicasts #var asciinema.endpoint.asciicasts/asciicasts-endpoint}
+ :dependencies
+ {:http {:app :asciicasts}
+  :ragtime [:db]
+  :asciicasts [:db :file-store :exp-set :executor :png-gen]}
+ :config
+ {:http
+  {:port http-port}
+  :db
+  {:uri db-uri}
+  :ragtime
+  {:resource-path "asciinema/migrations"}
+  :file-store
+  {:cred {:access-key s3-access-key
+          :secret-key s3-secret-key}
+   :bucket s3-bucket
+   :path-prefix "uploads/"}
+  :exp-set
+  {:host redis-host
+   :port redis-port}
+  :png-gen
+  {:bin-path a2png-bin-path}
+  :executor
+  {:threads 2
+   :queue-length 16}}}

src/asciinema/boundary/asciicast_database.clj

@@ -0,0 +1,5 @@
+(ns asciinema.boundary.asciicast-database)
+
+(defprotocol AsciicastDatabase
+  (get-asciicast-by-id [this id])
+  (get-asciicast-by-token [this token]))

src/asciinema/boundary/executor.clj

@@ -0,0 +1,4 @@
+(ns asciinema.boundary.executor)
+
+(defprotocol Executor
+  (execute [this f]))

src/asciinema/boundary/expiring_set.clj

@@ -0,0 +1,6 @@
+(ns asciinema.boundary.expiring-set
+  (:refer-clojure :exclude [conj! contains?]))
+
+(defprotocol ExpiringSet
+  (conj! [this value expires-at])
+  (contains? [this value]))

src/asciinema/boundary/file_store.clj

@@ -0,0 +1,8 @@
+(ns asciinema.boundary.file-store)
+
+(defprotocol FileStore
+  (put-file [this file path] [this file path size])
+  (input-stream [this path])
+  (move-file [this old-path new-path])
+  (delete-file [this path])
+  (serve-file [this ctx path opts]))

src/asciinema/boundary/png_generator.clj

@@ -0,0 +1,4 @@
+(ns asciinema.boundary.png-generator)
+
+(defprotocol PngGenerator
+  (generate [this json-is png-params]))

src/asciinema/boundary/user_database.clj

@@ -0,0 +1,4 @@
+(ns asciinema.boundary.user-database)
+
+(defprotocol UserDatabase
+  (get-user-by-id [this id]))

src/asciinema/component/a2png.clj

@@ -0,0 +1,26 @@
+(ns asciinema.component.a2png
+  (:require [asciinema.boundary.png-generator :as png-generator]
+            [asciinema.util.io :refer [cleanup-input-stream create-tmp-dir]]
+            [clojure.java.io :as io]
+            [clojure.java
+             [io :as io]
+             [shell :as shell]]
+            [me.raynes.conch :as conch]))
+
+(defn- exec-a2png [bin-path in-url out-path {:keys [snapshot-at theme scale]}]
+  (conch/let-programs [a2png bin-path]
+    (a2png in-url out-path (str snapshot-at) theme (str scale) {:timeout 30000})))
+
+(defrecord A2png [bin-path]
+  png-generator/PngGenerator
+  (generate [this json-is png-params]
+    (let [dir (create-tmp-dir "a2png-")
+          cleanup #(shell/sh "rm" "-rf" (.getPath dir))
+          json-local-path (str dir "/asciicast.json")
+          png-local-path (str dir "/asciicast.png")]
+      (io/copy json-is (io/file json-local-path))
+      (exec-a2png bin-path json-local-path png-local-path png-params)
+      (cleanup-input-stream (io/input-stream png-local-path) cleanup))))
+
+(defn a2png [{:keys [bin-path]}]
+  (->A2png bin-path))

src/asciinema/component/db.clj

@@ -0,0 +1,50 @@
+(ns asciinema.component.db
+  (:require [asciinema.boundary.asciicast-database :refer :all]
+            [asciinema.boundary.user-database :refer :all]
+            [clojure.java.jdbc :as jdbc]
+            [clj-time.coerce :as timec]
+            [duct.component.hikaricp :as hikaricp]))
+
+(extend-protocol jdbc/ISQLValue
+  org.joda.time.DateTime
+  (sql-value [val]
+    (timec/to-sql-time val)))
+
+(extend-protocol jdbc/IResultSetReadColumn
+  java.sql.Timestamp
+  (result-set-read-column [x _ _]
+    (timec/from-sql-time x)))
+
+;; AsciicastDatabase
+
+(def q-get-asciicast-by-id "SELECT * FROM asciicasts WHERE id=?")
+(def q-get-asciicast-by-secret-token "SELECT * FROM asciicasts WHERE secret_token=?")
+(def q-get-public-asciicast-by-id "SELECT * FROM asciicasts WHERE id=? AND private=FALSE")
+
+(extend-protocol AsciicastDatabase
+  duct.component.hikaricp.HikariCP
+
+  (get-asciicast-by-id [{db :spec} id]
+    (first (jdbc/query db [q-get-asciicast-by-id id])))
+
+  (get-asciicast-by-token [{db :spec} token]
+    (when-let [query (cond
+                       (re-matches #"\d+" token)
+                       [q-get-public-asciicast-by-id (Long/parseLong token)]
+                       (= (count token) 25)
+                       [q-get-asciicast-by-secret-token token])]
+      (first (jdbc/query db query)))))
+
+;; UserDatabase
+
+(def q-get-user-by-id "SELECT * FROM users WHERE id=?")
+
+(extend-protocol UserDatabase
+  duct.component.hikaricp.HikariCP
+
+  (get-user-by-id [{db :spec} id]
+    (first (jdbc/query db [q-get-user-by-id id]))))
+
+;; constructor
+
+(def hikaricp hikaricp/hikaricp)

src/asciinema/component/fixed_thread_executor.clj

@@ -0,0 +1,39 @@
+(ns asciinema.component.fixed-thread-executor
+  (:require [aleph.flow :as flow]
+            [asciinema.boundary.executor :as executor]
+            [com.stuartsierra.component :as component]
+            [manifold.deferred :as d])
+  (:import [java.util.concurrent
+            ExecutorService
+            RejectedExecutionException
+            TimeUnit]))
+
+(defrecord FixedThreadExecutor [threads queue-length]
+  executor/Executor
+  (execute [{:keys [^ExecutorService executor]} f]
+    (try
+      (let [result (d/deferred)
+            f (fn []
+                (try
+                  (d/success! result (f))
+                  (catch Exception e
+                    (d/error! result e))))]
+        (.execute executor f)
+        result)
+      (catch RejectedExecutionException _
+        nil)))
+
+  component/Lifecycle
+  (start [{:keys [threads queue-length] :as component}]
+    (let [executor (flow/fixed-thread-executor threads {:onto? false
+                                                        :initial-thread-count threads
+                                                        :queue-length queue-length})]
+      (assoc component :executor executor)))
+  (stop [{:keys [^ExecutorService executor] :as component}]
+    (.shutdown executor)
+    (when-not (.awaitTermination executor 1000 TimeUnit/MILLISECONDS)
+      (.shutdownNow executor))
+    (assoc component :executor nil)))
+
+(defn fixed-thread-executor [{:keys [threads queue-length]}]
+  (->FixedThreadExecutor threads queue-length))

src/asciinema/component/local_file_store.clj

@@ -0,0 +1,38 @@
+(ns asciinema.component.local-file-store
+  (:require [asciinema.boundary.file-store :as file-store]
+            [clojure.java.io :as io]
+            [ring.util.http-response :as response]))
+
+(defrecord LocalFileStore [base-path]
+  file-store/FileStore
+
+  (put-file [this file path]
+    (let [path (str base-path path)]
+      (io/make-parents path)
+      (io/copy file (io/file path))))
+
+  (put-file [this file path size]
+    (file-store/put-file this file path))
+
+  (input-stream [this path]
+    (let [path (str base-path path)]
+      (io/input-stream path)))
+
+  (move-file [this old-path new-path]
+    (let [old-path (str base-path old-path)
+          new-path (str base-path new-path)]
+      (.renameTo (io/file old-path) (io/file new-path))))
+
+  (delete-file [this path]
+    (let [path (str base-path path)]
+      (io/delete-file path)))
+
+  (serve-file [this ctx path {:keys [filename]}]
+    (let [path (str base-path path)
+          response (assoc (:response ctx) :body (io/file path))]
+      (if filename
+        (update response :headers assoc "content-disposition" (str "attachment; filename=" filename))
+        response))))
+
+(defn local-file-store [{:keys [path]}]
+  (->LocalFileStore path))

src/asciinema/component/mem_expiring_set.clj

@@ -0,0 +1,14 @@
+(ns asciinema.component.mem-expiring-set
+  (:require [asciinema.boundary.expiring-set :as exp-set]))
+
+(defrecord MemExpiringSet [store]
+  exp-set/ExpiringSet
+
+  (conj! [this value _expires-at]
+    (swap! store conj value))
+
+  (contains? [this value]
+    (contains? @store value)))
+
+(defn mem-expiring-set [{:keys [store]}]
+  (->MemExpiringSet (or store (atom #{}))))

src/asciinema/component/redis_client.clj

@@ -0,0 +1,28 @@
+(ns asciinema.component.redis-client
+  (:require [asciinema.boundary.expiring-set :as exp-set]
+            [clj-time.core :as t]
+            [clj-time.local :as tl]
+            [com.stuartsierra.component :as component]
+            [taoensso.carmine :as car]))
+
+(defrecord RedisClient [host port]
+  component/Lifecycle
+  (start [component]
+    (if (:listener component)
+      component
+      (let [conn {:pool {} :spec {:host host :port port}}]
+        (assoc component :conn conn))))
+  (stop [component]
+    (if (:conn component)
+      (dissoc component :conn)
+      component))
+
+  exp-set/ExpiringSet
+  (conj! [this value expires-at]
+    (let [seconds (t/in-seconds (t/interval (tl/local-now) expires-at))]
+      (car/wcar (:conn this) (car/setex value seconds true))))
+  (contains? [this value]
+    (car/as-bool (car/wcar (:conn this) (car/exists value)))))
+
+(defn redis-client [{:keys [host port]}]
+  (->RedisClient host port))

src/asciinema/component/s3_file_store.clj

@@ -0,0 +1,64 @@
+(ns asciinema.component.s3-file-store
+  (:require [asciinema.boundary.file-store :as file-store]
+            [aws.sdk.s3 :as s3]
+            [clj-time
+             [coerce :as timec]
+             [core :as time]]
+            [ring.util.http-response :as response]
+            [ring.util.mime-type :as mime-type])
+  (:import com.amazonaws.auth.BasicAWSCredentials
+           com.amazonaws.services.s3.AmazonS3Client
+           [com.amazonaws.services.s3.model GeneratePresignedUrlRequest ResponseHeaderOverrides]))
+
+(defn- s3-client* [cred]
+  (let [credentials (BasicAWSCredentials. (:access-key cred) (:secret-key cred))]
+    (AmazonS3Client. credentials)))
+
+(def ^:private s3-client (memoize s3-client*))
+
+(defn- generate-presigned-url [cred bucket path {:keys [expires filename]
+                                                 :or {expires (-> 1 time/days time/from-now)}}]
+  (let [client (s3-client cred)
+        request (GeneratePresignedUrlRequest. bucket path)]
+    (.setExpiration request (timec/to-date expires))
+    (when filename
+      (let [header-overrides (doto (ResponseHeaderOverrides.)
+                               (.setContentDisposition (str "attachment; filename=" filename)))]
+        (.setResponseHeaders request header-overrides)))
+    (.toString (.generatePresignedUrl client request))))
+
+(defrecord S3FileStore [cred bucket path-prefix]
+  file-store/FileStore
+
+  (put-file [this file path]
+    (file-store/put-file this file path nil))
+
+  (put-file [this file path size]
+    (let [path (str path-prefix path)
+          content-type (mime-type/ext-mime-type path)]
+      (s3/put-object cred bucket path file {:content-length size
+                                            :content-type content-type})))
+
+  (input-stream [this path]
+    (let [path (str path-prefix path)]
+      (:content (s3/get-object cred bucket path))))
+
+  (move-file [this old-path new-path]
+    (let [old-path (str path-prefix old-path)
+          new-path (str path-prefix new-path)]
+      (s3/copy-object cred bucket old-path new-path)
+      (s3/delete-object cred bucket old-path)))
+
+  (delete-file [this path]
+    (let [path (str path-prefix path)]
+      (s3/delete-object cred bucket path)))
+
+  (serve-file [this ctx path opts]
+    (let [path (str path-prefix path)
+          url (generate-presigned-url cred bucket path opts)]
+      (-> (:response ctx)
+          (assoc :status 302)
+          (update :headers assoc "location" url)))))
+
+(defn s3-file-store [{:keys [cred bucket path-prefix]}]
+  (->S3FileStore cred bucket path-prefix))

src/asciinema/component/yada_listener.clj

@@ -0,0 +1,21 @@
+(ns asciinema.component.yada-listener
+  (:require [com.stuartsierra.component :as component]
+            [yada.yada :as yada]))
+
+(defrecord YadaListener [port server app]
+  component/Lifecycle
+  (start [component]
+    (if server
+      component
+      (let [handler (:routes app)
+            server (yada/listener handler {:port port})]
+        (assoc component :server server))))
+  (stop [component]
+    (if server
+      (do
+        ((:close server))
+        (assoc component :server nil))
+      component)))
+
+(defn yada-listener [{:keys [port app]}]
+  (map->YadaListener {:port port :app app}))

src/asciinema/endpoint/asciicasts.clj

@@ -0,0 +1,90 @@
+(ns asciinema.endpoint.asciicasts
+  (:require [asciinema.boundary
+             [asciicast-database :as adb]
+             [executor :as executor]
+             [expiring-set :as exp-set]
+             [file-store :as fstore]
+             [png-generator :as png]
+             [user-database :as udb]]
+            [asciinema.model.asciicast :as asciicast]
+            [asciinema.yada :refer [not-found-model resource]]
+            [clj-time.core :as t]
+            [schema.core :as s]
+            [yada.yada :as yada]))
+
+(def Theme (apply s/enum asciicast/themes))
+
+(defn- service-unavailable-response [ctx]
+  (-> (:response ctx)
+      (assoc :status 503)
+      (update :headers assoc "retry-after" "5")))
+
+(defn- async-response [ctx executor f]
+  (or (executor/execute executor f)
+      (service-unavailable-response ctx)))
+
+(defn asciicast-file-resource [db file-store]
+  (resource
+   {:produces "application/json"
+    :parameters {:path {:token String}
+                 :query {(s/optional-key :dl) s/Bool}}
+    :properties (fn [ctx]
+                  (if-let [asciicast (adb/get-asciicast-by-token db (-> ctx :parameters :path :token))]
+                    {::asciicast asciicast}
+                    {:exists? false}))
+    :response (fn [ctx]
+                (let [asciicast (-> ctx :properties ::asciicast)
+                      dl (-> ctx :parameters :query :dl)
+                      path (asciicast/json-store-path asciicast)
+                      filename (str "asciicast-" (:id asciicast) ".json")]
+                  (fstore/serve-file file-store ctx path (when dl {:filename filename}))))}))
+
+(def png-ttl-days 7)
+
+(defn asciicast-image-resource [db file-store exp-set executor png-gen]
+  (resource
+   {:produces
+    "image/png"
+
+    :parameters
+    {:path {:token String}
+     :query {(s/optional-key :time) s/Num
+             (s/optional-key :theme) Theme
+             (s/optional-key :scale) (s/enum "1" "2")}}
+
+    :properties
+    (fn [ctx]
+      (if-let [asciicast (adb/get-asciicast-by-token db (-> ctx :parameters :path :token))]
+        (let [user (udb/get-user-by-id db (:user_id asciicast))
+              {:keys [time theme scale]} (-> ctx :parameters :query)
+              png-params (cond-> (asciicast/png-params asciicast user)
+                           time (assoc :snapshot-at time)
+                           theme (assoc :theme theme)
+                           scale (assoc :scale (Integer/parseInt scale)))]
+          {:version (asciicast/png-version asciicast png-params)
+           ::asciicast asciicast
+           ::png-params png-params})
+        {:exists? false}))
+
+    :response
+    (fn [ctx]
+      (let [asciicast (-> ctx :properties ::asciicast)
+            png-params (-> ctx :properties ::png-params)
+            png-store-path (asciicast/png-store-path asciicast png-params)
+            expires (-> png-ttl-days t/days t/from-now)]
+        (if (exp-set/contains? exp-set png-store-path)
+          (fstore/serve-file file-store ctx png-store-path {})
+          (async-response ctx
+                          executor
+                          (fn []
+                            (let [json-store-path (asciicast/json-store-path asciicast)]
+                              (with-open [json-is (fstore/input-stream file-store json-store-path)
+                                          png-is (png/generate png-gen json-is png-params)]
+                                (fstore/put-file file-store png-is png-store-path)))
+                            (exp-set/conj! exp-set png-store-path expires)
+                            (fstore/serve-file file-store ctx png-store-path {}))))))}))
+
+(defn asciicasts-endpoint [{:keys [db file-store exp-set executor png-gen]}]
+  ["" [["/a/" [[[:token ".json"] (asciicast-file-resource db file-store)]
+               [[:token ".png"] (asciicast-image-resource db file-store exp-set executor png-gen)]]]
+       [true (yada/resource not-found-model)]]])

src/asciinema/main.clj

@@ -0,0 +1,42 @@
+(ns asciinema.main
+    (:gen-class)
+    (:require [asciinema.yada :as y]
+              [clj-bugsnag.core :as bugsnag]
+              [com.stuartsierra.component :as component]
+              [duct.util.runtime :refer [add-shutdown-hook]]
+              [duct.util.system :refer [load-system]]
+              [environ.core :refer [env]]
+              [clojure.java.io :as io]))
+
+(defn- request-context [req]
+  (str (-> req (get :request-method :unknown) name .toUpperCase)
+       " "
+       (:uri req)))
+
+(defn- create-exception-notifier []
+  (when-let [key (:bugsnag-key env)]
+    (let [environment (:env-name env "production")
+          version (:git-sha env)]
+      (fn [ex req]
+        (bugsnag/notify ex {:api-key key
+                            :environment environment
+                            :project-ns "asciinema"
+                            :version version
+                            :context (request-context req)
+                            :meta {:request (dissoc req :body)}})))))
+
+(defn -main [& args]
+  (binding [y/*exception-notifier* (create-exception-notifier)]
+    (let [bindings {'http-port (Integer/parseInt (:port env "3000"))
+                    'db-uri (:database-url env)
+                    's3-bucket (:s3-bucket env)
+                    's3-access-key (:s3-access-key env)
+                    's3-secret-key (:s3-secret-key env)
+                    'redis-host (:redis-host env "localhost")
+                    'redis-port (Integer/parseInt (:redis-port env "6379"))
+                    'a2png-bin-path (:a2png-bin-path env "a2png/a2png.sh")}
+          system (->> (load-system [(io/resource "asciinema/system.edn")] bindings)
+                      (component/start))]
+      (add-shutdown-hook ::stop-system #(component/stop system))
+      (println "Started HTTP server on port" (-> system :http :port))))
+  @(promise))

src/asciinema/model/asciicast.clj

@@ -0,0 +1,38 @@
+(ns asciinema.model.asciicast
+  (:require [pandect.algo.sha1 :as sha1]
+            [clojure.string :as str]))
+
+(defn json-store-path [{:keys [id file stdout_frames]}]
+  (cond
+    file (str "asciicast/file/" id "/" file)
+    stdout_frames (str "asciicast/stdout_frames/" id "/" stdout_frames)))
+
+(def themes #{"asciinema" "tango" "solarized-dark" "solarized-light" "monokai"})
+(def default-theme "asciinema")
+
+(defn theme-name [asciicast user]
+  (or (:theme_name asciicast)
+      (:theme_name user)
+      default-theme))
+
+(defn snapshot-at [{:keys [snapshot_at duration]}]
+  (or snapshot_at (/ duration 2.0)))
+
+(def default-png-scale 2)
+
+(defn png-params [asciicast user]
+  {:snapshot-at (snapshot-at asciicast)
+   :theme (theme-name asciicast user)
+   :scale default-png-scale})
+
+(defn png-version [asciicast params]
+  (let [attrs (assoc params :id (:id asciicast))]
+    (->> attrs
+         (map (fn [[k v]] (str (name k) "=" v)))
+         (str/join "/")
+         (sha1/sha1))))
+
+(defn png-store-path [asciicast params]
+  (let [ver (png-version asciicast params)
+        png-filename (str ver ".png")]
+    (str "png/" (:id asciicast) "/" png-filename)))

src/asciinema/util/io.clj

@@ -0,0 +1,22 @@
+(ns asciinema.util.io
+  (:require [clojure.java.shell :as shell])
+  (:import java.io.FilterInputStream
+           java.nio.file.attribute.FileAttribute
+           java.nio.file.Files))
+
+(defn create-tmp-dir [prefix]
+  (let [dir (Files/createTempDirectory prefix (into-array FileAttribute []))]
+    (.toFile dir)))
+
+(defmacro with-tmp-dir [[sym prefix] & body]
+  `(let [~sym (create-tmp-dir ~prefix)]
+     (try
+       ~@body
+       (finally
+         (shell/sh "rm" "-rf" (.getPath ~sym))))))
+
+(defn cleanup-input-stream [is cleanup]
+  (proxy [FilterInputStream] [is]
+    (close []
+      (proxy-super close)
+      (cleanup))))

src/asciinema/yada.clj

@@ -0,0 +1,46 @@
+(ns asciinema.yada
+  (:require [clojure.java.io :as io]
+            [taoensso.timbre :as log]
+            [yada.status :as status]
+            [yada.yada :as yada]))
+
+(def ^:dynamic *exception-notifier* nil)
+
+(def not-found-model
+  {:produces
+   #{"text/html" "text/plain"}
+   :response
+   (fn [ctx]
+     (assoc (:response ctx)
+            :status 404
+            :body (case (yada/content-type ctx)
+                    "text/html" (io/input-stream (io/resource "asciinema/errors/404.html"))
+                    "Not found")))})
+
+(defn error-response [ctx]
+  (let [status (-> ctx :response :status)
+        status-name (get-in status/status [status :name])]
+    (case (yada/content-type ctx)
+      "text/html" (str "<html><body><h1>" status-name "</h1></body></html>")
+      status-name)))
+
+(defn create-logger []
+  (let [notifier *exception-notifier*]
+    (fn [ctx]
+      (when-let [error (:error ctx)]
+        (let [status (-> ctx :response :status)]
+          (when (not= status 404)
+            (log/error error))
+          (when (and (= status 500) notifier)
+            (let [ex (or (-> error ex-data :error) error)]
+              (notifier ex (:request ctx))))))
+      ctx)))
+
+(defn resource [model]
+  (let [error-statuses (set (concat (range 400 404) (range 405 600) ))]
+    (-> model
+        (assoc :logger (create-logger))
+        (update-in [:responses 404] #(or % not-found-model))
+        (update-in [:responses error-statuses] #(or % {:produces #{"text/html" "text/plain"}
+                                                       :response error-response}))
+        yada/resource)))

test/asciinema/boundary/file_store_test.clj

@@ -0,0 +1,7 @@
+(ns asciinema.boundary.file-store-test
+  (:require [clojure.test :refer :all]
+            [asciinema.boundary.file-store :as file-store]))
+
+(deftest a-test
+  (testing "FIXME, I fail."
+    (is (= 0 1))))

test/asciinema/component/db_test.clj

@@ -0,0 +1,54 @@
+(ns asciinema.component.db-test
+  (:require [clojure.test :refer :all]
+            [clojure.java.jdbc :as jdbc]
+            [clj-time.local :as timel]
+            [com.stuartsierra.component :as component]
+            [asciinema.component.db :as db]
+            [asciinema.boundary.asciicast-database :as adb]))
+
+(defmacro with-db-component [component-var & body]
+  `(let [component# (-> (db/hikaricp {:uri "jdbc:postgresql://localhost:15432/asciinema_test?user=vagrant"})
+                        component/start)]
+     (try
+       (jdbc/with-db-transaction [db# (:spec component#)]
+         (let [~component-var (assoc component# :spec db#)]
+           (jdbc/db-set-rollback-only! db#)
+           ~@body))
+       (finally
+         (component/stop component#)))))
+
+(defn insert-asciicast
+  ([db] (insert-asciicast db {}))
+  ([db attrs]
+   (first (jdbc/insert! db :asciicasts (merge {:duration 10.0
+                                               :terminal_columns 80
+                                               :terminal_lines 24
+                                               :created_at (timel/local-now)
+                                               :updated_at (timel/local-now)
+                                               :version 1
+                                               :secret_token "abcdeabcdeabcdeabcdeabcde"}
+                                              attrs)))))
+
+(deftest get-asciicast-by-id-test
+  (testing "for existing asciicast"
+    (with-db-component db
+      (let [asciicast (insert-asciicast (:spec db))]
+        (is (map? (adb/get-asciicast-by-id db (:id asciicast)))))))
+  (testing "for non-existing asciicast"
+    (with-db-component db
+      (is (nil? (adb/get-asciicast-by-id db 1))))))
+
+(deftest get-asciicast-by-token-test
+  (testing "for existing public asciicast"
+    (with-db-component db
+      (let [asciicast (insert-asciicast (:spec db) {:private false})]
+        (is (map? (adb/get-asciicast-by-token db (:secret_token asciicast))))
+        (is (map? (adb/get-asciicast-by-token db (-> asciicast :id str)))))))
+  (testing "for existing private asciicast"
+    (with-db-component db
+      (let [asciicast (insert-asciicast (:spec db) {:private true})]
+        (is (map? (adb/get-asciicast-by-token db (:secret_token asciicast))))
+        (is (nil? (adb/get-asciicast-by-token db (-> asciicast :id str)))))))
+  (testing "for non-existing asciicast"
+    (with-db-component db
+      (is (nil? (adb/get-asciicast-by-token db "1"))))))