Compare commits
21
Commits
a50256a042
...
clojure
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
ae676f2b6c | ||
|
|
6b4c8034f1 | ||
|
|
161737d4c7 | ||
|
|
5990b8d735 | ||
|
|
134ee27ca6 | ||
|
|
71918ee4fd | ||
|
|
a9b7874f36 | ||
|
|
32a1509482 | ||
|
|
6afaa228c3 | ||
|
|
5c1a080831 | ||
|
|
13a53a26d0 | ||
|
|
02cc607e73 | ||
|
|
ce343dfcf6 | ||
|
|
397d9f7b5c | ||
|
|
c688846a26 | ||
|
|
30aa52cdc7 | ||
|
|
553dac3069 | ||
|
|
2c576aff4e | ||
|
|
201155c0b2 | ||
|
|
8169796eb9 | ||
|
|
08793c5099 |
@@ -0,0 +1,5 @@
|
|||||||
|
target/
|
||||||
|
node_modules/
|
||||||
|
.env
|
||||||
|
.cpcache/
|
||||||
|
.nrepl-port
|
||||||
@@ -1,15 +1,26 @@
|
|||||||
# btcprice
|
# btcprice
|
||||||
|
|
||||||
Bitcoin price tracker - Clojure Kit web application.
|
Bitcoin price tracker UI — Clojure Kit web application. Serves the HTML/Tailwind UI. Connects to btcdata for live price data via WebSocket.
|
||||||
|
|
||||||
## Build & Development Commands
|
## Build & Development Commands
|
||||||
|
|
||||||
- `make run` — Start dev server on port 3000
|
- `make run` — Start dev server on port 4000
|
||||||
- `make repl` — Start nREPL on port 7888
|
- `make repl` — Start nREPL
|
||||||
- `make test` — Run tests
|
- `make test` — Run tests
|
||||||
- `make tailwind` — Watch Tailwind CSS for changes
|
- `make tailwind` — Watch Tailwind CSS for changes
|
||||||
- `make uberjar` — Build production JAR
|
- `make uberjar` — Build production JAR
|
||||||
- `docker compose up -d` — Start PostgreSQL
|
- `docker compose up -d` — Start btcprice + btcdata containers
|
||||||
|
|
||||||
|
## Docker
|
||||||
|
|
||||||
|
Docker runs alongside local dev on different ports:
|
||||||
|
|
||||||
|
| Service | Local dev | Docker |
|
||||||
|
|----------|----------------|----------------|
|
||||||
|
| btcprice | localhost:4000 | localhost:4041 |
|
||||||
|
| btcdata | localhost:4100 | localhost:4101 |
|
||||||
|
|
||||||
|
btcprice's docker-compose includes btcdata via `include: ../btcdata/docker-compose.yml`.
|
||||||
|
|
||||||
## REPL Commands
|
## REPL Commands
|
||||||
|
|
||||||
@@ -18,10 +29,6 @@ Bitcoin price tracker - Clojure Kit web application.
|
|||||||
(go) ;; Start system
|
(go) ;; Start system
|
||||||
(reset) ;; Reload code & restart
|
(reset) ;; Reload code & restart
|
||||||
(halt) ;; Stop system
|
(halt) ;; Stop system
|
||||||
(reset-db) ;; Drop & re-migrate database
|
|
||||||
(migrate) ;; Run pending migrations
|
|
||||||
(rollback) ;; Rollback last migration
|
|
||||||
(query-fn) ;; Get database query function
|
|
||||||
```
|
```
|
||||||
|
|
||||||
## Architecture
|
## Architecture
|
||||||
@@ -29,9 +36,10 @@ Bitcoin price tracker - Clojure Kit web application.
|
|||||||
- **Framework:** Kit (Integrant-based)
|
- **Framework:** Kit (Integrant-based)
|
||||||
- **Server:** Undertow
|
- **Server:** Undertow
|
||||||
- **Routing:** Reitit
|
- **Routing:** Reitit
|
||||||
- **Templates:** Hiccup + HTMX
|
- **Templates:** Hiccup + HTMX (WebSocket extension)
|
||||||
- **Styling:** Tailwind CSS v4
|
- **Styling:** Tailwind CSS v4
|
||||||
- **Database:** PostgreSQL + conman + Migratus
|
- **Data backend:** btcdata (separate service at BTCDATA_URL, default http://localhost:4100)
|
||||||
|
- **No database** — all data comes from btcdata
|
||||||
|
|
||||||
## Source Layout
|
## Source Layout
|
||||||
|
|
||||||
@@ -50,6 +58,7 @@ src/clj/pmagnus/btcprice/
|
|||||||
│ └── formats.clj # Content negotiation
|
│ └── formats.clj # Content negotiation
|
||||||
└── routes/
|
└── routes/
|
||||||
├── api.clj # /api routes (JSON)
|
├── api.clj # /api routes (JSON)
|
||||||
├── ui.clj # UI routes (HTML)
|
├── ui.clj # UI routes (HTML + HTMX WebSocket)
|
||||||
|
├── ws_proxy.clj # WebSocket proxy to btcdata
|
||||||
└── utils.clj # Route utilities
|
└── utils.clj # Route utilities
|
||||||
```
|
```
|
||||||
|
|||||||
+18
-4
@@ -1,14 +1,28 @@
|
|||||||
FROM clojure:openjdk-25 AS build
|
FROM node:22-alpine AS css
|
||||||
|
|
||||||
WORKDIR /build
|
WORKDIR /build
|
||||||
COPY . .
|
COPY package.json package-lock.json ./
|
||||||
RUN clj -Sforce -T:build all
|
RUN npm ci
|
||||||
|
COPY resources/css/ resources/css/
|
||||||
|
COPY src/ src/
|
||||||
|
COPY tailwind.config.js ./
|
||||||
|
RUN npm run css:build
|
||||||
|
|
||||||
FROM azul/zulu-openjdk-alpine:25
|
FROM clojure:temurin-21-tools-deps-alpine AS build
|
||||||
|
|
||||||
|
WORKDIR /build
|
||||||
|
COPY deps.edn build.clj ./
|
||||||
|
RUN clj -Sforce -P
|
||||||
|
COPY . .
|
||||||
|
COPY --from=css /build/resources/public/css/output.css resources/public/css/output.css
|
||||||
|
RUN clj -T:build all
|
||||||
|
|
||||||
|
FROM eclipse-temurin:21-jre-alpine
|
||||||
|
|
||||||
COPY --from=build /build/target/btcprice-standalone.jar /btcprice/btcprice-standalone.jar
|
COPY --from=build /build/target/btcprice-standalone.jar /btcprice/btcprice-standalone.jar
|
||||||
|
|
||||||
EXPOSE 4040
|
EXPOSE 4040
|
||||||
ENV PORT=4040
|
ENV PORT=4040
|
||||||
|
ENV BTCDATA_URL=http://btcdata:4101
|
||||||
|
|
||||||
CMD ["java", "-jar", "/btcprice/btcprice-standalone.jar"]
|
CMD ["java", "-jar", "/btcprice/btcprice-standalone.jar"]
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
include .env
|
include .env
|
||||||
export
|
export
|
||||||
|
|
||||||
.PHONY: clean run repl tailwind test uberjar
|
.PHONY: clean run run-docker repl tailwind test uberjar
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
rm -rf target
|
rm -rf target
|
||||||
@@ -9,6 +9,9 @@ clean:
|
|||||||
run:
|
run:
|
||||||
clj -M:dev -e "(dev-prep!) (go)" -r
|
clj -M:dev -e "(dev-prep!) (go)" -r
|
||||||
|
|
||||||
|
run-docker:
|
||||||
|
BTCDATA_URL=http://localhost:4101 clj -M:dev -e "(dev-prep!) (go)" -r
|
||||||
|
|
||||||
repl:
|
repl:
|
||||||
clj -M:dev:nrepl
|
clj -M:dev:nrepl
|
||||||
|
|
||||||
|
|||||||
@@ -0,0 +1,32 @@
|
|||||||
|
# btcprice
|
||||||
|
|
||||||
|
Bitcoin price tracker UI. Serves an HTML page with live price updates streamed from [btcdata](../btcdata) via WebSocket using HTMX.
|
||||||
|
|
||||||
|
## Quick Start
|
||||||
|
|
||||||
|
```bash
|
||||||
|
# Start btcdata first (provides price data)
|
||||||
|
cd ../btcdata && make run
|
||||||
|
|
||||||
|
# Local dev
|
||||||
|
make run # starts on port 4000
|
||||||
|
make tailwind # watch Tailwind CSS (separate terminal)
|
||||||
|
|
||||||
|
# Docker (starts both btcprice + btcdata)
|
||||||
|
docker compose up -d # btcprice on 4041, btcdata on 4101
|
||||||
|
```
|
||||||
|
|
||||||
|
## Environment Variables
|
||||||
|
|
||||||
|
| Variable | Default | Description |
|
||||||
|
|---|---|---|
|
||||||
|
| `PORT` | `4000` | HTTP server port |
|
||||||
|
| `BTCDATA_URL` | `http://192.168.50.42:4100` | btcdata service URL (browser connects via WebSocket) |
|
||||||
|
|
||||||
|
## How It Works
|
||||||
|
|
||||||
|
The server renders an HTML page with HTMX and the WebSocket extension (`hx-ext="ws"`). HTMX connects directly to btcdata's WebSocket endpoint (`BTCDATA_URL/api/price/ws`), which sends HTML fragments. HTMX swaps the received `<div id="price-display">` into the DOM automatically. Price changes are color-coded (green up, red down). Reconnection is handled by HTMX with exponential backoff.
|
||||||
|
|
||||||
|
## Tech Stack
|
||||||
|
|
||||||
|
Clojure · Kit · Undertow · Reitit · Hiccup · HTMX · Tailwind CSS v4
|
||||||
@@ -1,7 +1,5 @@
|
|||||||
{:paths ["src/clj" "resources"]
|
{:paths ["src/clj" "resources"]
|
||||||
:deps {org.clojure/clojure {:mvn/version "1.12.3"}
|
:deps {org.clojure/clojure {:mvn/version "1.12.3"}
|
||||||
org.clojure/data.json {:mvn/version "2.5.1"}
|
|
||||||
|
|
||||||
;; Kit
|
;; Kit
|
||||||
io.github.kit-clj/kit-core {:mvn/version "1.0.6"}
|
io.github.kit-clj/kit-core {:mvn/version "1.0.6"}
|
||||||
|
|
||||||
@@ -28,11 +26,7 @@
|
|||||||
;; Serialization
|
;; Serialization
|
||||||
metosin/muuntaja {:mvn/version "0.6.11"}
|
metosin/muuntaja {:mvn/version "0.6.11"}
|
||||||
luminus-transit/luminus-transit {:mvn/version "0.1.6"}
|
luminus-transit/luminus-transit {:mvn/version "0.1.6"}
|
||||||
|
org.clojure/data.json {:mvn/version "2.5.1"}}
|
||||||
;; Database
|
|
||||||
io.github.kit-clj/kit-postgres {:mvn/version "1.0.7"}
|
|
||||||
io.github.kit-clj/kit-sql-conman {:mvn/version "1.10.5"}
|
|
||||||
io.github.kit-clj/kit-sql-migratus {:mvn/version "1.0.5"}}
|
|
||||||
|
|
||||||
:aliases
|
:aliases
|
||||||
{:build {:deps {io.github.clojure/tools.build {:mvn/version "0.10.9"}}
|
{:build {:deps {io.github.clojure/tools.build {:mvn/version "0.10.9"}}
|
||||||
|
|||||||
@@ -0,0 +1,15 @@
|
|||||||
|
networks:
|
||||||
|
btc-network:
|
||||||
|
name: btc-network
|
||||||
|
external: true
|
||||||
|
|
||||||
|
services:
|
||||||
|
btcprice:
|
||||||
|
build: .
|
||||||
|
restart: unless-stopped
|
||||||
|
networks:
|
||||||
|
- btc-network
|
||||||
|
ports:
|
||||||
|
- "4041:4040"
|
||||||
|
environment:
|
||||||
|
BTCDATA_URL: "http://btcdata:${DOCKER_BTCDATA_PORT:-4102}"
|
||||||
Vendored
-25
@@ -1,6 +1,5 @@
|
|||||||
(ns user
|
(ns user
|
||||||
(:require
|
(:require
|
||||||
[clojure.tools.logging :as log]
|
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[integrant.repl :refer [go halt reset reset-all set-prep!]]
|
[integrant.repl :refer [go halt reset reset-all set-prep!]]
|
||||||
[integrant.repl.state :as state]
|
[integrant.repl.state :as state]
|
||||||
@@ -19,30 +18,6 @@
|
|||||||
(-> (config/system-config {:profile :test})
|
(-> (config/system-config {:profile :test})
|
||||||
(ig/expand)))))
|
(ig/expand)))))
|
||||||
|
|
||||||
(defn reset-db []
|
|
||||||
(let [sys (or @pmagnus.btcprice.core/system
|
|
||||||
integrant.repl.state/system)]
|
|
||||||
(when-let [mig (:db.sql/migrations sys)]
|
|
||||||
(migratus.core/reset mig)
|
|
||||||
(log/info "Database reset complete"))))
|
|
||||||
|
|
||||||
(defn rollback []
|
|
||||||
(let [sys (or @pmagnus.btcprice.core/system
|
|
||||||
integrant.repl.state/system)]
|
|
||||||
(when-let [mig (:db.sql/migrations sys)]
|
|
||||||
(migratus.core/rollback mig))))
|
|
||||||
|
|
||||||
(defn migrate []
|
|
||||||
(let [sys (or @pmagnus.btcprice.core/system
|
|
||||||
integrant.repl.state/system)]
|
|
||||||
(when-let [mig (:db.sql/migrations sys)]
|
|
||||||
(migratus.core/migrate mig))))
|
|
||||||
|
|
||||||
(defn query-fn []
|
|
||||||
(let [sys (or @pmagnus.btcprice.core/system
|
|
||||||
integrant.repl.state/system)]
|
|
||||||
(:db.sql/query-fn sys)))
|
|
||||||
|
|
||||||
(comment
|
(comment
|
||||||
(dev-prep!)
|
(dev-prep!)
|
||||||
(go)
|
(go)
|
||||||
|
|||||||
@@ -1 +0,0 @@
|
|||||||
DROP TABLE binance_price;
|
|
||||||
@@ -1,5 +0,0 @@
|
|||||||
CREATE TABLE binance_price (
|
|
||||||
id BIGSERIAL PRIMARY KEY,
|
|
||||||
price NUMERIC(18,8) NOT NULL,
|
|
||||||
recorded_at TIMESTAMPTZ NOT NULL DEFAULT NOW()
|
|
||||||
);
|
|
||||||
@@ -1 +0,0 @@
|
|||||||
Migration files go here.
|
|
||||||
File diff suppressed because one or more lines are too long
@@ -1,9 +0,0 @@
|
|||||||
-- queries for btcprice
|
|
||||||
|
|
||||||
-- :name insert-binance-price! :! :n
|
|
||||||
-- :doc Insert a Binance BTC price
|
|
||||||
INSERT INTO binance_price (price) VALUES (:price)
|
|
||||||
|
|
||||||
-- :name get-latest-binance-price :? :1
|
|
||||||
-- :doc Get the most recent Binance BTC price
|
|
||||||
SELECT price, recorded_at FROM binance_price ORDER BY id DESC LIMIT 1
|
|
||||||
+5
-20
@@ -32,27 +32,12 @@
|
|||||||
{:routes #ig/ref :router/routes
|
{:routes #ig/ref :router/routes
|
||||||
:env #ig/ref :system/env}
|
:env #ig/ref :system/env}
|
||||||
|
|
||||||
:db.sql/connection
|
|
||||||
{:jdbc-url #env JDBC_URL}
|
|
||||||
|
|
||||||
:db.sql/query-fn
|
|
||||||
{:conn #ig/ref :db.sql/connection
|
|
||||||
:options {}
|
|
||||||
:filename "queries.sql"}
|
|
||||||
|
|
||||||
:db.sql/migrations
|
|
||||||
{:store :database
|
|
||||||
:db {:datasource #ig/ref :db.sql/connection}
|
|
||||||
:migrate-on-init? true}
|
|
||||||
|
|
||||||
:reitit.routes/api
|
:reitit.routes/api
|
||||||
{:base-path "/api"
|
{:base-path "/api"}
|
||||||
:query-fn #ig/ref :db.sql/query-fn}
|
|
||||||
|
|
||||||
:reitit.routes/ui
|
:reitit.routes/ui
|
||||||
{:base-path ""
|
{:base-path ""}
|
||||||
:query-fn #ig/ref :db.sql/query-fn}
|
|
||||||
|
|
||||||
:ws/binance
|
:reitit.routes/ws-proxy
|
||||||
{:query-fn #ig/ref :db.sql/query-fn
|
{:base-path ""
|
||||||
:uri "wss://stream.binance.com:9443/ws/btcusdt@trade"}}
|
:btcdata-url #or [#env BTCDATA_URL "http://localhost:4100"]}}
|
||||||
|
|||||||
@@ -6,16 +6,12 @@
|
|||||||
[pmagnus.btcprice.env :refer [defaults]]
|
[pmagnus.btcprice.env :refer [defaults]]
|
||||||
|
|
||||||
;; Edges
|
;; Edges
|
||||||
[kit.edge.db.postgres]
|
|
||||||
[kit.edge.db.sql.conman]
|
|
||||||
[kit.edge.db.sql.migratus]
|
|
||||||
[kit.edge.server.undertow]
|
[kit.edge.server.undertow]
|
||||||
[pmagnus.btcprice.web.handler]
|
[pmagnus.btcprice.web.handler]
|
||||||
;; Routes
|
;; Routes
|
||||||
[pmagnus.btcprice.web.routes.api]
|
[pmagnus.btcprice.web.routes.api]
|
||||||
[pmagnus.btcprice.web.routes.ui]
|
[pmagnus.btcprice.web.routes.ui]
|
||||||
;; WebSocket clients
|
[pmagnus.btcprice.web.routes.ws-proxy])
|
||||||
[pmagnus.btcprice.ws.binance])
|
|
||||||
(:gen-class))
|
(:gen-class))
|
||||||
|
|
||||||
(defonce system (atom nil))
|
(defonce system (atom nil))
|
||||||
|
|||||||
@@ -18,7 +18,8 @@
|
|||||||
[:meta {:name "apple-mobile-web-app-status-bar-style" :content "black-translucent"}]
|
[:meta {:name "apple-mobile-web-app-status-bar-style" :content "black-translucent"}]
|
||||||
[:title (or (:title opts#) "BTC Price")]
|
[:title (or (:title opts#) "BTC Price")]
|
||||||
[:link {:rel "stylesheet" :href "/css/output.css"}]
|
[:link {:rel "stylesheet" :href "/css/output.css"}]
|
||||||
[:script {:src "https://unpkg.com/htmx.org@2.0.8"}]]
|
[:script {:src "https://unpkg.com/htmx.org@2/dist/htmx.min.js"}]
|
||||||
|
[:script {:src "https://unpkg.com/htmx-ext-ws@2/ws.js"}]]
|
||||||
[:body
|
[:body
|
||||||
[:div.mx-auto.max-w-lg.px-4.py-6
|
[:div.mx-auto.max-w-lg.px-4.py-6
|
||||||
~@content]]]))}))
|
~@content]]]))}))
|
||||||
|
|||||||
@@ -2,8 +2,18 @@
|
|||||||
(:require
|
(:require
|
||||||
[ring.middleware.defaults :as defaults]))
|
[ring.middleware.defaults :as defaults]))
|
||||||
|
|
||||||
|
(defn- wrap-nil-guard
|
||||||
|
"Discard responses with no :status — these are artifacts of ring-defaults
|
||||||
|
middleware wrapping a nil response (e.g., from a raw WebSocket upgrade).
|
||||||
|
Passes through :undertow/websocket responses for the adapter to handle."
|
||||||
|
[handler]
|
||||||
|
(fn [request]
|
||||||
|
(let [resp (handler request)]
|
||||||
|
(when (or (:status resp) (:undertow/websocket resp)) resp))))
|
||||||
|
|
||||||
(defn wrap-base [{:keys [site-defaults-config]}]
|
(defn wrap-base [{:keys [site-defaults-config]}]
|
||||||
(fn [handler]
|
(fn [handler]
|
||||||
(cond-> handler
|
(-> handler
|
||||||
true (defaults/wrap-defaults
|
(defaults/wrap-defaults
|
||||||
(or site-defaults-config defaults/site-defaults)))))
|
(or site-defaults-config defaults/site-defaults))
|
||||||
|
(wrap-nil-guard))))
|
||||||
|
|||||||
@@ -8,8 +8,7 @@
|
|||||||
[reitit.ring.coercion :as coercion]
|
[reitit.ring.coercion :as coercion]
|
||||||
[reitit.ring.middleware.muuntaja :as muuntaja]
|
[reitit.ring.middleware.muuntaja :as muuntaja]
|
||||||
[reitit.ring.middleware.parameters :as parameters]
|
[reitit.ring.middleware.parameters :as parameters]
|
||||||
[reitit.swagger :as swagger]
|
[reitit.swagger :as swagger]))
|
||||||
[reitit.swagger-ui :as swagger-ui]))
|
|
||||||
|
|
||||||
(defn- api-routes [_opts]
|
(defn- api-routes [_opts]
|
||||||
[["/swagger.json"
|
[["/swagger.json"
|
||||||
|
|||||||
@@ -1,40 +1,35 @@
|
|||||||
(ns pmagnus.btcprice.web.routes.ui
|
(ns pmagnus.btcprice.web.routes.ui
|
||||||
(:require
|
(:require
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[pmagnus.btcprice.web.htmx :refer [page fragment]]
|
[pmagnus.btcprice.web.htmx :refer [page]]
|
||||||
[pmagnus.btcprice.web.middleware.exception :as exception]
|
[pmagnus.btcprice.web.middleware.exception :as exception]
|
||||||
[pmagnus.btcprice.web.middleware.formats :as formats]
|
[pmagnus.btcprice.web.middleware.formats :as formats]
|
||||||
[reitit.ring.middleware.muuntaja :as muuntaja]
|
[reitit.ring.middleware.muuntaja :as muuntaja]
|
||||||
[reitit.ring.middleware.parameters :as parameters]))
|
[reitit.ring.middleware.parameters :as parameters]))
|
||||||
|
|
||||||
(defn home-page [_req]
|
(defn- home-page [_opts _req]
|
||||||
(page {:title "BTC Price"}
|
(page {:title "BTC Price"}
|
||||||
[:header.text-center.mb-8
|
[:header.text-center.mb-8
|
||||||
[:h1.text-3xl.font-bold.text-gray-900 "BTC Price"]
|
[:h1.text-3xl.font-bold.text-gray-900 "BTC Price"]
|
||||||
[:p.text-sm.text-gray-500.mt-1 "Bitcoin price tracker"]]
|
[:p.text-sm.text-gray-500.mt-1 "Bitcoin price tracker"]]
|
||||||
|
|
||||||
[:div#price-panel.space-y-4
|
[:div#price-panel {:hx-ext "ws" :ws-connect "/ws/price"}
|
||||||
{:hx-get "/price" :hx-trigger "every 2s" :hx-swap "innerHTML"}
|
[:div#price-display
|
||||||
[:div.bg-white.rounded-2xl.shadow-sm.border.border-gray-200.p-6
|
|
||||||
[:p.text-center.text-gray-400.text-sm "Loading..."]]]))
|
|
||||||
|
|
||||||
(defn price-fragment [{:keys [query-fn]}]
|
|
||||||
(let [row (query-fn :get-latest-binance-price {})]
|
|
||||||
(fragment {}
|
|
||||||
[:div.bg-white.rounded-2xl.shadow-sm.border.border-gray-200.p-6
|
[:div.bg-white.rounded-2xl.shadow-sm.border.border-gray-200.p-6
|
||||||
(if row
|
[:p.text-center.text-gray-400.text-sm "Connecting..."]]]]
|
||||||
[:div.text-center
|
|
||||||
[:p.text-4xl.font-bold.text-gray-900
|
[:div.mt-4 {:hx-ext "ws" :ws-connect "/ws/strike"}
|
||||||
(str "$" (format "%,.2f" (double (:price row))))]
|
[:div#strike-display
|
||||||
[:p.text-xs.text-gray-400.mt-2
|
[:div.bg-white.rounded-2xl.shadow-sm.border.border-gray-200.p-6
|
||||||
(str "Updated " (:recorded_at row))]]
|
[:p.text-center.text-gray-400.text-sm "Loading Strike rates..."]]]]
|
||||||
[:p.text-center.text-gray-400.text-sm "Waiting for data..."])])))
|
|
||||||
|
;; Safelist classes used in btcdata HTML fragments
|
||||||
|
[:div {:class "hidden text-4xl text-2xl font-bold text-green-600 text-red-600 text-gray-900 text-xs text-gray-400 mt-2 flex justify-center justify-between items-center gap-4 mt-1 mt-3 text-sm text-gray-600 text-gray-500 mb-3 py-1 grid grid-cols-2 gap-x-6 gap-y-1"
|
||||||
|
:aria-hidden "true"}]))
|
||||||
|
|
||||||
(defn- ui-routes [opts]
|
(defn- ui-routes [opts]
|
||||||
[["/"
|
[["/"
|
||||||
{:get home-page}]
|
{:get (fn [req] (home-page opts req))}]])
|
||||||
["/price"
|
|
||||||
{:get (fn [_req] (price-fragment opts))}]])
|
|
||||||
|
|
||||||
(defn route-data [opts]
|
(defn route-data [opts]
|
||||||
(merge
|
(merge
|
||||||
|
|||||||
@@ -0,0 +1,159 @@
|
|||||||
|
(ns pmagnus.btcprice.web.routes.ws-proxy
|
||||||
|
(:require
|
||||||
|
[clojure.data.json :as json]
|
||||||
|
[clojure.tools.logging :as log]
|
||||||
|
[integrant.core :as ig])
|
||||||
|
(:import
|
||||||
|
[io.undertow.websockets.core WebSockets WebSocketChannel]
|
||||||
|
[java.net URI]
|
||||||
|
[java.net.http HttpClient WebSocket$Builder WebSocket$Listener]
|
||||||
|
[java.time Instant ZoneId]
|
||||||
|
[java.time.format DateTimeFormatter]
|
||||||
|
[java.util Locale]
|
||||||
|
[java.util.concurrent CompletableFuture]))
|
||||||
|
|
||||||
|
(defn- close-quietly [^WebSocketChannel ch]
|
||||||
|
(when (and ch (.isOpen ch))
|
||||||
|
(try (.close ch) (catch Exception _))))
|
||||||
|
|
||||||
|
(defn- close-upstream-quietly [^java.net.http.WebSocket ws]
|
||||||
|
(when ws
|
||||||
|
(try (.sendClose ws java.net.http.WebSocket/NORMAL_CLOSURE "") (catch Exception _))))
|
||||||
|
|
||||||
|
(defn- connect-upstream
|
||||||
|
"Open a Java HttpClient WebSocket to btcdata, transform each text frame
|
||||||
|
with xf, and send the result to the browser channel."
|
||||||
|
[^String btcdata-ws-url ^WebSocketChannel browser-ch xf]
|
||||||
|
(let [client (HttpClient/newHttpClient)
|
||||||
|
listener (reify java.net.http.WebSocket$Listener
|
||||||
|
(onOpen [_ ws]
|
||||||
|
(.request ws 1))
|
||||||
|
(onText [_ ws data last?]
|
||||||
|
(let [text (str data)]
|
||||||
|
(try
|
||||||
|
(when (and (.isOpen browser-ch) (seq text))
|
||||||
|
(WebSockets/sendTextBlocking (xf text) browser-ch))
|
||||||
|
(catch Exception e
|
||||||
|
(log/debug e "Error forwarding to browser")
|
||||||
|
(close-upstream-quietly ws))))
|
||||||
|
(.request ws 1)
|
||||||
|
(CompletableFuture/completedFuture nil))
|
||||||
|
(onClose [_ _ws status-code _reason]
|
||||||
|
(log/debug "Upstream closed" status-code)
|
||||||
|
(close-quietly browser-ch))
|
||||||
|
(onError [_ _ws error]
|
||||||
|
(log/debug error "Upstream error")
|
||||||
|
(close-quietly browser-ch)))]
|
||||||
|
(-> (.newWebSocketBuilder client)
|
||||||
|
^WebSocket$Builder identity
|
||||||
|
(.buildAsync (URI. btcdata-ws-url) listener)
|
||||||
|
(.join))))
|
||||||
|
|
||||||
|
(defn- ws-handler [btcdata-ws-url xf _req]
|
||||||
|
(let [upstream-atom (atom nil)]
|
||||||
|
{:undertow/websocket
|
||||||
|
{:on-open
|
||||||
|
(fn [{:keys [^WebSocketChannel channel]}]
|
||||||
|
(log/info "Browser connected, proxying to" btcdata-ws-url)
|
||||||
|
(reset! upstream-atom (connect-upstream btcdata-ws-url channel xf)))
|
||||||
|
:on-close-message
|
||||||
|
(fn [_]
|
||||||
|
(log/debug "Browser closed")
|
||||||
|
(close-upstream-quietly @upstream-atom))}}))
|
||||||
|
|
||||||
|
;; --- Price rendering ---
|
||||||
|
|
||||||
|
(def ^:private ts-fmt (DateTimeFormatter/ofPattern "dd-MM HH:mm:ss"))
|
||||||
|
(def ^:private da-locale (Locale. "da" "DK"))
|
||||||
|
|
||||||
|
(defn- da-fmt [fmt val]
|
||||||
|
(String/format da-locale fmt (into-array Object [val])))
|
||||||
|
|
||||||
|
(defn- price-json->html [text]
|
||||||
|
(let [{:strs [price prev_price recorded_at
|
||||||
|
price_eur price_dkk]} (json/read-str text)
|
||||||
|
p (double (bigdec price))
|
||||||
|
pp (when prev_price (double (bigdec prev_price)))
|
||||||
|
color (cond
|
||||||
|
(nil? pp) "text-gray-900"
|
||||||
|
(> p pp) "text-green-600"
|
||||||
|
(< p pp) "text-red-600"
|
||||||
|
:else "text-gray-900")
|
||||||
|
ts (.format (.atZone (Instant/parse recorded_at) (ZoneId/systemDefault)) ts-fmt)]
|
||||||
|
(str "<div id=\"price-display\">"
|
||||||
|
"<div class=\"bg-white rounded-2xl shadow-sm border border-gray-200 p-6\">"
|
||||||
|
"<div class=\"text-center\">"
|
||||||
|
"<p class=\"text-4xl font-bold " color "\">$" (da-fmt "%,.2f" p) "</p>"
|
||||||
|
(when price_eur
|
||||||
|
(let [p-eur (double (bigdec price_eur))
|
||||||
|
p-dkk (double (bigdec price_dkk))
|
||||||
|
eur (/ p-eur p)
|
||||||
|
dkk (/ p-dkk p)]
|
||||||
|
(str "<div class=\"flex justify-center gap-4 mt-3\">"
|
||||||
|
"<span class=\"text-2xl font-bold text-gray-600\">\u20AC" (da-fmt "%,.0f" p-eur) "</span>"
|
||||||
|
"<span class=\"text-2xl font-bold text-gray-600\">" (da-fmt "%,.0f" p-dkk) " kr</span>"
|
||||||
|
"</div>"
|
||||||
|
"<div class=\"flex justify-center gap-4 mt-1\">"
|
||||||
|
"<span class=\"text-xs text-gray-400\">EUR/USD " (da-fmt "%.4f" eur) "</span>"
|
||||||
|
"<span class=\"text-xs text-gray-400\">DKK/USD " (da-fmt "%.4f" dkk) "</span>"
|
||||||
|
"</div>")))
|
||||||
|
"<p class=\"text-xs text-gray-400 mt-2\">Updated " ts "</p>"
|
||||||
|
"</div></div></div>")))
|
||||||
|
|
||||||
|
;; --- Strike rendering ---
|
||||||
|
|
||||||
|
(def ^:private strike-pairs
|
||||||
|
[["BTC/USDT" "$"]
|
||||||
|
["BTC/EUR" "\u20AC"]
|
||||||
|
["USDT/EUR" ""]
|
||||||
|
["EUR/BTC" ""]])
|
||||||
|
|
||||||
|
(defn- format-strike-amount [prefix amount]
|
||||||
|
(if amount
|
||||||
|
(let [v (double (bigdec amount))]
|
||||||
|
(case prefix
|
||||||
|
"$" (str prefix (da-fmt "%,.2f" v))
|
||||||
|
"\u20AC" (str prefix (da-fmt "%,.2f" v))
|
||||||
|
amount))
|
||||||
|
"\u2014"))
|
||||||
|
|
||||||
|
(defn- strike-json->html [text]
|
||||||
|
(let [rates (json/read-str text)
|
||||||
|
sats (get rates "quote-sats")]
|
||||||
|
(str "<div id=\"strike-display\">"
|
||||||
|
"<div class=\"rounded-2xl shadow-sm border border-gray-200 p-6\" style=\"background:#f3f4f6;\">"
|
||||||
|
(if sats
|
||||||
|
(str "<p class=\"text-center text-2xl font-bold mb-3\" style=\"color:#1e3a5f;\">"
|
||||||
|
(da-fmt "%,d" sats) " <span style=\"color:#1e3a5f;\">sats</span></p>")
|
||||||
|
"")
|
||||||
|
"<div style=\"display:grid;grid-template-columns:1fr;row-gap:0.25rem;\">"
|
||||||
|
(apply str
|
||||||
|
(for [[pair prefix] strike-pairs
|
||||||
|
:let [amount (get rates pair)]]
|
||||||
|
(str "<div style=\"display:flex;justify-content:space-between;align-items:center;padding:0.25rem 0;\">"
|
||||||
|
"<span class=\"text-sm text-gray-500\">" pair "</span>"
|
||||||
|
"<span class=\"text-sm font-bold text-gray-900\">"
|
||||||
|
(format-strike-amount prefix amount)
|
||||||
|
"</span></div>")))
|
||||||
|
"</div></div></div>")))
|
||||||
|
|
||||||
|
;; --- Routes ---
|
||||||
|
|
||||||
|
(defn- ws-proxy-routes [{:keys [btcdata-url]}]
|
||||||
|
(let [ws-base (str (.replaceFirst ^String btcdata-url "^http" "ws"))]
|
||||||
|
[["/ws/price"
|
||||||
|
{:get (fn [req] (ws-handler (str ws-base "/api/price/ws") price-json->html req))
|
||||||
|
:no-doc true
|
||||||
|
:middleware []}]
|
||||||
|
["/ws/strike"
|
||||||
|
{:get (fn [req] (ws-handler (str ws-base "/api/strike/ws") strike-json->html req))
|
||||||
|
:no-doc true
|
||||||
|
:middleware []}]]))
|
||||||
|
|
||||||
|
(derive :reitit.routes/ws-proxy :reitit/routes)
|
||||||
|
|
||||||
|
(defmethod ig/init-key :reitit.routes/ws-proxy
|
||||||
|
[_ {:keys [base-path]
|
||||||
|
:or {base-path ""}
|
||||||
|
:as opts}]
|
||||||
|
[base-path {} (ws-proxy-routes opts)])
|
||||||
@@ -1,85 +0,0 @@
|
|||||||
(ns pmagnus.btcprice.ws.binance
|
|
||||||
(:require
|
|
||||||
[clojure.data.json :as json]
|
|
||||||
[clojure.tools.logging :as log]
|
|
||||||
[integrant.core :as ig])
|
|
||||||
(:import
|
|
||||||
[java.net URI]
|
|
||||||
[java.net.http HttpClient WebSocket WebSocket$Listener]
|
|
||||||
[java.util.concurrent CompletableFuture CompletionStage]))
|
|
||||||
|
|
||||||
(defn- save-price! [query-fn price]
|
|
||||||
(try
|
|
||||||
(query-fn :insert-binance-price! {:price price})
|
|
||||||
(catch Exception e
|
|
||||||
(log/error e "Failed to save BTC price"))))
|
|
||||||
|
|
||||||
(defn- connect!
|
|
||||||
"Opens a WebSocket to Binance trade stream and returns the WebSocket instance.
|
|
||||||
`state` is an atom with keys :running?, :last-write, :buffer."
|
|
||||||
[uri query-fn state]
|
|
||||||
(let [client (HttpClient/newHttpClient)
|
|
||||||
listener (reify WebSocket$Listener
|
|
||||||
(onOpen [_ ws]
|
|
||||||
(log/info "Binance WebSocket connected")
|
|
||||||
(.request ws 1))
|
|
||||||
|
|
||||||
(onText [_ ws data last?]
|
|
||||||
(let [buf (:buffer @state)]
|
|
||||||
(.append buf data)
|
|
||||||
(when last?
|
|
||||||
(let [text (str buf)]
|
|
||||||
(.setLength buf 0)
|
|
||||||
(try
|
|
||||||
(let [msg (json/read-str text :key-fn keyword)
|
|
||||||
price (some-> (:p msg) bigdec)]
|
|
||||||
(when price
|
|
||||||
(let [now (System/currentTimeMillis)]
|
|
||||||
(when (> (- now (:last-write @state)) 5000)
|
|
||||||
(swap! state assoc :last-write now)
|
|
||||||
(log/info "BTC price:" (str price))
|
|
||||||
(save-price! query-fn price)))))
|
|
||||||
(catch Exception e
|
|
||||||
(log/error e "Failed to parse Binance message")))))
|
|
||||||
(let [^CompletionStage cf (CompletableFuture/completedFuture nil)]
|
|
||||||
(.request ws 1)
|
|
||||||
cf)))
|
|
||||||
|
|
||||||
(onClose [_ _ws code reason]
|
|
||||||
(log/warn "Binance WebSocket closed:" code reason)
|
|
||||||
(when (:running? @state)
|
|
||||||
(future
|
|
||||||
(Thread/sleep 3000)
|
|
||||||
(when (:running? @state)
|
|
||||||
(log/info "Reconnecting to Binance...")
|
|
||||||
(try
|
|
||||||
(let [ws (connect! uri query-fn state)]
|
|
||||||
(swap! state assoc :ws ws))
|
|
||||||
(catch Exception e
|
|
||||||
(log/error e "Binance reconnect failed")))))))
|
|
||||||
|
|
||||||
(onError [_ _ws error]
|
|
||||||
(log/error error "Binance WebSocket error")))]
|
|
||||||
(-> (.newWebSocketBuilder client)
|
|
||||||
(.buildAsync (URI. uri) listener)
|
|
||||||
(.join))))
|
|
||||||
|
|
||||||
(defmethod ig/init-key :ws/binance
|
|
||||||
[_ {:keys [query-fn uri]}]
|
|
||||||
(log/info "Starting Binance WebSocket listener:" uri)
|
|
||||||
(let [state (atom {:running? true
|
|
||||||
:last-write 0
|
|
||||||
:buffer (StringBuilder.)
|
|
||||||
:ws nil})
|
|
||||||
ws (connect! uri query-fn state)]
|
|
||||||
(swap! state assoc :ws ws)
|
|
||||||
state))
|
|
||||||
|
|
||||||
(defmethod ig/halt-key! :ws/binance
|
|
||||||
[_ state]
|
|
||||||
(log/info "Stopping Binance WebSocket listener")
|
|
||||||
(swap! state assoc :running? false)
|
|
||||||
(when-let [ws (:ws @state)]
|
|
||||||
(try
|
|
||||||
(.sendClose ws WebSocket/NORMAL_CLOSURE "shutting down")
|
|
||||||
(catch Exception _))))
|
|
||||||
Reference in New Issue
Block a user