path: root/simulation.scm

(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 (ice-9 getopt-long)
  #:use-module (fibers)
  #:use-module (fibers channels)
  #:use-module (fibers operations)
  #:use-module (fibers timers))

(define (put-message/timeout chan msg to)
  (perform-operation (choice-operation
                       (sleep-operation to)
                       (put-operation chan msg))))

(define (get-message/timeout chan to default)
  (perform-operation (choice-operation
                       (wrap-operation (sleep-operation to)
                         (lambda _ default))
                       (get-operation chan))))


(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 (time->milliseconds time)
  (let* ((seconds (car time))
         (micros  (cdr time)))
    (+ (* 1000 seconds) (round (/ micros 1000)))))
(define %start-time (time->milliseconds (gettimeofday)))
(define (ll f . data)
  (spawn-fiber
    (lambda ()
      (put-message
        *output-channel*
        (format #f "~12'0d - ~?~%" (- (time->milliseconds (gettimeofday))
                                      %start-time) f data)))))

;; Synchronized id generator
(define *id-channel-in* (make-channel))
(define *id-channel-out* (make-channel))
(define (counter)
   (let loop ((id 0))
     (let ((msg (get-message *id-channel-in*)))
       (put-message *id-channel-out* id)
       (loop (1+ id)))))

(define (new-id)
  (put-message *id-channel-in* #t)
  (get-message *id-channel-out*))

;; 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 id channel-n frame)
  radio-event?
  (type radio-event-type)
  (id radio-event-id)  ;; Match the start-interference-end events
  (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)
  (define window (make-channel))
  ;; 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-waiting-for! chn frame-counter)
    (ll "Device ~a started listening" id)
    (atomic-box-set! listening? (list chn frame-counter)))
  (define (stop-waiting!)
    (ll "Device ~a stopped listening" id)
    (atomic-box-set! listening? #f))
  (define (waiting-for? chn frame)
    (let ((listen (atomic-box-ref listening?)))
      (and listen
           (= chn (car listen))
           (= (frame-FCnt frame) (cadr listen)))))

  (define (process-downlink! frame)
    ;; TODO
    (ll "Device ~a got downlink frame ~a" id frame))

  #;(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* ((event-id id)
           (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 event-id channel frame))
      (sleep time-on-air)
      (put-message upstream-chn (make-radio-event 'uplink-end event-id 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: improve
      (sleep RECEIVE_DELAY1) ;; TODO: make sure this is ok

      (start-waiting-for! channel (1- current-frame))
      (let ((maybe-downstream-event (get-message/timeout window RX1 #f)))
        (match maybe-downstream-event
          (($ <radio-event> 'downlink-start event-id chn frame)
           (let ((event (get-message window)))
             (stop-waiting!)
             (match event
               (($ <radio-event> 'downlink-end event-id chn frame)
                (process-downlink! frame))
               (_ #f))))
          (_ (stop-waiting!)))

        #;(when (in-time?)
          (wait-until-rx2)
          (start-waiting-for! answer-to-x)
          (open-RX2)
          (stop-waiting! answer-to-x)))

      #;(when (atomic-box-ref to-confirm)
        (sleep (- RECEIVE_DELAY2 RECEIVE_DELAY1 RX1))
        (start-listening!)
        (sleep RX2)
        (stop-listening!))))

  (define (downstream)
    (forever
      (let ((ev (get-message downstream-chn)))
        ;; TODO:
        ;; If the same message is sent by several gateways how to identify
        ;; which start corresponds to each end??
        (match ev
          (($ <radio-event> type event-id chn frame)
           ;; TODO: listen to the first, and then hook to its radio-event-id
           (when (waiting-for? chn frame)
             ;; do not add timeout if it's waiting for an end???
             (spawn-fiber (lambda ()
                            (put-message window ev)))
             ))))))

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

(define (make-gateway id in radio network)
  (define time-on-air 0.01) ;s (TODO)
  (define pending-interferences '())

  (define (send-to-device frame)
    (ll "Trying to downlink")
    (spawn-fiber
      (lambda ()
        ;; TODO: choose channel properly
        (let ((event-id (new-id)))
          (ll "Gateway ~a sending downlink ~a" id frame)
          (put-message radio (make-radio-event 'downlink-start event-id 0 frame))
          (sleep time-on-air)
          (put-message radio (make-radio-event 'downlink-end   event-id 0 frame))))))

  (define (send-to-network-server x)
    (ll "Gateway ~a forwarding ~a" id x)
    (put-message network (make-network-event id x)))

  ;; Upstream: listen, and answer in new fibers
  (lambda ()
    (forever
      (let* ((ev (get-message in)))
        (match ev
          (($ <network-event> id frame)
           (send-to-device frame))
          (($ <radio-event> 'uplink-start event-id channel-n frame) #f)
          (($ <radio-event> 'interference event-id channel-n frame)
           (set! pending-interferences (cons ev pending-interferences)))
          (($ <radio-event> 'uplink-end event-id channel-n frame)
           (let-values (((mine not-mine)
                         (partition (lambda (x) (eq? (radio-event-id x)
                                                     (radio-event-id ev)))
                                    pending-interferences)))
             (set! pending-interferences not-mine)
             (when (null? mine) ;; TODO
               (send-to-network-server 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)
        (remove! (lambda (x) (eq? (radio-event-id x)
                                  (radio-event-id 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 id channel-n frame)
       (make-radio-event 'interference id channel-n frame))))

  (lambda ()
    (forever
      (let ((ev (get-message in)))
        (match ev
          (($ <radio-event> 'uplink-start event-id 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 event-id 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 (device-channel (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 event-id 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 event-id channel-n frame)
           (ll "Device ~a ended downlink-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 (get-message upstream)
        (($ <network-event> gateway-id frame)
         (ll "Network event happend!")
         ;; TODO answer properly
         (spawn-fiber
           (lambda ()
             (sleep RECEIVE_DELAY1)
             (put-message
               (device-channel (hash-table-ref gateways gateway-id))
               (make-network-event
                 gateway-id
                 (make-frame (frame-FCnt frame)
                             (frame-DeviceAddr frame)
                             #f
                             'hello))))))))))



(define (run-simulation end-device-count gateway-count)
  ;; We need synchronized logger and counter running in fibers
  (spawn-fiber logger)
  (spawn-fiber counter)

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

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

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

    (spawn-fiber (make-network-server network-chn gateways end-devices))

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

(define (main args)
  (define help
"
LoRaWAN interference simulator:

USAGE:
~/guile simulation.scm -d END_DEVICE_COUNT -g GATWEWAY_COUNT

OPTIONS:
~/-g, --gateways~25tGateway count to add to the simulation
~/-d, --end-devices~25tEnd Device count to add to the simulation
~/-h, --help~25tShow this help~&
")
  (define option-spec
    '((gateways     (single-char #\g) (value #t))
      (end-devices  (single-char #\d) (value #t))
      (help         (single-char #\h) (value #f))))

  (let* ((options        (getopt-long args option-spec))
         (end-devices-op (option-ref options 'end-devices #f))
         (gateways-op    (option-ref options 'gateways #f)))
    (when (option-ref options 'help #f)
      (format #t help)
      (exit 0))
    (unless end-devices-op
      (format #t "ERROR: No end-device count provided~%")
      (exit 1))
    (unless gateways-op
      (format #t "ERROR: No gateway count provided~%")
      (exit 1))
    (let* ((end-devices (and end-devices-op (string->number end-devices-op)))
           (gateways    (and gateways-op (string->number gateways-op))))
      (unless (integer? end-devices)
        (format #t "ERROR: -d, --end-devices: expecting integer~%")
        (exit 1))
      (unless (integer? gateways)
        (format #t "ERROR: -g, --gateways: expecting integer~%")
        (exit 1))

      (run-fibers
        (lambda () (run-simulation end-devices gateways))
        #:drain? #t))))

(main (command-line))