WebRTC with JSCL

webrtc-jscl.lisp

;; WebSocket and WebRTC based multi-user chat sample with two-way video
;; calling, including use of TURN if applicable or necessary.

;; This file contains the JavaScript code that implements the client-side
;; features for connecting and managing chat and video calls.
;; To read about how this sample works:  http://bit.ly/webrtc-from-chat

;; Any copyright is dedicated to the Public Domain.
;; http://creativecommons.org/publicdomain/zero/1.0/

;; Dependencies can be found here: https://codeberg.org/mmontone/interactive-lang-tools/src/branch/master/backends/jscl
;; The complete Javascript example this is based on is here: https://github.com/mdn/samples-server/tree/master/s/webrtc-from-chat

(defpackage :jscl/webrtc
  (:use :cl :js/syntax :jscl/alexandria))

(in-package :jscl/webrtc)

(defun emptyp (thing)
  (or (null thing)
      (and (jscl::sequencep thing)
           (zerop (length thing)))))

;; (emptyp nil)
;; (emptyp "")

(defparameter *hostname*
  (or (and (not (emptyp #j:window:location:hostname))
           #j:window:location:hostname)
      "localhost"))

(defparameter *server-port* 6503)
(defparameter *server-url*
  (let ((protocol (if (string= #j:document:location:protocol "https")
                      "wss" "ws")))
    (format nil "~a://~a:~a" protocol *hostname* *server-port*)))

(defparameter *connection* nil)
(defparameter *client-id* 0)

;; The media constraints object describes what sort of stream we want
;; to request from the local A/V hardware (typically a webcam and
;; microphone). Here, we specify only that we want both audio and
;; video; however, you can be more specific. It's possible to state
;; that you would prefer (or require) specific resolutions of video,
;; whether to prefer the user-facing or rear-facing camera (if available),
;; and so on.

;; See also:
;; https://developer.mozilla.org/en-US/docs/Web/API/MediaStreamConstraints
;; https://developer.mozilla.org/en-US/docs/Web/API/MediaDevices/getUserMedia

(defparameter *media-constraints*
  (@{ :audio t
      :video (@{
              :|aspectRatio|
              (@{
               :ideal 1.33
               ))))

;; (#j:JSON:stringify *media-constraints*)

(defparameter *username* nil
  "The username of the local user.")
(defparameter *target-username* nil
  "The username of the user to communicate with.")
(defparameter *peer-connection* nil
  "RTCPeerConnection")
(defparameter *webcam-stream* nil
  "MediaStream from webcam")

(defun send-to-server (msg)
  "Send MSG to server via the WebSocket connection."
  (#j:console:log "Sending: " msg)
  (-> *connection* (:send (#j:JSON:stringify msg))))

(defun set-username ()
  "Called when the 'id' message is received; this message is sent by the
server to assign this login session a unique ID number; in response,
this function sends a 'username' message to set our username for this
session."
  (setf *username* (@ (#j:document:getElementById "name") "value"))

  (send-to-server
   (@{
    :name *username*
    :date (new #j:Date)
    :id *client-id*
    :type "username"
    )))

(defun connect ()
  "Open and configure the connectionto the WebSocket server."
  (setf *connection* (new #j:WebSocket (js *server-url*) (js "json")))
  (#j:console:log "Connected: " *connection*)

  (setf (@ *connection* :|onopen|)
        (lambda (evt)
          (setf (@ (#j:document:getElementById "text") "disabled") nil)
          (setf (@ (#j:document:getElementById "send") "disabled") nil)))

  (setf (@ *connection* :|onerror|)
        (lambda (evt)
          (#j:console:dir evt)))

  (setf (@ *connection* :|onmessage|)
        (lambda (evt)
          (let* ((chatbox (#j:document:querySelector ".chatbox"))
                 (text "")
                 (msg (#j:JSON:parse (@ evt :|data|)))
                 (time (new #j:Date (js (@ msg :|date|))))
                 (time-str (-> time (:|toLocaleTimeString|))))

            (#j:console:log "Message received: ")
            (#j:console:dir msg)

            (condp (curry #'string= (@ msg "type"))
                   ("id"
                    (setf *client-id* (@ msg "id"))
                    (set-username))
                   ("username"
                    (setf text (format nil "<b>User <em>~a</em> signed in at ~a</b></br>"
                                       (@ msg "name")
                                       time-str)))
                   ("message"
                    (setf text (format nil "(~a) <b>~a</b>: ~a<br>"
                                       time-str (@ msg "name") (@ msg "text"))))
                   ("rejectusername"
                    (setf *username* (@ msg "name"))
                    (setf text (format nil "<b>Your username has been set to <em>~a</em> because the name you chose is in use.</b><br>"
                                       *username*)))
                   ("userlist"
                    (handle-userlist-msg msg))
                   ("video-offer"
                    (handle-video-offer-msg msg))
                   ("video-answer"
                    (handle-video-answer-msg msg))
                   ("new-ice-candidate"
                    (handle-new-ICE-candidate-msg msg))
                   ("hang-up"
                    (handle-hang-up-msg msg)))

            (when (not (emptyp text))
              (setf (@ chatbox "innerHTML")
                    (concatenate 'string (@ chatbox "innerHTML") text))
              (setf (@ chatbox "scrollTop") (- (@ chatbox "scrollHeight")
                                               (@ chatbox "clientHeight"))))))))

(defun handle-send-button ()
  "Handle a click on the Send button (or pressing return/enter)
by building a message object and sending it to the server.)"
  (let ((msg (@{
              :text (@ (#j:document:getElementById "text") "value")
              :type "message"
              :id *client-id*
              :date (new #j:Date))))
    (send-to-server msg)
    (setf (@ (#j:document:getElementById "text") "value") "")))

(defun handle-key (evt)
  "Handler for keyboard events.
This is used to intercept the return and enter keys so that we can call send()
to transmit the entered text to the server.."
  (when (or (= (@ evt "keyCode") 13)
            (= (@ evt "keyCode") 14))
    (when (not (@ (#j:document:getElementById "send") "disabled"))
      (handle-send-button))))

(defun create-peer-connection ()
  "Create the RTCPeerConnection which knows how to talk to our
selected STUN/TURN server and then uses getUserMedia() to find
our camera and microphone and add that stream to the connection for
use in our video call. Then we configure event handlers to get
needed notifications on the call."

  (#j:console:log "Setting up a connection ...")
  (setf *peer-connection* (new #j:RTCPeerConnection
                               (@{
                                :|iceServers|
                                (vector (@{
                                         :|urls| (format nil "turn:~a" *hostname*)
                                         :|username| "webrtc"
                                         :|credential| "turnserver")))))

  ;; Set up event handlers for the ICE negotiation process

  (setf (@ *peer-connection* :|onicecandidate|) #'handle-ICE-candidate-event
        (@ *peer-connection* :|oniceconnectionstatechange|) #'handle-ICE-connection-state-change-event
        (@ *peer-connection* :|onicegatheringstatechange|) #'handle-ICE-gathering-state-change-event
        (@ *peer-connection* :|onsignalingstatechange|) #'handle-signaling-state-change-event
        (@ *peer-connection* :|onnegotiationneeded|) #'handle-negotiation-needed-event
        (@ *peer-connection* :|ontrack|) #'handle-track-event)

  *peer-connection*)

(defun handle-negotiation-needed-event (evt)
  "Called by the WebRTC layer to let us know when it's time to
begin, resume, or restart ICE negotiation."
  (#j:console:log "*** Negotiation needed")

  (-> *peer-connection*
    (:|createOffer|)
    (:then (lambda (offer)
             ;; If the connection hasn't yet achieved the "stable" state,
             ;; return to the caller. Another negotiationneeded event
             ;; will be fired when the state stabilizes.
	     (#j:console:log "Signaling state: " (@ *peer-connection* :|signalingState|))
             (if (not (string= (@ *peer-connection* :|signalingState|)
                               "stable"))
                 (progn
                   (#j:console:log "-- The connection isn't stable yet; posponing...")
                   ;;(return-from handle-negotiation-needed-event)
                   (#j:Promise:reject "Connection not stable yet"))
                 (progn

                   ;; Establish the offer as the local peer's current description.
                   (#j:console:log "---> Setting local description to the offer")

                   (-> *peer-connection* (:|setLocalDescription| offer))))))
    (:then (lambda (res)
             ;; Send the offer to the remote peer
             (#j:console:log "---> Sending the offer to the remote peer")
             (send-to-server (@{
                              :name *username*
                              :target *target-username*
                              :type "video-offer"
                              :sdp (@ *peer-connection* "localDescription")))))
    (:catch #'report-error)))

(defun handle-track-event (event)
  "Called by the WebRTC layer when events occur on the media tracks
on our WebRTC call. This includes when streams are added to and
removed from the call.

track events include the following fields:

RTCRtpReceiver       receiver
MediaStreamTrack     track
MediaStream[]        streams
RTCRtpTransceiver    transceiver

In our case, we're just taking the first stream found and attaching
it to the <video> element for incoming media."
  (#j:console:log "*** Track event")
  (setf (@ (#j:document:getElementById "received_video") "srcObject")
        (-> event :|streams| 0)
        (@ (#j:document:getElementById "hangup-button") "disabled")
        nil))

(defun handle-ice-candidate-event (event)
  "Handles |icecandidate| events by forwarding the specified
ICE candidate (created by our local ICE agent) to the other
peer through the signaling server."
  (when (@ event "candidate")
    (#j:console:log "*** Outgoing ICE candidate: " (@ event "candidate"))

    (send-to-server
     (@{ :type "new-ice-candidate"
         :target *target-username*
         :candidate (@ event "candidate")))))

(defun handle-ICE-connection-state-change-event (event)
  "This will detect when the signaling connection is closed.

NOTE: This will actually move to the new RTCPeerConnectionState enum
returned in the property RTCPeerConnection.connectionState when
browsers catch up with the latest version of the specification!"

  (#j:console:log "*** ICE connection state changed to " (@ *peer-connection* :|iceConnectionState|))

  (when (member (@ *peer-connection* :|iceConnectionState|)
                '("closed" "failed" "disconnected") :test #'string=)
    (close-video-call)))

(defun handle-signaling-state-change-event (event)
  "Set up a |signalingstatechange| event handler. This will detect when
the signaling connection is closed.

NOTE: This will actually move to the new RTCPeerConnectionState enum
returned in the property RTCPeerConnection.connectionState when
browsers catch up with the latest version of the specification!"

  (#j:console:log "*** WebRTC signaling state changed to: " (@ *peer-connection* :|signalingState|))

  (when (string= (@ *peer-connection* :|signalingState|)
                 "closed")
    (close-video-call)))

(defun handle-ICE-Gathering-State-Change-Event (event)
  "Handle the |icegatheringstatechange| event. This lets us know what the
ICE engine is currently working on: 'new' means no networking has happened
yet, 'gathering' means the ICE engine is currently gathering candidates,
and 'complete' means gathering is complete. Note that the engine can
alternate between 'gathering' and 'complete' repeatedly as needs and
circumstances change.

We don't need to do anything when this happens, but we log it to the
console so you can see what's going on when playing with the sample."

  (#j:console:log "*** ICE gathering state changed to: " (@ *peer-connection* :|iceGatheringState|)))

(defun handle-userlist-msg (msg)
  "Given a message containing a list of usernames, this function
populates the user list box with those names, making each item
clickable to allow starting a video call."
  (let ((ul (#j:document:querySelector ".userlistbox")))
    ;; Remove all current list members
    (setf (@ ul "innerHTML") "")

    ;; Add member names from the received list
    (dovector (username (@ msg "users"))
      (let ((li (#j:document:createElement "li")))
        (-> li (:|appendChild| (#j:document:createTextNode username)))
        (-> li (:|addEventListener| "click" #'invite nil))
        (-> ul (:|appendChild| li))))))

(defun close-video-call ()
  "Close the RTCPeerConnection and reset variables so that the user can
make or receive another call if they wish. This is called both
when the user hangs up, the other user hangs up, or if a connection
failure is detected."
  (let ((local-video (#j:document:getElementById "local_video")))
    (#j:console:log "Closing the call")

    (when *peer-connection*
      (#j:console:log "Closing peer connection." *peer-connection*)

      ;; Disconnect all our event listeners; we don't want stray events
      ;; to interfere with the hangup while it's ongoing.

      (setf (@ *peer-connection* "ontrack") nil
            (@ *peer-connection* "onicecandidate") nil
            (@ *peer-connection* "oniceconnectionstatechange") nil
            (@ *peer-connection* "onsignalingstatechange") nil
            (@ *peer-connection* "onicegatheringstatechange") nil
            (@ *peer-connection* "onnotificationneeded") nil)

      ;; Stop all transceivers on the connection
      (dovector (transceiver (-> *peer-connection* (:|getTransceivers|)))
        (-> transceiver (:|stop|)))

      ;; Stop the webcam preview as well by pausing the <video>
      ;; element, then stopping each of the getUserMedia() tracks
      ;; on it.

      (when (@ local-video "srcObject")
        (-> local-video (:|pause|))
        (dovector (track (-> local-video :|srcObject| (:|getTracks|)))
          (-> track (:|stop|))))

      ;; Close the peer connection
      (-> *peer-connection* (:|close|))
      (setf *peer-connection* nil)
      (setf *webcam-stream* nil))))

(defun handle-hang-up-msg (msg)
  (#j:console:log "*** Received hang up notification from other peer")
  (close-video-call))

(defun hang-up-call ()
  "Hang up the call by closing our end of the connection, then
sending a 'hang-up' message to the other peer (keep in mind that
the signaling is done on a different connection). This notifies
the other peer that the connection should be terminated and the UI
returned to the 'no call in progress' state."
  (close-video-call)
  (send-to-server
   (@{ :name *username*
       :target *target-username*
       :type "hang-up")))

(defun invite (evt)
  "Handle a click on an item in the user list by inviting the clicked
user to video chat. Note that we don't actually send a message to
the callee here -- calling RTCPeerConnection.addTrack() issues
a |notificationneeded| event, so we'll let our handler for that
make the offer.)"
  (when *peer-connection*
    (#j:alert "You can't start a call because you already have one open!")
    (return-from invite))

  (let ((clicked-username (-> evt :|target| :|textContent|)))

    ;; Don't allow users to call themselves, because weird.
    (when (string= clicked-username *username*)
      (#j:alert "I'm afraid I can't let you talk to yourself. That would be weird.")
      (return-from invite))

    ;; Record the username being called for future reference

    (setf *target-username* clicked-username)
    (#j:console:log "Inviting user" *target-username*)

    ;; Call createPeerConnection() to create the RTCPeerConnection.
    ;; When this returns, myPeerConnection is our RTCPeerConnection
    ;; and webcamStream is a stream coming from the camera. They are
    ;; not linked together in any way yet.

    (create-peer-connection)

    ;; Get access to the webcam stream and attach it to the
    ;; "preview" box (id "local_video").
    (-> (#j:navigator:mediaDevices:getUserMedia *media-constraints*)
      (:then (lambda (webcam-stream)
               (setf (@ (#j:document:getElementById "local_video") "srcObject")
                     webcam-stream)
               ;; Add the tracks from the stream to the RTCPeerConnection
               (dovector (track (-> webcam-stream (:|getTracks|)))
                 (-> *peer-connection* (:|addTransceiver| track
                                        (@{ :streams (vector webcam-stream)))))))
      (:catch #'handle-get-user-media-error))))

(defun handle-video-offer-msg (msg)
  "Accept an offer to video chat. We configure our local settings,
create our RTCPeerConnection, get and attach our local camera
stream, then create and send an answer to the caller.)"
  (setf *target-username* (@ msg "name"))

  ;; If we're not already connected, create an RTCPeerConnection
  ;; to be linked to the caller.
  (#j:console:log "Received video chat offer from " *target-username*)

  (when (not *peer-connection*)
    (create-peer-connection))

  ;; We need to set the remote description to the received SDP offer
  ;; so that our local WebRTC layer knows how to talk to the caller.

  (let ((desc (new #j:RTCSessionDescription (js (@ msg "sdp")))))

    ;; If the connection isn't stable yet, wait for it ...
    (#j:console:log "Signaling state: " (@ *peer-connection* :|signalingState|))
    (when (not (string= (@ *peer-connection* :|signalingState|) "stable"))
      (#j:console:log "  - But the signaling state isn't stable, so triggering rollback")
      (return-from handle-video-offer-msg
        (#j:Promise:all (vector (-> *peer-connection* (:|setLocalDescription|
                                                       (@{ :type "rollback")))
                                (-> *peer-connection* (:|setRemoteDescription| desc))))))

    (#j:console:log "   - Setting remote description")
    (let ((promise (-> *peer-connection* (:|setRemoteDescription| desc))))
      ;; Get the webcam stream if we don't already have it
      (when (not *webcam-stream*)
        (-> promise
          (:then (lambda (_)
                   (#j:navigator:mediaDevices:getUserMedia *media-constraints*)))
          (:catch #'handle-get-user-media-error)
          (:then (lambda (webcam-stream)
                   (setf *webcam-stream* webcam-stream)
                   (setf (@ (#j:document:getElementById "local_video") "srcObject")
                         *webcam-stream*)

                   ;; Add the camera stream to the RTCPeerConnection
                   (dovector (track (-> *webcam-stream* (:|getTracks|)))
                     (-> *peer-connection* (:|addTransceiver| track
                                            (@{ :streams (vector *webcam-stream*)))))))))
      (-> promise
        (:then (lambda (_)
                 (-> *peer-connection* (:|createAnswer|))))
        (:then (lambda (answer)
                 (#j:console:log "---> Creating and sending answer to caller")
                 (-> *peer-connection* (:|setLocalDescription| answer))))
        (:then (lambda (_)
                 (send-to-server (@{
                                  :name *username*
                                  :target *target-username*
                                  :type "video-answer"
                                  :sdp (@ *peer-connection* "localDescription")
                                  ))))))))

(defun report-error (err)
  (#j:console:error err))

(defun handle-video-answer-msg (msg)
  "Responds to the 'video-answer' message sent to the caller
once the callee has decided to accept our request to talk.)"
  (#j:console:log "*** Call recipient has accepted our call")

  (let ((desc (new #j:RTCSessionDescription (js (@ msg "sdp")))))
    (-> *peer-connection*
      (:|setRemoteDescription| desc)
      (:catch #'report-error))))

(defun handle-new-ice-candidate-msg (msg)
  "A new ICE candidate has been received from the other peer. Call
RTCPeerConnection.addIceCandidate() to send it along to the
local ICE framework."
  (when (@ msg "candidate")
    (let ((candidate (new #j:RTCIceCandidate (js (@ msg "candidate")))))
      (#j:console:log "*** Adding received ICE candidate: " candidate)
      (-> *peer-connection*
	(:|addIceCandidate| candidate)
	(:catch #'report-error)))))

(defun handle-get-user-media-error (err)
  "Handle errors which occur when trying to access the local media
hardware; that is, exceptions thrown by getUserMedia(). The two most
likely scenarios are that the user has no camera and/or microphone
or that they declined to share their equipment when prompted. If
they simply opted not to share their media, that's not really an
error, so we won't present a message in that situation.)"
  (#j:console:error err)

  (close-video-call))

;; Expose functions to Javascript world
(setf #j:connect #'connect)
(setf #j:handleSendButton #'handle-send-button)
(setf #j:handleKey #'handle-key)
(setf #j:closeVideoCall #'close-video-call)
(setf #j:hangUpCall #'hang-up-call)