Something went wrong. Try again.
Nothing to see here yet...
Something went wrong. Try again.
16 kB · 368 lines
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369#lang racket/base
(require racket/contract/base rebellion/base/comparator)
(provide (contract-out [epoch timestamp?] [timestamp? (-> any/c boolean?)] [timestamp<=> (comparator/c timestamp?)] [rfc3339-string? (-> any/c boolean?)] [timestamp->rfc3339-string (-> timestamp? rfc3339-string?)] [rfc3339-string->timestamp (-> rfc3339-string? timestamp?)] [timestamp->epoch-seconds (-> timestamp? real?)] [epoch-seconds->timestamp (-> real? timestamp?)] [timestamp->epoch-milliseconds (-> timestamp? real?)] [epoch-milliseconds->timestamp (-> real? timestamp?)]))
(require racket/date racket/list racket/math)
(struct timestamp (seconds-component nanoseconds-component) #:transparent)
(define epoch (timestamp 0 0))
(define (timestamp->epoch-seconds ts) (+ (timestamp-seconds-component ts) (nanoseconds->seconds (timestamp-nanoseconds-component ts))))
(define (epoch-seconds->timestamp secs) (define secs-part (exact-floor secs)) (define nanos-part (exact-floor (seconds->nanoseconds (- secs secs-part)))) (timestamp secs-part nanos-part))
(define (timestamp->epoch-milliseconds ts) (+ (seconds->milliseconds (timestamp-seconds-component ts)) (nanoseconds->milliseconds (timestamp-nanoseconds-component ts))))
(define (epoch-milliseconds->timestamp ms) (define secs-part (exact-floor (milliseconds->seconds ms))) (define nanos-part (exact-floor (- (milliseconds->nanoseconds ms) (seconds->nanoseconds secs-part)))) (timestamp secs-part nanos-part))
;; Compares the components lexicographically rather than converting to a single;; number: both constructors floor the seconds component, so the nanoseconds;; component is always in [0, 1000000000) and comparing it only matters when the;; seconds agree. That keeps the comparison to exact integers.(define timestamp<=> (comparator-chain (comparator-map real<=> timestamp-seconds-component) (comparator-map real<=> timestamp-nanoseconds-component)))
(define (seconds->milliseconds secs) (* secs 1000))
(define (seconds->nanoseconds ns) (* ns 1000000000))
(define (milliseconds->seconds ms) (/ ms 1000))
(define (milliseconds->nanoseconds ms) (* ms 1000000))
(define (nanoseconds->seconds ns) (/ ns 1000000000))
(define (nanoseconds->milliseconds ns) (/ ns 1000000))
;@----------------------------------------------------------------------------------------------------
;; RFC 3339 is the wire format: the lexicons declare these fields as `datetime`,;; which atproto requires to carry a timezone and strongly prefers to be UTC;; with a Z suffix.;;;; Serialization always emits nine fractional digits, zero-padded. The format;; allows any number of them and atproto asks for at least milliseconds, but nine;; is what a timestamp actually holds, so emitting fewer would silently truncate.;; A fixed width also means lexicographic string ordering agrees with;; chronological ordering, which a variable-width fraction would break.(define (timestamp->rfc3339-string ts) (define moment (seconds->date (timestamp-seconds-component ts) #false)) (string-append (pad-digits (date-year moment) 4) "-" (pad-digits (date-month moment) 2) "-" (pad-digits (date-day moment) 2) "T" (pad-digits (date-hour moment) 2) ":" (pad-digits (date-minute moment) 2) ":" (pad-digits (date-second moment) 2) "." (pad-digits (timestamp-nanoseconds-component ts) 9) "Z"))
(define (pad-digits n width) (define digits (number->string n)) (string-append (make-string (max 0 (- width (string-length digits))) #\0) digits))
(define rfc3339-pattern (pregexp (string-append "^([0-9]{4})-([0-9]{2})-([0-9]{2})" "[Tt]" "([0-9]{2}):([0-9]{2}):([0-9]{2})" "(?:\\.([0-9]+))?" "(?:[Zz]|([+-])([0-9]{2}):([0-9]{2}))$")))
(define (rfc3339-string? v) (and (string? v) (parse-rfc3339 v) #true))
(define (rfc3339-string->timestamp str) (parse-rfc3339 str))
;; Returns a timestamp, or #false when the string is not a datetime that a;; timestamp can represent. Both the predicate and the converter go through here,;; so they can never disagree about what counts as valid.(define (parse-rfc3339 str) (define groups (regexp-match rfc3339-pattern str)) (and groups (rfc3339-groups->timestamp groups)))
(define (rfc3339-groups->timestamp groups) (define (field index) (list-ref groups index)) (define (number-field index) (string->number (field index))) (define utc-seconds ;; find-seconds rejects impossible dates such as February 30th, and leap ;; seconds, which POSIX time cannot represent anyway. (with-handlers ([exn:fail? (λ (_) #false)]) (find-seconds (number-field 6) (number-field 5) (number-field 4) (number-field 3) (number-field 2) (number-field 1) #false))) (define offset-seconds (rfc3339-offset-seconds groups)) (and utc-seconds offset-seconds (timestamp (- utc-seconds offset-seconds) (rfc3339-nanoseconds (field 7)))))
;; A numeric offset says how far the written time runs ahead of UTC, so it is;; subtracted to recover the instant. A Z suffix leaves the offset groups;; unmatched, giving an offset of zero. Returns #false for an out-of-range;; offset, which the pattern alone cannot rule out: without the check, an offset;; like +99:99 would quietly yield an instant days away from the one written.(define (rfc3339-offset-seconds groups) (define sign (list-ref groups 8)) (cond [(not sign) 0] [else (define hours (string->number (list-ref groups 9))) (define minutes (string->number (list-ref groups 10))) (and (<= hours 23) (<= minutes 59) (let ([magnitude (+ (* hours 3600) (* minutes 60))]) (if (equal? sign "-") (- magnitude) magnitude)))]))
;; Fractional digits beyond nanosecond precision are dropped rather than rounded,;; since RFC 3339 permits arbitrarily many and a timestamp cannot hold them.(define (rfc3339-nanoseconds fraction) (cond [(not fraction) 0] [else (define digits (if (> (string-length fraction) 9) (substring fraction 0 9) fraction)) (string->number (string-append digits (make-string (- 9 (string-length digits)) #\0)))]))
(module+ test (require racket/list rackunit)
;; Conversions are exact when given exact inputs, so these use exact rationals ;; and integers rather than flonums; check-equal? distinguishes 1.5 from 3/2.
(test-case "the epoch is zero in both units" (check-equal? (timestamp->epoch-seconds epoch) 0) (check-equal? (timestamp->epoch-milliseconds epoch) 0))
(test-case "whole seconds carry no sub-second remainder" (check-equal? (epoch-seconds->timestamp 5) (epoch-milliseconds->timestamp 5000)) (check-equal? (timestamp->epoch-seconds (epoch-seconds->timestamp 5)) 5) (check-equal? (timestamp->epoch-milliseconds (epoch-seconds->timestamp 5)) 5000))
(test-case "fractional seconds become a nanoseconds component" (check-equal? (timestamp->epoch-seconds (epoch-seconds->timestamp 3/2)) 3/2) (check-equal? (timestamp->epoch-milliseconds (epoch-seconds->timestamp 3/2)) 1500))
(test-case "seconds conversions round-trip" (for ([secs (in-list (list 0 1 3/2 9/4 -3/2 1234567))]) (check-equal? (timestamp->epoch-seconds (epoch-seconds->timestamp secs)) secs)))
(test-case "whole milliseconds below a second become a nanoseconds component" (check-equal? (timestamp->epoch-milliseconds (epoch-milliseconds->timestamp 500)) 500) (check-equal? (timestamp->epoch-seconds (epoch-milliseconds->timestamp 500)) 1/2))
(test-case "milliseconds conversions round-trip" (for ([ms (in-list (list 0 1000 1500 2250 -1500 1234567))]) (check-equal? (timestamp->epoch-milliseconds (epoch-milliseconds->timestamp ms)) ms)))
(test-case "the seconds and milliseconds conversions agree" (for ([ms (in-list (list 0 1000 1500 2250 -1500))]) (check-equal? (epoch-milliseconds->timestamp ms) (epoch-seconds->timestamp (/ ms 1000)))))
(test-case "times before the epoch keep a non-negative nanoseconds component" ;; The seconds component floors, so sub-second offsets are always counted ;; forward from it. -3/2 seconds is two seconds before the epoch plus half ;; a second, not one second before minus half. (check-equal? (epoch-seconds->timestamp -3/2) (epoch-milliseconds->timestamp -1500)) (check-equal? (timestamp->epoch-milliseconds (epoch-seconds->timestamp -3/2)) -1500))
(test-case "timestamp? recognizes timestamps and nothing else" (check-true (timestamp? epoch)) (check-true (timestamp? (epoch-seconds->timestamp 1))) (check-false (timestamp? 0)) (check-false (timestamp? "1970-01-01T00:00:00Z")) (check-false (timestamp? #false)))
(test-case "timestamp<=> orders by whole seconds" (check-equal? (compare timestamp<=> (epoch-seconds->timestamp 1) (epoch-seconds->timestamp 2)) lesser) (check-equal? (compare timestamp<=> (epoch-seconds->timestamp 2) (epoch-seconds->timestamp 1)) greater))
(test-case "timestamp<=> breaks ties on the nanoseconds component" (check-equal? (compare timestamp<=> (epoch-milliseconds->timestamp 1250) (epoch-milliseconds->timestamp 1750)) lesser) (check-equal? (compare timestamp<=> (epoch-milliseconds->timestamp 1750) (epoch-milliseconds->timestamp 1250)) greater))
(test-case "timestamp<=> considers equal timestamps equivalent" (check-equal? (compare timestamp<=> epoch epoch) equivalent) (check-equal? (compare timestamp<=> (epoch-seconds->timestamp 3/2) (epoch-milliseconds->timestamp 1500)) equivalent))
(test-case "timestamp<=> orders times before the epoch correctly" ;; The seconds component floors, so -3/2 seconds is (timestamp -2 500000000). ;; Comparing components naively would be wrong if nanoseconds could be ;; negative, which is why the conversions normalize them. (check-equal? (compare timestamp<=> (epoch-seconds->timestamp -3/2) epoch) lesser) (check-equal? (compare timestamp<=> (epoch-seconds->timestamp -3/2) (epoch-seconds->timestamp -1/2)) lesser) (check-equal? (compare timestamp<=> (epoch-seconds->timestamp -1/2) (epoch-seconds->timestamp 1/2)) lesser))
(test-case "timestamp<=> agrees with comparing epoch seconds" (define moments (list (epoch-seconds->timestamp -3/2) (epoch-milliseconds->timestamp -1) epoch (epoch-milliseconds->timestamp 1) (epoch-milliseconds->timestamp 1250) (epoch-seconds->timestamp 3/2) (epoch-seconds->timestamp 1234567))) (for* ([left (in-list moments)] [right (in-list moments)]) (check-equal? (compare timestamp<=> left right) (compare real<=> (timestamp->epoch-seconds left) (timestamp->epoch-seconds right)))))
(test-case "timestamp<=> sorts a shuffled sequence into chronological order" (define sorted (list (epoch-seconds->timestamp -3/2) epoch (epoch-milliseconds->timestamp 500) (epoch-seconds->timestamp 1) (epoch-seconds->timestamp 3/2))) (check-equal? (sort (shuffle sorted) (λ (a b) (equal? (compare timestamp<=> a b) lesser))) sorted)) (test-case "timestamp->rfc3339-string writes UTC with a Z suffix" (check-equal? (timestamp->rfc3339-string epoch) "1970-01-01T00:00:00.000000000Z") (check-equal? (timestamp->rfc3339-string (epoch-seconds->timestamp 1785476330)) "2026-07-31T05:38:50.000000000Z"))
(test-case "timestamp->rfc3339-string always pads to nanosecond precision" ;; Fixed width keeps lexicographic string order agreeing with chronological ;; order, which a variable-length fraction would break. (check-equal? (timestamp->rfc3339-string (epoch-milliseconds->timestamp 1500)) "1970-01-01T00:00:01.500000000Z") (check-equal? (string-length (timestamp->rfc3339-string epoch)) (string-length (timestamp->rfc3339-string (epoch-milliseconds->timestamp 1500)))))
(test-case "timestamp->rfc3339-string writes times before the epoch" (check-equal? (timestamp->rfc3339-string (epoch-seconds->timestamp -1/2)) "1969-12-31T23:59:59.500000000Z"))
(test-case "rfc3339-string->timestamp reads whole seconds" (check-equal? (rfc3339-string->timestamp "2026-07-31T05:38:50Z") (epoch-seconds->timestamp 1785476330)))
(test-case "rfc3339-string->timestamp pads fractional digits to nanoseconds" (check-equal? (rfc3339-string->timestamp "1970-01-01T00:00:00.5Z") (epoch-milliseconds->timestamp 500)) (check-equal? (rfc3339-string->timestamp "1970-01-01T00:00:00.500Z") (epoch-milliseconds->timestamp 500)))
(test-case "rfc3339-string->timestamp drops precision finer than nanoseconds" (check-equal? (rfc3339-string->timestamp "1970-01-01T00:00:00.1234567891Z") (rfc3339-string->timestamp "1970-01-01T00:00:00.123456789Z")))
(test-case "rfc3339-string->timestamp converts a numeric offset to UTC" ;; A positive offset means the written time runs ahead of UTC. (check-equal? (rfc3339-string->timestamp "2026-07-31T07:38:50+02:00") (rfc3339-string->timestamp "2026-07-31T05:38:50Z")) (check-equal? (rfc3339-string->timestamp "2026-07-31T03:38:50-02:00") (rfc3339-string->timestamp "2026-07-31T05:38:50Z")))
(test-case "rfc3339-string->timestamp accepts a lowercase t and z" (check-equal? (rfc3339-string->timestamp "2026-07-31t05:38:50z") (rfc3339-string->timestamp "2026-07-31T05:38:50Z")))
(test-case "the converters round-trip" (for ([ts (in-list (list epoch (epoch-seconds->timestamp 1785476330) (epoch-milliseconds->timestamp 1500) (epoch-seconds->timestamp -1/2) (epoch-seconds->timestamp -1234567)))]) (check-equal? (rfc3339-string->timestamp (timestamp->rfc3339-string ts)) ts)))
(test-case "rfc3339-string? rejects malformed and impossible datetimes" (check-true (rfc3339-string? "2026-07-31T05:38:50Z")) (check-true (rfc3339-string? "2026-07-31T05:38:50.123Z")) (check-false (rfc3339-string? "2026-02-30T00:00:00Z")) (check-false (rfc3339-string? "2026-13-01T00:00:00Z")) (check-false (rfc3339-string? "2026-07-31T05:38:60Z")) (check-false (rfc3339-string? "2026-07-31T05:38:50")) (check-false (rfc3339-string? "2026-07-31 05:38:50Z")) (check-false (rfc3339-string? "2026-07-31T05:38:50+99:99")) (check-false (rfc3339-string? "2026-07-31T05:38:50+24:00")) (check-false (rfc3339-string? "2026-07-31T05:38:50+00:60")) (check-true (rfc3339-string? "2026-07-31T05:38:50+23:59")) (check-false (rfc3339-string? "not a datetime")) (check-false (rfc3339-string? 0)))
(test-case "string order of the written form matches chronological order" (define moments (list (epoch-seconds->timestamp -1/2) epoch (epoch-milliseconds->timestamp 500) (epoch-seconds->timestamp 1) (epoch-seconds->timestamp 1785476330))) (for* ([left (in-list moments)] [right (in-list moments)]) (check-equal? (string<? (timestamp->rfc3339-string left) (timestamp->rfc3339-string right)) (equal? (compare timestamp<=> left right) lesser)))))