Skip to content

Instantly share code, notes, and snippets.

@zentrope
Created November 26, 2020 18:56
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save zentrope/40e2d503742be86637fc39f156305a68 to your computer and use it in GitHub Desktop.
Save zentrope/40e2d503742be86637fc39f156305a68 to your computer and use it in GitHub Desktop.
Incomplete token registry service in Racket Lang
#lang racket
(require db)
(require web-server/servlet)
(require web-server/servlet-env)
(require web-server/managers/none)
(define auth-token "3d99fd86-f62b-4583-a14c-e1151b093569")
(define db-name "register.sqlite")
;; ----------------------------------------------------------------------------
;; Database
;; ----------------------------------------------------------------------------
(define db-conn
(virtual-connection
(connection-pool
(lambda () (sqlite3-connect #:database db-name #:mode 'create)))))
(define (init-database)
(query-exec db-conn "create table if not exists tokens (
created datetime not null default current_timestamp,
token text not null unique)"))
(define (find-tokens)
(let ((data (query-list db-conn "select token from tokens")))
(map (lambda (d) `#hasheq((token . ,d))) data)))
(define (upsert-token token)
(query-exec db-conn "insert into tokens (token) values (?)
on conflict(token) do update
set created = datetime('now')" token))
(define (delete-token token)
(query-exec db-conn "delete from tokens where token=?" token))
;; ----------------------------------------------------------------------------
;; Request Helpers
;; ----------------------------------------------------------------------------
(define (not-found request)
(let ((msg (format "~a not found" (url->string (request-uri request)))))
(response/jsexpr `#hasheq((error . "not-found")
(reason . ,msg))
#:code 404)))
(define (response/error status code reason)
(response/jsexpr `#hasheq((error . ,code) (reason . ,reason)) #:code status))
;; ----------------------------------------------------------------------------
;; Request Endpoints
;; ----------------------------------------------------------------------------
(define (registration/create request)
(response/error 501 "not-implemented" "Just learning."))
(define (registration/delete request token)
(response/error 501 "not-implemented" "Should this be?"))
(define (registration/list request)
(response/jsexpr (find-tokens)))
;; ----------------------------------------------------------------------------
(define-values (service-dispatch service-url)
(dispatch-rules
(("registration" (string-arg)) #:method "delete" registration/delete)
(("registration") #:method "post" registration/create)
(("registration") #:method "get" registration/list)
(else not-found)))
(define (the-service request)
(service-dispatch request))
;; ----------------------------------------------------------------------------
(define (main)
(init-database)
(serve/servlet the-service
#:stateless? #t
#:manager (create-none-manager #f)
#:port 8000
#:launch-browser? #f
#:listen-ip "127.0.0.1" ;; use #f to listen on public interfaces
#:servlet-regexp #rx""))
(main)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment