Websockets in MemCP

In MemCP, you can call (set send ((res "websocket") onReceiveFunction onCloseFunction))to upgrade a http session into a websocket (res is the response object from your http handler, see serve). The onReceiveFunction will take message as it's parameter. onCloseFunction will be called when the socket is closed. You can call (send 1 "my message") to send a string to the client.

Here's an example application of a publish subscribe network for a game where player positions are streamed to other players:

(print "")
(print "Welcome to our Worldserver")
(print "")
(print "set MEMCP and PORT in your environment")

/* this can be overhooked */
(define http_handler (lambda (req res) (begin
        (print "request " req)
        ((res "header") "Content-Type" "text/plain")
        ((res "status") 404)
        ((res "println") "404 not found")
)))

(set MEMCP (env "MEMCP" "../../memcp"))
(import (concat MEMCP "/lib/sql.scm"))

/* load config */
(set CONF (env "CONF" "../out/conf.json"))
(set conf (json_decode (load CONF)))
(set macKey (((conf "Types") "Password") "encryptKey"))

/* init database */
(settings "DefaultEngine" "sloppy")
(createdatabase "hardlife" true)
(define resultrow print)
(define session (newsession))
(eval (parse_sql "hardlife" "CREATE TABLE IF NOT EXISTS avatar(ID int, x double, y double, z double, r double, location int, UNIQUE KEY PRIMARY(ID))"))
(eval (parse_sql "hardlife" "CREATE TABLE IF NOT EXISTS avatarListen(ID int, container int, UNIQUE KEY PRIMARY(ID, container))"))
(eval (parse_sql "hardlife" "CREATE TABLE IF NOT EXISTS avatarDirty(ID int, other int, UNIQUE KEY PRIMARY(ID, other))"))
(set update_location_prepared (parse_sql "hardlife" "INSERT INTO avatar(ID, x, y, z, r, location) VALUES (@avatar, @x, @y, @z, @r, @l) ON DUPLICATE KEY UPDATE x = @x, y = @y, z = @z, r = @r, location = @l"))
(set update_dirtylist_prepared (parse_sql "hardlife" "INSERT IGNORE INTO avatarDirty(ID, other) SELECT ID, @avatar FROM avatarListen WHERE ID != @avatar AND container = @l"))
(set clear_listen_prepared (parse_sql "hardlife" "DELETE FROM avatarListen WHERE ID = @avatar"))
(set insert_listen_prepared (parse_sql "hardlife" "INSERT IGNORE INTO avatarListen(ID, container) VALUES (@avatar, @l2)"))
(set get_listen_prepared (parse_sql "hardlife" "SELECT avatar.ID, avatar.x, avatar.y, avatar.z, avatar.r, avatar.location AS l FROM avatarDirty, avatar WHERE avatar.ID = avatarDirty.other AND avatarDirty.ID = @avatar"))
(set clear_dirty_prepared (parse_sql "hardlife" "DELETE FROM avatarDirty WHERE ID = @avatar"))

(define http_handler (begin
	(set old_handler http_handler)
	(lambda (req res) (begin
		/* hooked our additional paths to it */
		(match (req "path")
			"/" (begin
				(set session (newsession))
				(set send ((res "websocket") (lambda (msg) (begin
					(set msg (json_decode msg))
					(if
						(and (has_assoc? msg "l") (session "avatar")) (begin
							/* position report */
							(if (and (session "l") (not (equal? (msg "l") (session "l"))))
								(eval update_dirtylist_prepared)) /* update dirtylist if we leave a room */
							(session "x" (msg "x"))
							(session "y" (msg "y"))
							(session "z" (msg "z"))
							(session "r" (msg "r"))
							(session "l" (msg "l"))
							(eval update_location_prepared)
							(eval update_dirtylist_prepared)
							/* flush all dirtyflags of this avatar
							/*(set resultrow (lambda (item)
								(send 1 json_encode_assoc '(
							))*/

							/* send back dirty items */
							(set resultrow (lambda (item) (begin
								(send 1 (json_encode_assoc item))
							)))
							(eval get_listen_prepared)
							(eval clear_dirty_prepared)
						)
						(and (has_assoc? msg "listen") (session "avatar")) (begin
							/* update listener list */
							(eval clear_listen_prepared)
							(map (msg "listen") (lambda (container) (begin
								(session "l2" container)
								(eval insert_listen_prepared)
							)))
						)
						(has_assoc? msg "authenticate") (begin
							(if (equal? (bin2hex (password (concat "a:" (msg "authenticate") ":" macKey))) (msg "mac")) (begin
								(print "authenicated avatar " (msg "authenticate"))
								(session "avatar" (msg "authenticate"))
							) (send 1 (json_encode_assoc '("error" "could not authenticate to avatar"))))
						)
						(print "unhandled message: " (json_encode msg))
					)
				)) (lambda () (print "player has left"))))
				(send 1 "\"Hello World from server\"")
			)
			/* default */
			(old_handler req res))
	))
))


/* read  http_handler fresh from the environment */
(set port (env "PORT" "8001"))
(serve port (lambda (req res) (http_handler req res)))
(print "listening on http://localhost:" port)