feat: Add websocket support

src/gleam/http/cowboy.gleam

@@ -1,131 +1,16 @@
-import gleam/list
-import gleam/pair
-import gleam/map.{Map}
-import gleam/option.{None, Option, Some}
-import gleam/result
-import gleam/http.{Header}
-import gleam/http/service.{Service}
-import gleam/http/request.{Request}
-import gleam/bit_builder.{BitBuilder}
 import gleam/dynamic.{Dynamic}
-import gleam/otp/actor.{StartResult}
+import gleam/bit_builder.{BitBuilder}
+import gleam/http/cowboy/common.{service_to_handler, CowboyRequest}
+import gleam/http/service.{Service}
 import gleam/otp/process.{Pid}
-
-external type CowboyRequest
+import gleam/otp/actor.{StartResult}
 
 external fn erlang_start_link(
   handler: fn(CowboyRequest) -> CowboyRequest,
   port: Int,
 ) -> Result(Pid, Dynamic) =
   "gleam_cowboy_native" "start_link"
 
-external fn cowboy_reply(
-  Int,
-  Map(String, Dynamic),
-  BitBuilder,
-  CowboyRequest,
-) -> CowboyRequest =
-  "cowboy_req" "reply"
-
-external fn erlang_get_method(CowboyRequest) -> Dynamic =
-  "cowboy_req" "method"
-
-fn get_method(request) -> http.Method {
-  request
-  |> erlang_get_method
-  |> http.method_from_dynamic
-  |> result.unwrap(http.Get)
-}
-
-external fn erlang_get_headers(CowboyRequest) -> Map(String, String) =
-  "cowboy_req" "headers"
-
-fn get_headers(request) -> List(http.Header) {
-  request
-  |> erlang_get_headers
-  |> map.to_list
-}
-
-external fn get_body(CowboyRequest) -> #(BitString, CowboyRequest) =
-  "gleam_cowboy_native" "read_entire_body"
-
-external fn erlang_get_scheme(CowboyRequest) -> String =
-  "cowboy_req" "scheme"
-
-fn get_scheme(request) -> http.Scheme {
-  request
-  |> erlang_get_scheme
-  |> http.scheme_from_string
-  |> result.unwrap(http.Http)
-}
-
-external fn erlang_get_query(CowboyRequest) -> String =
-  "cowboy_req" "qs"
-
-fn get_query(request) -> Option(String) {
-  case erlang_get_query(request) {
-    "" -> None
-    query -> Some(query)
-  }
-}
-
-external fn get_path(CowboyRequest) -> String =
-  "cowboy_req" "path"
-
-external fn get_host(CowboyRequest) -> String =
-  "cowboy_req" "host"
-
-external fn get_port(CowboyRequest) -> Int =
-  "cowboy_req" "port"
-
-fn proplist_get_all(input: List(#(a, b)), key: a) -> List(b) {
-  list.filter_map(
-    input,
-    fn(item) {
-      case item {
-        #(k, v) if k == key -> Ok(v)
-        _ -> Error(Nil)
-      }
-    },
-  )
-}
-
-// In cowboy all header values are strings except set-cookie, which is a
-// list. This list has a special-case in Cowboy so we need to set it
-// correctly.
-// https://github.com/gleam-lang/cowboy/issues/3
-fn cowboy_format_headers(headers: List(Header)) -> Map(String, Dynamic) {
-  let set_cookie_headers = proplist_get_all(headers, "set-cookie")
-  headers
-  |> list.map(pair.map_second(_, dynamic.from))
-  |> map.from_list
-  |> map.insert("set-cookie", dynamic.from(set_cookie_headers))
-}
-
-fn service_to_handler(
-  service: Service(BitString, BitBuilder),
-) -> fn(CowboyRequest) -> CowboyRequest {
-  fn(request) {
-    let #(body, request) = get_body(request)
-    let response =
-      service(Request(
-        body: body,
-        headers: get_headers(request),
-        host: get_host(request),
-        method: get_method(request),
-        path: get_path(request),
-        port: Some(get_port(request)),
-        query: get_query(request),
-        scheme: get_scheme(request),
-      ))
-    let status = response.status
-
-    let headers = cowboy_format_headers(response.headers)
-    let body = response.body
-    cowboy_reply(status, headers, body, request)
-  }
-}
-
 // TODO: document
 // TODO: test
 pub fn start(

src/gleam/http/cowboy/common.gleam

@@ -0,0 +1,150 @@
+import gleam/list
+import gleam/pair
+import gleam/map.{Map}
+import gleam/option.{None, Option, Some}
+import gleam/result
+import gleam/http.{Header}
+import gleam/http/service.{Service}
+import gleam/http/request.{Request}
+import gleam/http/response.{Response}
+import gleam/bit_builder.{BitBuilder}
+import gleam/dynamic.{Dynamic}
+import gleam/otp/actor.{StartResult}
+import gleam/otp/process.{Pid}
+import gleam/erlang/atom.{Atom}
+
+pub external type CowboyRequest
+
+external fn cowboy_reply(
+  Int,
+  Map(String, Dynamic),
+  BitBuilder,
+  CowboyRequest,
+) -> CowboyRequest =
+  "cowboy_req" "reply"
+
+external fn erlang_get_method(CowboyRequest) -> Dynamic =
+  "cowboy_req" "method"
+
+fn get_method(request) -> http.Method {
+  request
+  |> erlang_get_method
+  |> http.method_from_dynamic
+  |> result.unwrap(http.Get)
+}
+
+external fn erlang_get_headers(CowboyRequest) -> Map(String, String) =
+  "cowboy_req" "headers"
+
+fn get_headers(request) -> List(http.Header) {
+  request
+  |> erlang_get_headers
+  |> map.to_list
+}
+
+external fn get_body(CowboyRequest) -> #(BitString, CowboyRequest) =
+  "gleam_cowboy_native" "read_entire_body"
+
+external fn erlang_get_scheme(CowboyRequest) -> String =
+  "cowboy_req" "scheme"
+
+fn get_scheme(request) -> http.Scheme {
+  request
+  |> erlang_get_scheme
+  |> http.scheme_from_string
+  |> result.unwrap(http.Http)
+}
+
+external fn erlang_get_query(CowboyRequest) -> String =
+  "cowboy_req" "qs"
+
+fn get_query(request) -> Option(String) {
+  case erlang_get_query(request) {
+    "" -> None
+    query -> Some(query)
+  }
+}
+
+external fn get_path(CowboyRequest) -> String =
+  "cowboy_req" "path"
+
+external fn get_host(CowboyRequest) -> String =
+  "cowboy_req" "host"
+
+external fn get_port(CowboyRequest) -> Int =
+  "cowboy_req" "port"
+
+fn proplist_get_all(input: List(#(a, b)), key: a) -> List(b) {
+  list.filter_map(
+    input,
+    fn(item) {
+      case item {
+        #(k, v) if k == key -> Ok(v)
+        _ -> Error(Nil)
+      }
+    },
+  )
+}
+
+// In cowboy all header values are strings except set-cookie, which is a
+// list. This list has a special-case in Cowboy so we need to set it
+// correctly.
+// https://github.com/gleam-lang/cowboy/issues/3
+fn cowboy_format_headers(headers: List(Header)) -> Map(String, Dynamic) {
+  let set_cookie_headers = proplist_get_all(headers, "set-cookie")
+  headers
+  |> list.map(pair.map_second(_, dynamic.from))
+  |> map.from_list
+  |> map.insert("set-cookie", dynamic.from(set_cookie_headers))
+}
+
+fn cowboy_request_to_request(request) {
+  let #(body, request) = get_body(request)
+
+  Request(
+    body: body,
+    headers: get_headers(request),
+    host: get_host(request),
+    method: get_method(request),
+    path: get_path(request),
+    port: Some(get_port(request)),
+    query: get_query(request),
+    scheme: get_scheme(request),
+  )
+}
+
+pub fn service_to_handler(
+  service: Service(BitString, BitBuilder),
+) -> fn(CowboyRequest) -> CowboyRequest {
+  fn(request) {
+    let response = request |> cowboy_request_to_request |> service
+    let headers = cowboy_format_headers(response.headers)
+    cowboy_reply(response.status, headers, response.body, request)
+  }
+}
+
+/// Response returned from a websocket service. The response can either be a
+/// normal HTTP response OR it can be a directive to upgrade to a persistant
+/// websocket connection with the initial state for the socket
+pub type WSResponse(out, state) {
+  Upgrade(CowboyRequest, state)
+  Respond(Response(out))
+}
+
+pub type WSService(in, out, state) = fn(Request(in)) -> WSResponse(out, state)
+
+pub fn ws_service_to_handler(
+  service: WSService(BitString, BitBuilder, state),
+) -> fn(CowboyRequest) -> Dynamic {
+  fn(request) {
+    case service(cowboy_request_to_request(request)) {
+      Respond(response) -> {
+        let headers = cowboy_format_headers(response.headers)
+        dynamic.from(cowboy_reply(response.status, headers, response.body, request))
+      }
+      Upgrade(request, state) -> {
+        dynamic.from(#(atom.from_string("cowboy_websocket"), request, state))
+      }
+    }
+  }
+}

src/gleam/http/cowboy/websocket.gleam

@@ -0,0 +1,43 @@
+import gleam/dynamic.{Dynamic}
+import gleam/map.{Map}
+import gleam/bit_builder.{BitBuilder}
+import gleam/http/cowboy/common.{WSService, ws_service_to_handler}
+import gleam/otp/process.{Pid}
+import gleam/erlang/atom.{Atom}
+import gleam/otp/actor.{StartResult}
+
+external fn erlang_start_ws_link(
+  handlers: Map(Atom, Dynamic),
+  port: Int,
+) -> Result(Pid, Dynamic) =
+  "gleam_cowboy_native" "start_link"
+
+pub type Frame {
+  Text(String)
+}
+
+pub type FrameResponse {
+  Ignore
+  Respond(Frame)
+}
+
+type Next(state) = #(FrameResponse, state)
+
+pub fn start(
+  service: WSService(BitString, BitBuilder, state),
+  on_ws_init init: fn(state) -> Next(state),
+  on_ws_frame frame: fn(state, Frame) -> Next(state),
+  on_info info: fn(state, Dynamic) -> Next(state),
+  on_port number: Int,
+) -> StartResult(a) {
+  service
+  |> ws_service_to_handler
+  |> fn(handler) { map.from_list([
+    #(atom.create_from_string("handler"), dynamic.from(handler)),
+    #(atom.create_from_string("on_ws_init"), dynamic.from(init)),
+    #(atom.create_from_string("on_ws_frame"), dynamic.from(frame)),
+    #(atom.create_from_string("on_info"), dynamic.from(info)),
+  ]) }
+  |> erlang_start_ws_link(number)
+  |> actor.from_erlang_start_result
+}

src/gleam_cowboy_native.erl

@@ -18,9 +18,38 @@ start_link(Handler, Port) ->
         cowboy_clear, CowboyOptions
     ).
 
+% Callback used by websocket.gleam
+% Allows for both normal request/response as well as upgrades to a persistant
+% websocket connection
+init(Req, #{handler => Handler} = Handlers) ->
+    case Handler(Req) of
+        {cowboy_websocket, Res, State} -> {cowboy_websocket, Res, Handlers#{state => State}, #{max_frame_size => 8000000, idle_timeout => 30000}};
+        Res -> {ok, Res, Req}
+    end.
+
+% Normal Callback used by cowboy.gleam
 init(Req, Handler) ->
     {ok, Handler(Req), Req}.
 
+% https://ninenines.eu/docs/en/cowboy/2.9/guide/ws_handlers/
+websocket_init(#{state => State, on_ws_init => OnWSInit } = Handlers) ->
+  case OnWSInit(State) of
+      {ok, State} -> {ok, Handlers#{state => State}, hibernate};
+      {reply, Frame, State} -> {reply, Frame, Handlers#{state => State}, hibernate}
+  end.
+
+websocket_handle(Frame, #{state => State, on_ws_frame => OnWSFrame } = Handlers) ->
+  case OnWSFrame(State) of
+      {ok, State} -> {ok, Handlers#{state => State}, hibernate};
+      {reply, Frame, State} -> {reply, Frame, Handlers#{state => State}, hibernate}
+  end.
+
+websocket_info(Frame, #{state => State, on_info => OnInfo } = Handlers) ->
+  case OnInfo(State) of
+      {ok, State} -> {ok, Handlers#{state => State}, hibernate};
+      {reply, Frame, State} -> {reply, Frame, Handlers#{state => State}, hibernate}
+  end.
+
 read_entire_body(Req) ->
     read_entire_body([], Req).