CS3700-project2/private/msg.rkt

#lang racket
(provide (all-defined-out))

(require json
         "iputil.rkt")

(module+ test
  (require rackunit))

;; src, dst : IP
;; data : Any
(struct msg [src dst]
  #:transparent)

(struct route [nexthop subnet pref self-origin? as-path origin]
  ;; nexthop : IP
  ;; subnet : Subnet
  ;; pref : Int
  ;; self-origin? : Boolean
  ;; as-path : [Listof Int]
  ;; origin : (U 'IGP 'EGP 'UNK)
  #:transparent)

(struct msg:update msg [route]
  ;; route : Route
  #:transparent)

(struct msg:revoke msg [networks]
  ;; networks : [Listof Subnet]
  #:transparent)

(struct msg:data msg [stuff]
  ;; stuff : Any
  #:transparent)

(struct msg:no-route msg []
  #:transparent)

(struct msg:dump msg []
  #:transparent)

(struct msg:table msg [networks]
  ;; networks : [Listof [List Subnet IP]]
  #:transparent)

;; Any -> Msg
(define (jsexpr->msg j)
  (define src (string->ip (hash-ref j 'src)))
  (define dst (string->ip (hash-ref j 'dst)))
  (define type (hash-ref j 'type))
  (define data (hash-ref j 'msg))

  (define (hash->subnet h)
    (subnet (string->ip (hash-ref h 'network))
            (ip-netmask (string->ip (hash-ref h 'netmask)))))

  (match type
    ["update"
     (msg:update src dst
                 (route src
                        (hash->subnet data)
                        (hash-ref data 'localpref)
                        (hash-ref data 'selfOrigin)
                        (hash-ref data 'ASPath)
                        (string->symbol (hash-ref data 'origin))))]
    ["revoke"
     (msg:revoke src dst
                 (map hash->subnet data))]
    ["data"
     (msg:data src dst
               data)]
    ["no route"
     (msg:no-route src dst)]
    ["dump"
     (msg:dump src dst)]
    ["table"
     (msg:table src dst
                (map (λ (h) (list (hash->subnet h)
                                  (string->ip (hash-ref h 'peer))))
                     data))]))

;; Bytes -> Msg
(define (bytes->msg bs)
  (jsexpr->msg (bytes->jsexpr bs)))

;; Msg -> String
(define (msg-type m)
  (cond
    [(msg:update? m) "update"]
    [(msg:revoke? m) "revoke"]
    [(msg:data? m) "data"]
    [(msg:no-route? m) "no route"]
    [(msg:dump? m) "dump"]
    [(msg:table? m) "table"]))

;; Msg -> Any
(define (msg->jsexpr msg)
  (hash 'src (ip->string (msg-src msg))
        'dst (ip->string (msg-dst msg))
        'type (msg-type msg)
        'msg (match msg
               [(msg:data _ _ data) data]
               [(msg:no-route _ _) (hash)]

               [(msg:update _ _
                            (route _
                                   net
                                   pref
                                   self-orig?
                                   as
                                   org))
                (hash 'network (ip->string (subnet-ip net))
                      'netmask (ip->string (netmask-ip (subnet-mask net)))
                      'localpref pref
                      'selfOrigin self-orig?
                      'ASPath as
                      'origin (symbol->string org))]

               [(msg:table _ _ networks)
                (for/list ([entry (in-list networks)])
                  (hash 'network (ip->string (subnet-ip (first entry)))
                        'netmask (ip->string (netmask-ip (subnet-mask (first entry))))
                        'peer (ip->string (second entry))))]

               [_ (error 'msg->jsexpr
                         (format "unimplemented ~a" (msg-type msg)))])))

;; Msg -> Bytes
(define (msg->bytes msg)
  (jsexpr->bytes (msg->jsexpr msg)))

(module+ test
  (check-equal? (msg->jsexpr
                 (msg:update
                  (string->ip "1.2.3.4")
                  (string->ip "1.2.3.7")
                  (route (string->ip "1.2.3.4")
                         (subnet (string->ip "1.2.3.5") 25)
                         100
                         #t
                         '(1 2)
                         'UNK)))
                (hash 'src "1.2.3.4"
                      'dst "1.2.3.7"
                      'type "update"
                      'msg (hash 'network "1.2.3.5"
                                 'netmask "255.255.255.128"
                                 'localpref 100
                                 'selfOrigin #t
                                 'ASPath '(1 2)
                                 'origin "UNK")))

  (check-equal? (jsexpr->msg
                 (hash 'src "1.2.3.4"
                       'dst "1.2.3.7"
                       'type "update"
                       'msg (hash 'network "1.2.3.5"
                                  'netmask "255.255.255.128"
                                  'localpref 100
                                  'selfOrigin #t
                                  'ASPath '(1 2)
                                  'origin "UNK")))
                (msg:update
                 (string->ip "1.2.3.4")
                 (string->ip "1.2.3.7")
                 (route (string->ip "1.2.3.4")
                        (subnet (string->ip "1.2.3.5") 25)
                        100
                        #t
                        '(1 2)
                        'UNK))))