add auth + remote nrepl

src/tbd/auth/core.clj

@@ -0,0 +1,130 @@
+(ns tbd.auth.core
+  "Gitea OAuth2 (authorization-code flow) and the admin allowlist. No Ring here; the
+  routes and middleware own that."
+  (:require [clojure.string :as str]
+            [muuntaja.core :as m])
+  (:import (java.net URI URLEncoder)
+           (java.net.http HttpClient HttpRequest HttpResponse$BodyHandlers HttpRequest$BodyPublishers)
+           (java.nio.charset StandardCharsets)
+           (java.security MessageDigest SecureRandom)
+           (java.time Duration)
+           (java.util Base64)))
+
+(def ^:private http-client
+  (delay (-> (HttpClient/newBuilder) (.connectTimeout (Duration/ofSeconds 5)) .build)))
+
+(defn java-http
+  "Default `:http` fn: {:method :get|:post, :url, :headers, :body} -> {:status, :body}.
+  Configs can swap it out, which is how the tests stub Gitea."
+  [{:keys [method url headers body]}]
+  (let [builder (-> (HttpRequest/newBuilder (URI/create url)) (.timeout (Duration/ofSeconds 10)))]
+    (doseq [[k v] headers] (.header builder k v))
+    (case method
+      :get (.GET builder)
+      :post (.POST builder (HttpRequest$BodyPublishers/ofString body)))
+    (let [resp (.send ^HttpClient @http-client (.build builder) (HttpResponse$BodyHandlers/ofString))]
+      {:status (.statusCode resp) :body (.body resp)})))
+
+(defn- env-val [env k]
+  (let [v (get env k)]
+    (when-not (str/blank? v) (str/trim v))))
+
+(defn- strip-trailing-slashes [s]
+  (some-> s (str/replace #"/+$" "")))
+
+(defn env-config
+  "Auth config from environment variables:
+    GITEA_URL, GITEA_CLIENT_ID, GITEA_CLIENT_SECRET  the Gitea OAuth2 application
+    BASE_URL       public URL of this app; <BASE_URL>/auth/callback is the redirect URI to register in Gitea
+    ADMIN_USERS    comma-separated Gitea usernames allowed to use the admin API (none by default)
+    SESSION_SECRET signs/encrypts session cookies (random per start when unset, so logins don't survive restarts)"
+  ([] (env-config (System/getenv)))
+  ([env]
+   (let [base-url (strip-trailing-slashes (env-val env "BASE_URL"))]
+     {:gitea-url (strip-trailing-slashes (env-val env "GITEA_URL"))
+      :client-id (env-val env "GITEA_CLIENT_ID")
+      :client-secret (env-val env "GITEA_CLIENT_SECRET")
+      :redirect-uri (some-> base-url (str "/auth/callback"))
+      :secure-cookies? (boolean (some-> base-url (str/starts-with? "https://")))
+      :admin-users (->> (str/split (or (env-val env "ADMIN_USERS") "") #",")
+                        (map str/trim)
+                        (remove str/blank?)
+                        (map str/lower-case)
+                        set)
+      :session-secret (env-val env "SESSION_SECRET")
+      :http java-http})))
+
+(defn configured?
+  "True when everything needed to run the OAuth flow is set."
+  [config]
+  (every? config [:gitea-url :client-id :client-secret :redirect-uri]))
+
+(defn admin?
+  "Gitea usernames are case-insensitive, so the allowlist is compared lower-cased."
+  [config login]
+  (contains? (:admin-users config) (str/lower-case login)))
+
+(defn session-key
+  "Cookie stores need a 16-byte key; derive it from the secret, or make a throwaway one."
+  [secret]
+  (if secret
+    (byte-array (take 16 (.digest (MessageDigest/getInstance "SHA-256")
+                                  (.getBytes ^String secret StandardCharsets/UTF_8))))
+    (let [k (byte-array 16)]
+      (.nextBytes (SecureRandom.) k)
+      k)))
+
+(defn new-state
+  "Random OAuth `state`, tying the callback to the browser that started the login."
+  []
+  (let [bytes (byte-array 32)]
+    (.nextBytes (SecureRandom.) bytes)
+    (.encodeToString (.withoutPadding (Base64/getUrlEncoder)) bytes)))
+
+(defn state-matches? [expected actual]
+  (and (string? expected)
+       (string? actual)
+       (MessageDigest/isEqual (.getBytes ^String expected StandardCharsets/UTF_8)
+                              (.getBytes ^String actual StandardCharsets/UTF_8))))
+
+(defn- form-encode [params]
+  (str/join "&" (map (fn [[k v]]
+                       (str (URLEncoder/encode (name k) StandardCharsets/UTF_8) "="
+                            (URLEncoder/encode (str v) StandardCharsets/UTF_8)))
+                     params)))
+
+(defn authorize-url [{:keys [gitea-url client-id redirect-uri]} state]
+  (str gitea-url "/login/oauth/authorize?"
+       (form-encode {:client_id client-id
+                     :redirect_uri redirect-uri
+                     :response_type "code"
+                     :state state})))
+
+(defn- parse-json [body]
+  (m/decode "application/json" body))
+
+(defn exchange-code
+  "Trades the authorization code for an access token; nil if Gitea refuses it."
+  [{:keys [gitea-url client-id client-secret redirect-uri http]} code]
+  (let [{:keys [status body]} (http {:method :post
+                                     :url (str gitea-url "/login/oauth/access_token")
+                                     :headers {"Content-Type" "application/x-www-form-urlencoded"
+                                               "Accept" "application/json"}
+                                     :body (form-encode {:grant_type "authorization_code"
+                                                         :client_id client-id
+                                                         :client_secret client-secret
+                                                         :redirect_uri redirect-uri
+                                                         :code code})})]
+    (when (= 200 status)
+      (:access_token (parse-json body)))))
+
+(defn fetch-user
+  "The Gitea user behind an access token as {:login :id}; nil if Gitea refuses the token."
+  [{:keys [gitea-url http]} token]
+  (let [{:keys [status body]} (http {:method :get
+                                     :url (str gitea-url "/api/v1/user")
+                                     :headers {"Authorization" (str "Bearer " token)
+                                               "Accept" "application/json"}})]
+    (when (= 200 status)
+      (let [{:keys [login id]} (parse-json body)]
+        (when login {:login login :id id})))))

src/tbd/auth/middleware.clj

@@ -0,0 +1,46 @@
+(ns tbd.auth.middleware
+  (:require [ring.middleware.session :refer [wrap-session]]
+            [ring.middleware.session.cookie :refer [cookie-store]]
+            [tbd.auth.core :as auth]
+            [tbd.http :refer [edn-response]]))
+
+(def session-ttl-ms (* 8 60 60 1000))
+
+(defn session-middleware
+  "Cookie-backed sessions (encrypted and signed, so nothing is stored server-side). Lax, not
+  Strict: the OAuth callback is a cross-site redirect from Gitea and must still carry the
+  cookie that holds the login `state`."
+  [config]
+  (let [store (cookie-store {:key (auth/session-key (:session-secret config))})]
+    (fn [handler]
+      (wrap-session handler {:store store
+                             :cookie-name "tbd-session"
+                             :cookie-attrs {:http-only true
+                                            :same-site :lax
+                                            :secure (:secure-cookies? config)
+                                            :max-age (quot session-ttl-ms 1000)}}))))
+
+(defn current-user
+  "The logged-in user from the session, or nil when there is none or it has expired. The
+  cookie is only a bearer of `:expires-at`, so the server enforces the lifetime here."
+  ([req] (current-user req (System/currentTimeMillis)))
+  ([req now]
+   (let [{:keys [expires-at] :as user} (get-in req [:session :user])]
+     (when (and user expires-at (< now expires-at))
+       user))))
+
+(defn admin-middleware
+  "Reitit middleware for routes whose data has `:admin? true`: 401 without a login, 403 when
+  the user isn't on the ADMIN_USERS allowlist. Passes the user on as `:user`. Mount it ahead
+  of the parsing/coercion middleware so unauthenticated callers never reach them."
+  [config]
+  {:name ::admin
+   :compile (fn [route-data _opts]
+              (when (:admin? route-data)
+                (fn [handler]
+                  (fn [req]
+                    (if-let [user (current-user req)]
+                      (if (auth/admin? config (:login user))
+                        (handler (assoc req :user user))
+                        (edn-response 403 {:error "admin access required"}))
+                      (edn-response 401 {:error "login required"}))))))})

src/tbd/auth/routes.clj

@@ -0,0 +1,63 @@
+(ns tbd.auth.routes
+  (:require [ring.util.response :as response]
+            [tbd.auth.core :as auth]
+            [tbd.auth.middleware :as mw]
+            [tbd.http :refer [edn-response]]))
+
+(def ^:private not-configured
+  (edn-response 503 {:error "OAuth is not configured (set GITEA_URL, GITEA_CLIENT_ID, GITEA_CLIENT_SECRET, BASE_URL)"}))
+
+(defn- login-handler [config]
+  (fn [{:keys [session]}]
+    (if-not (auth/configured? config)
+      not-configured
+      (let [state (auth/new-state)]
+        (-> (response/redirect (auth/authorize-url config state))
+            (assoc :session (assoc session :oauth-state state)))))))
+
+(defn- callback-handler [config]
+  (fn [{:keys [session parameters]}]
+    (let [{:keys [code state error]} (:query parameters)]
+      (cond
+        (not (auth/configured? config)) not-configured
+        (not (auth/state-matches? (:oauth-state session) state)) (edn-response 400 {:error "invalid OAuth state"})
+        error (edn-response 403 {:error "login was denied"})
+        (nil? code) (edn-response 400 {:error "missing authorization code"})
+        :else
+        (try
+          (let [user (some->> (auth/exchange-code config code) (auth/fetch-user config))]
+            (if user
+              ;; A fresh session (not the old one plus a user) so nothing from before login carries over.
+              (-> (response/redirect "/")
+                  (assoc :session {:user (assoc user :expires-at (+ (System/currentTimeMillis)
+                                                                     mw/session-ttl-ms))}))
+              (edn-response 401 {:error "login failed"})))
+          (catch Exception e
+            (println "[tbd] Gitea login failed:" (.getMessage e))
+            (edn-response 502 {:error "could not complete login with Gitea"})))))))
+
+(defn- me-handler [config]
+  (fn [req]
+    (if-let [{:keys [login id]} (mw/current-user req)]
+      (edn-response 200 {:login login :id id :admin? (auth/admin? config login)})
+      (edn-response 401 {:error "login required"}))))
+
+(defn routes [config]
+  ["/auth"
+   ["/login" {:get {:tags ["auth"]
+                    :summary "Start the Gitea OAuth login (redirects to Gitea)"
+                    :handler (login-handler config)}}]
+   ["/callback" {:get {:tags ["auth"]
+                       :summary "OAuth redirect target; completes the login and redirects to /"
+                       :parameters {:query [:map
+                                            [:code {:optional true} :string]
+                                            [:state {:optional true} :string]
+                                            [:error {:optional true} :string]]}
+                       :handler (callback-handler config)}}]
+   ["/logout" {:post {:tags ["auth"]
+                      :summary "End the session"
+                      :handler (fn [_req]
+                                 (assoc (edn-response 200 {:logged-out true}) :session nil))}}]
+   ["/me" {:get {:tags ["auth"]
+                 :summary "The logged-in user (401 if not logged in)"
+                 :handler (me-handler config)}}]])

src/tbd/core.clj

@@ -13,8 +13,14 @@
             [reitit.ring.middleware.parameters :as parameters]
             [muuntaja.core :as m]
             [ring.util.response :as response]
+            [tbd.auth.core :as auth]
+            [tbd.auth.middleware :as auth-mw]
+            [tbd.auth.routes :as auth-routes]
             [tbd.health.routes :as health]
-            [tbd.math.routes :as math]))
+            [tbd.http :as http]
+            [tbd.math.routes :as math]
+            [tbd.nrepl.core :as nrepl]
+            [tbd.nrepl.routes :as nrepl-routes]))
 
 (defn- swagger-handler
   "reitit emits `\"definitions\": null` when no route declares a schema, which
@@ -41,14 +47,22 @@
   (-> (response/resource-response "public/index.html")
       (response/content-type "text/html; charset=utf-8")))
 
+(defn- decode-error-handler
+  "A request body that isn't valid for its Content-Type -> 400 in the same EDN shape."
+  [_e _req]
+  {:status 400
+   :headers {"Content-Type" "application/edn; charset=utf-8"}
+   :body (pr-str {:error "malformed request body"})})
+
 (def ^:private exception-middleware
   (exception/create-exception-middleware
     (assoc exception/default-handlers
-           :reitit.coercion/request-coercion coercion-error-handler)))
+           :reitit.coercion/request-coercion coercion-error-handler
+           :muuntaja/decode decode-error-handler)))
 
 ;; Each logical group (health, users, orders, ...) owns a `tbd.<group>.routes`
 ;; namespace that returns its own route subtree; they're concatenated here.
-(def router
+(defn make-router [{:keys [auth nrepl]}]
   (ring/router
     [["/swagger.json"
       {:get {:no-doc true
@@ -57,23 +71,40 @@
      ["/" {:get {:no-doc true
                  :handler index-handler}}]
      (health/routes)
-     (math/routes)]
+     (math/routes)
+     (auth-routes/routes auth)
+     (nrepl-routes/routes nrepl)]
     {:data {:muuntaja m/instance
             :coercion malli/coercion
-            :middleware [parameters/parameters-middleware
-                         muuntaja-middleware/format-middleware
+            ;; Admin auth goes first so unauthenticated callers to `:admin? true` routes
+            ;; are turned away before any body parsing or coercion runs. The muuntaja
+            ;; middleware is split around the exception middleware (rather than the combined
+            ;; format-middleware) so a malformed request body is caught and answered with a 400.
+            :middleware [(auth-mw/admin-middleware auth)
+                         parameters/parameters-middleware
+                         muuntaja-middleware/format-negotiate-middleware
+                         muuntaja-middleware/format-response-middleware
                          exception-middleware
+                         muuntaja-middleware/format-request-middleware
                          coercion/coerce-request-middleware]}}))
 
-(def app
+(defn make-app [{:keys [auth] :as config}]
   (-> (ring/ring-handler
-        router
+        (make-router config)
         (ring/routes
           (swagger-ui/create-swagger-ui-handler {:path "/api-docs"})
           ;; Compiled UI (script/ui-build writes resources/public/js).
           (ring/create-resource-handler {:path "/js" :root "public/js"})
           (ring/create-default-handler)))
-      wrap-head))
+      wrap-head
+      http/wrap-browser-viewable-edn
+      ((auth-mw/session-middleware auth))))
+
+(def config
+  {:auth (auth/env-config)
+   :nrepl (nrepl/env-config)})
+
+(def app (make-app config))
 
 (defn add-shutdown-hook [server]
   (.addShutdownHook
@@ -84,6 +115,12 @@
   (let [port (Integer/parseInt (str (or (System/getenv "PORT")
                                          (get opts :port 3000))))]
     (println (format "[tbd] starting server on port %d..." port))
+    (when-not (auth/configured? (:auth config))
+      (println "[tbd] WARNING: Gitea OAuth is not configured; login and the admin API are unavailable"))
+    (when (empty? (get-in config [:auth :admin-users]))
+      (println "[tbd] WARNING: ADMIN_USERS is empty; nobody can use the admin API"))
+    (when-not (get-in config [:auth :session-secret])
+      (println "[tbd] WARNING: SESSION_SECRET is not set; logins won't survive a restart"))
     (try
       (let [server (jetty/run-jetty (wrap-defaults app api-defaults)
                                     {:port port

src/tbd/http.clj

@@ -0,0 +1,20 @@
+(ns tbd.http)
+
+(defn edn-response [status body]
+  {:status status
+   :headers {"Content-Type" "application/edn; charset=utf-8"}
+   :body (pr-str body)})
+
+(defn wrap-browser-viewable-edn
+  "Browsers download `application/edn` instead of showing it. When the request comes from a
+  browser navigation (Accept includes text/html), relabel EDN responses as text/plain so they
+  render inline. Programmatic clients (fetch, curl, ...) still get `application/edn`."
+  [handler]
+  (fn [req]
+    (let [resp (handler req)
+          accept (get-in req [:headers "accept"] "")
+          content-type (get-in resp [:headers "Content-Type"] "")]
+      (if (and (re-find #"text/html" accept)
+               (.startsWith ^String content-type "application/edn"))
+        (assoc-in resp [:headers "Content-Type"] "text/plain; charset=utf-8")
+        resp))))

src/tbd/nrepl/core.clj

@@ -0,0 +1,45 @@
+(ns tbd.nrepl.core
+  "The on-demand nREPL debug server. No HTTP here."
+  (:require [clojure.string :as str]
+            [nrepl.server :as nrepl]))
+
+(def default-port 7888)
+
+;; nREPL has no authentication and evaluates arbitrary code, so it only listens on loopback
+;; unless the operator explicitly opens it up.
+(def default-bind "127.0.0.1")
+
+(defn env-config
+  "NREPL_PORT (default 7888) and NREPL_BIND (default 127.0.0.1)."
+  ([] (env-config (System/getenv)))
+  ([env]
+   (let [port (get env "NREPL_PORT")
+         bind (get env "NREPL_BIND")]
+     {:port (if (str/blank? port) default-port (parse-long (str/trim port)))
+      :bind (if (str/blank? bind) default-bind (str/trim bind))})))
+
+(defonce ^:private state (atom nil))
+
+(defn status []
+  (if-let [{:keys [port bind]} @state]
+    {:enabled true :bind bind :port port}
+    {:enabled false}))
+
+(defn enable!
+  "Starts the server if it isn't running (a no-op otherwise); returns the status. Port 0
+  picks a free port, and the status reports the one actually bound."
+  [{:keys [port bind]}]
+  (locking state
+    (when-not @state
+      (let [server (nrepl/start-server :port port :bind bind)]
+        (reset! state {:server server :bind bind :port (:port server)})))
+    (status)))
+
+(defn disable!
+  "Stops the server if it's running; returns the status."
+  []
+  (locking state
+    (when-let [{:keys [server]} @state]
+      (nrepl/stop-server server)
+      (reset! state nil))
+    (status)))

src/tbd/nrepl/routes.clj

@@ -0,0 +1,24 @@
+(ns tbd.nrepl.routes
+  (:require [tbd.http :refer [edn-response]]
+            [tbd.nrepl.core :as nrepl]))
+
+(defn- toggle-handler [config]
+  (fn [{{{:keys [enabled]} :body} :parameters {:keys [login]} :user}]
+    (try
+      (let [status (if enabled (nrepl/enable! config) (nrepl/disable!))]
+        (println (format "[tbd] nREPL %s by %s%s"
+                         (if enabled "enabled" "disabled")
+                         login
+                         (if enabled (format " on %s:%d" (:bind status) (:port status)) "")))
+        (edn-response 200 status))
+      (catch Exception e
+        (println "[tbd] nREPL toggle failed:" (.getMessage e))
+        (edn-response 500 {:error (str "could not change nREPL state: " (.getMessage e))})))))
+
+(defn routes [config]
+  ["/nrepl"
+   {:post {:tags ["admin"]
+           :summary "Enable or disable the nREPL debug server (admin only)"
+           :admin? true
+           :parameters {:body [:map [:enabled {:description "true starts the server, false stops it"} :boolean]]}
+           :handler (toggle-handler config)}}])