(define-module (simulation)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-69)
  #:use-module (ice-9 atomic)
  #:use-module (ice-9 match)
  #:use-module (fibers)
  #:use-module (fibers channels)
  #:use-module (fibers timers))

(define RX1 1) ; s (has to be between 1-15s)
(define RX2 (1+ RX1)) ; s
(define RECEIVE_DELAY1 1) ; s
(define RECEIVE_DELAY2 (1+ RECEIVE_DELAY1)) ; s
(define RETRANSMISSION_DELAY 2) ; s
;; From RP002 (Regional Parameters):
;; MAC commands exist in the LoRaWAN® specification to change the value of
;; RECEIVE_DELAY1 (using RXTimingSetupReq, RXTimingSetupAns) as well as
;; ADR_ACK_LIMIT and ADR_ACK_DELAY (using ADRParamSetupReq, ADRParamSetupAns).
;; Also, RXTimingSettings are transmitted to the end device along with the
;; JOIN_ACCEPT message in OTAA mode.

;; TODO: put a time limit as a parameter
(define-syntax-rule (forever exp ...)
  (let loop ()
    (begin exp ...)
    (loop)))

;; Synchronized logger
(define *output-channel* (make-channel))
(define (logger)
  (forever
    (let ((msg (get-message *output-channel*)))
      (display msg))))

(define (ll f . data)
  (let ((now (gettimeofday)))
    (spawn-fiber
      (lambda ()
        (put-message
          *output-channel*
          (format #f "~d~6'0d - ~?~%" (car now) (cdr now) f data))))))


;; For End-Device <--> Radio <--> Gateway
;; type can be:
;; '[up/down]link-start
;; '[up/down]link-end
;; 'interference
(define-record-type <radio-event>
  (make-radio-event type channel-n frame)
  radio-event?
  (type radio-event-type)
  (channel-n radio-event-channel-n)
  (frame radio-event-frame))

;; For Gateway <--> Network Server
(define-record-type <network-event>
  (make-network-event gateway-id frame)
  network-event?
  (gateway-id network-event-gateway-id)
  (frame network-event-frame))

;; body can be:
;; 'unconfirmed-data (uplink)
;; 'confirmed-data (uplink)
;; 'ack (downlink)
(define-record-type <frame>
  (make-frame FCnt DeviceAddr mac-commands body)
  frame?

  (FCnt frame-FCnt)
  (DeviceAddr frame-DeviceAddr)

  (mac-commands frame-mac-commands)
  (body frame-body))


(define-record-type <device>
  (make-device channel thunk)
  device?
  (channel device-channel)
  (thunk device-thunk))

(define (rand-time)
  (random 2.))

(define (make-class-a id initial-channel upstream-chn downstream-chn)
  ;; Make all atomic
  (define channel initial-channel)

  ;; TODO: Unhardcode me
  (define time-on-air 0.01)
  (define to-confirm (make-atomic-box #f))
  (define NbTrans 3)
  (define Cu 0)
  (define Cd 0)

  (define retransmissions NbTrans) ;; decrement in each transmission

  ;; Handle the receive windows
  (define listening? (make-atomic-box #f))
  (define (start-listening!)
    (ll "Device ~a started listening" id)
    (atomic-box-set! listening? #t))
  (define (stop-listening!)
    (ll "Device ~a stopped listening" id)
    (atomic-box-set! listening? #f))
  (define (im-listening?)
    (atomic-box-ref listening?))

  (define (confirm frame-FCnt)
    (when  (eq? frame-FCnt (atomic-box-compare-and-swap! to-confirm frame-FCnt #f))
      (spawn-fiber
        (lambda () "confirm confirmation frame"))))

  (define (send-uplink-frame frame-number device-addr confirmed?)
    (let* ((frame (make-frame
                    frame-number
                    id
                    '()
                    (if confirmed? 'confirmed-data 'unconfirmed-data))))
      (when confirmed?
        (atomic-box-compare-and-swap! to-confirm #f frame-number))
      (put-message upstream-chn (make-radio-event 'uplink-start channel frame))
      (sleep time-on-air)
      (put-message upstream-chn (make-radio-event 'uplink-end channel frame))))

  (define (upstream)
    (define current-frame 0)
    (forever
      (when (eq? #f (atomic-box-ref to-confirm))
        (ll "Device ~a waiting for data" id)
        (sleep (rand-time))) ;; wait for more data
      (send-uplink-frame current-frame id #t)
      (set! current-frame (1+ current-frame)) ;; TODO: fix
      (sleep RECEIVE_DELAY1)
      (start-listening!)
      (sleep RX1)
      (stop-listening!)
      (when (atomic-box-ref to-confirm)
        (sleep (- RECEIVE_DELAY2 RECEIVE_DELAY1 RX1))
        (start-listening!)
        (sleep RX2)
        (stop-listening!))))

  (define (downstream)
    (forever
      (let ((msg (get-message downstream-chn)))
        (when (im-listening?)
          (match (frame-body msg)
            ('ack (confirm (frame-FCnt msg))))))))

  (lambda ()
    (spawn-fiber upstream)
    (spawn-fiber downstream)))

(define (make-gateway id upstream downstream)
  (define time-on-air 0.01) ;s (TODO)
  (define pending-interferences '())

  (define (forward-frame x)
    (ll "forwarding ~a" x))

  ;; Upstream: listen, and answer in new fibers
  (lambda ()
    (forever
      (let* ((ev (get-message upstream)))
        (match ev
          (($ <radio-event> 'uplink-start channel-n frame) #f)
          (($ <radio-event> 'interference channel-n frame)
           (set! pending-interferences (cons ev pending-interferences)))
          (($ <radio-event> 'uplink-end channel-n frame)
           (let-values (((mine not-mine)
                         (partition (lambda (x) (eq? (radio-event-frame x)
                                                     (radio-event-frame ev)))
                                    pending-interferences)))
             (set! pending-interferences not-mine)
             (when (null? mine) ;; TODO
               (forward-frame frame)))))))))


(define (make-radio in end-devices gateways)
  "Fiber for radio resource allocation/control."

  ;; We can access it only from one fiber! Careful!
  (define lorawan-channels (make-hash-table))
  (define (interferences ev chn)
    (let ((res (hash-table-ref/default lorawan-channels chn '())))
      (if (equal? res (list ev)) '() res)))
  (define (use-lorawan-channel! chn start-event)
    (hash-table-update!/default lorawan-channels chn
                        (lambda (event-list)
                          (cons start-event event-list))
                        '()))
  (define (release-lorawan-channel! chn end-event)
    (hash-table-update! lorawan-channels chn
      (lambda (event-list)
        ;; what if we have more than one?
        ;; is that possible?
        (remove! (lambda (x) (eq? (radio-event-frame x)
                                  (radio-event-frame end-event)))
                 event-list))))
  (define (radio-event->interference ev)
    "Make a new radio-event of type 'interference from another radio-event"
    (match ev
      (($ <radio-event> type channel-n frame)
       (make-radio-event 'interference channel-n frame))))

  (lambda ()
    (forever
      (let ((ev (get-message in)))
        (match ev
          (($ <radio-event> 'uplink-start channel-n frame)
           (ll "Device ~a started uplink-frame #~a on channel ~a"
               (frame-DeviceAddr frame)
               (frame-FCnt frame)
               channel-n)
           (use-lorawan-channel! channel-n ev)
           (let ((ints (interferences ev channel-n)))
             (hash-table-walk gateways
               (lambda (k gateway)
                 (spawn-fiber
                   (lambda ()
                     (put-message (device-channel gateway) ev)
                     (for-each
                       (lambda (ev)
                         (ll "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA")
                         (put-message (device-channel gateway)
                                      (radio-event->interference ev)))
                       ints)))))))

          (($ <radio-event> 'downlink-start channel-n frame)
           (ll "Device ~a started downlink-frame #~a on channel ~a"
               (frame-DeviceAddr frame)
               (frame-FCnt frame)
               channel-n)
           (use-lorawan-channel! channel-n ev)
           (let ((chan (hash-table-ref end-devices
                                       (frame-DeviceAddr frame)))
                 (ints (interferences ev channel-n)))
             (put-message chan ev)
             (for-each
               (lambda (ev)
                 (ll "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA")
                 (put-message chan (radio-event->interference ev)))
               ints)))

          (($ <radio-event> 'uplink-end channel-n frame)
           (ll "Device ~a ended uplink-frame #~a on channel ~a"
               (frame-DeviceAddr frame)
               (frame-FCnt frame)
               channel-n)
           (release-lorawan-channel! channel-n ev)
           (hash-table-walk gateways
             (lambda (k gateway)
               (spawn-fiber
                 (lambda ()
                   (put-message (device-channel gateway) ev))))))

          (($ <radio-event> 'downlink-end channel-n frame)
           (ll "Device ~a ended uplink-frame #~a on channel ~a"
               (frame-DeviceAddr frame)
               (frame-FCnt frame)
               channel-n)
           (release-lorawan-channel! channel-n ev)
           (put-message
             (device-channel (hash-table-ref end-devices
                                             (frame-DeviceAddr frame)))
             ev)))))))


(define (make-network-server upstream gateways end-devices)

  (lambda ()
    (forever
      (match (ev (get-message upstream))
        (($ <network-event> gateway-id frame) #f)))))



(define (run-simulation)
  ;; We need a synchronized logger running in a fiber
  (spawn-fiber logger)

  (let* ((radio-chn   (make-channel))
         (end-devices (make-hash-table))
         (gateways    (make-hash-table)))

    (for-each
      (lambda (id)
        (let ((chn (make-channel)))
          (hash-table-set!
            end-devices id
            (make-device chn (make-class-a id 1 radio-chn chn)))))
      (iota 1))

    (for-each
      (lambda (id)
        (let ((chn (make-channel)))
          (hash-table-set!
            gateways id
            (make-device chn (make-gateway id chn radio-chn)))))
      (iota 1 2))

    (spawn-fiber (make-radio radio-chn end-devices gateways))
    (hash-table-walk end-devices
                     (lambda (_ device) (spawn-fiber (device-thunk device))))
    (hash-table-walk gateways
                     (lambda (_ device) (spawn-fiber (device-thunk device))))))

(run-fibers
  run-simulation
  #:drain? #t)