#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)))))