path: root/simulation.scm

(define-module (simulation)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #: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))))))


;; type can be:
;; '[up/down]link-start
;; '[up/down]link-end
(define-record-type <event>
  (make-event type channel-n frame)
  event?
  (type event-type)
  (channel-n event-channel-n)
  (frame 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-event 'uplink-start channel frame))
      (sleep time-on-air)
      (put-message upstream-chn (make-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 (ack-confirmed-data to channel seq-number)
    (spawn-fiber
      ;; TODO: answer in the second window??
      (lambda ()
        (sleep RECEIVE_DELAY1)
        (let ((frame (make-frame seq-number to '() 'ack)))
          (put-message downstream (make-event 'downlink-start channel frame))
          (sleep time-on-air) ;; TODO: size / data-rate
          (put-message downstream (make-event 'downlink-end channel frame))))))

  ;; Upstream: listen, and answer in new fibers
  (lambda ()
    (forever
      (let* ((msg (get-message upstream))) ;; TODO: make this get events instead
        (ll "Gateway ~a: Data #~a got from ~a"
            id
            (frame-FCnt msg)
            (frame-DeviceAddr msg))
        (match (frame-body msg)
          ('confirmed-data
           (ack-confirmed-data (frame-DeviceAddr msg)
                               1
                               (frame-FCnt msg))) ;; TODO: wrong!
          ('unconfirmed-data #f))))))


(define (make-radio in end-devices gateways)

  ;; Semaphore-like channel adquisition-release
  (define lorawan-channels (make-hash-table))
  (define (use-lorawan-channel chn)
    #f)
  (define (release-lorawan-channel chn)
    #f)


  ;; TODO: this is broken, only accounts for the interference of the frame
  ;; that was already being sent, and not from the new one that produced the
  ;; interference => both should be affected.
  (define (interference?)
    #f)

  (lambda ()
    (forever
      (match (get-message in)
        (($ <event> 'uplink-start channel-n frame)
         (ll "Device ~a started ~a of frame ~a"
             (frame-DeviceAddr frame)
             (frame-body frame)
             (frame-FCnt frame)))

        (($ <event> 'downlink-start channel-n frame)
         (ll "Device ~a started ~a of frame ~a"
             (frame-DeviceAddr frame)
             (frame-body frame)
             (frame-FCnt frame)))

        (($ <event> 'uplink-end channel-n frame)
         (ll "Device ~a finished ~a of frame ~a"
             (frame-DeviceAddr frame)
             (frame-body frame)
             (frame-FCnt frame))
         (if (interference?) ;; TODO: interferences are broken
           (ll "Interference!!!!!!")
           (hash-table-walk gateways
                            (lambda (k gateway)
                              (put-message (device-channel gateway) frame)))))

        (($ <event> 'downlink-end channel-n frame)
         (ll "Device ~a finished ~a of frame ~a"
             (frame-DeviceAddr frame)
             (frame-body frame)
             (frame-FCnt frame))
         (if (interference?) ;; TODO: interferences are broken
           (ll "Interference!!!!!!")
           (put-message
               (device-channel (hash-table-ref end-devices (frame-DeviceAddr frame)))
               frame)))))))


(define (make-network-server upstream)
  #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)