Merge branch 'dev' into 'master'

Add event dispatch and the Client module

See merge request Mishio595/disml!4

16 files changed, 656 insertions, 181 deletions

diff --git a/bin/bot.ml b/bin/bot.ml
index bf9f36e..83e7063 100644
--- a/bin/bot.ml
+++ b/bin/bot.ml
@@ -1,20 +1,30 @@
-open Lwt.Infix
+open Async
+open Core
 open Disml
 
-let main sharder =
-    Lwt_engine.on_timer 60.0 true begin
-        fun _ev -> Sharder.set_status_with sharder @@ begin
-        fun shard ->
-            `String ("Current seq: " ^ string_of_int shard.seq)
-        end
-        >|= (fun _ -> print_endline "Status set!")
-        |> ignore;
-    end
+let main () =
+    let token = match Sys.getenv "DISCORD_TOKEN" with
+    | Some s -> s
+    | None -> failwith "No token"
+    in
+    let client = Client.make token in
+    Client.on "MESSAGE_CREATE" client (fun msg ->
+        let content = Yojson.Basic.Util.(member "content" msg |> to_string) in
+        let channel = Yojson.Basic.Util.(member "channel_id" msg |> to_string) in
+        if String.is_prefix ~prefix:"!?ping" content then
+            Http.create_message channel @@ `Assoc [
+                ("content", `String "Pong!");
+                ("tts", `Bool false);
+            ]
+            >>> fun _ -> print_endline "Message sent!";
+    );
+    Client.start client
+    >>> fun client ->
+    Clock.every
+    (Time.Span.create ~sec:60 ())
+    (fun () ->
+        Client.set_status_with client (fun shard -> `String ("Current seq: " ^ (Int.to_string shard.seq)))
+        |> ignore)
 
 let _ =
-    Sharder.start @@ Sys.getenv "DISCORD_TOKEN"
-    >>= (fun sharder ->
-    main sharder
-    |> ignore;
-    sharder.promise)
-    |> Lwt_main.run
\ No newline at end of file
+    Scheduler.go_main ~main ()
\ No newline at end of file
diff --git a/dune b/dune
index b8d2700..2b4861d 100644
--- a/dune
+++ b/dune
@@ -1,14 +1,14 @@
 (library
 	(name disml)
 	(modules endpoints http client sharder opcode)
-	(libraries lwt cohttp cohttp.lwt yojson websocket websocket-lwt-unix zlib)
+	(libraries core async_ssl cohttp-async yojson websocket-async zlib)
 )
 
 ; Test executable
 (executable
     (name bot)
 	(modules bot)
-    (libraries lwt disml)
+    (libraries core async disml)
 )
 
 (include_subdirs unqualified)
\ No newline at end of file
diff --git a/dune-project b/dune-project
index bb44e3a..31a7429 100644
--- a/dune-project
+++ b/dune-project
@@ -1,3 +1 @@
 (lang dune 1.3)
-(name animus)
-(version 0.1.0)
diff --git a/lib/client/client.ml b/lib/client/client.ml
index b1f6f25..e07e348 100644
--- a/lib/client/client.ml
+++ b/lib/client/client.ml
@@ -1,5 +1,80 @@
-let notify t data =
-    Yojson.Basic.pretty_print Format.std_formatter @@ `Assoc data;
-    print_newline ();
-    print_endline t;
-    ()
\ No newline at end of file
+open Async
+
+type t = {
+    sharder: Sharder.t Ivar.t;
+    (* events: (Events.t, Core_kernel.write) Bvar.t list; *)
+    mutable handler: Sharder.handler;
+    token: string;
+}
+
+let make ?handler token =
+    let handler = match handler with
+    | Some h -> h
+    | None -> begin
+        Sharder.{
+            ready = None;
+            resumed = None;
+            channel_create = None;
+            channel_delete = None;
+            channel_update = None;
+            channel_pins_update = None;
+            guild_create = None;
+            guild_delete = None;
+            guild_update = None;
+            guild_ban_add = None;
+            guild_ban_remove = None;
+            guild_emojis_update = None;
+            guild_integrations_update = None;
+            guild_member_add = None;
+            guild_member_remove = None;
+            guild_member_update = None;
+            guild_members_chunk = None;
+            guild_role_create = None;
+            guild_role_delete = None;
+            guild_role_update = None;
+            message_create = None;
+            message_delete = None;
+            message_update = None;
+            message_delete_bulk = None;
+            message_reaction_add = None;
+            message_reaction_remove = None;
+            message_reaction_remove_all = None;
+            presence_update = None;
+            typing_start = None;
+            user_update = None;
+            voice_state_update = None;
+            voice_server_update = None;
+            webhooks_update = None;
+        }
+    end in
+    {
+        sharder = Ivar.create ();
+        handler;
+        token;
+    }
+
+let start ?count client =
+    Sharder.start ?count ~handler:client.handler client.token
+    >>| fun sharder ->
+    Ivar.fill_if_empty client.sharder sharder;
+    client
+
+let on ev client fn =
+    match ev with
+    | "MESSAGE_CREATE" -> client.handler <- { client.handler with message_create = Some(fn) }
+    | _ -> ()
+
+let set_status client status =
+    Ivar.read client.sharder
+    >>= fun sharder ->
+    Sharder.set_status sharder status
+
+let set_status_with client f =
+    Ivar.read client.sharder
+    >>= fun sharder ->
+    Sharder.set_status_with sharder f
+
+let request_guild_members ~guild ?query ?limit client =
+    Ivar.read client.sharder
+    >>= fun sharder ->
+    Sharder.request_guild_members ~guild ?query ?limit sharder
\ No newline at end of file
diff --git a/lib/client/sharder.ml b/lib/client/sharder.ml
index 18d1da0..652358f 100644
--- a/lib/client/sharder.ml
+++ b/lib/client/sharder.ml
@@ -1,51 +1,77 @@
-open Lwt.Infix
-open Websocket
+open Async
+open Core
+open Websocket_async
 
 exception Invalid_Payload
-exception Invalid_Shards
 
-type data = {
-    shards: int list;
-    token: string;
-    url: string;
+type handler = {
+    ready: (Yojson.Basic.json -> unit) option;
+    resumed: (Yojson.Basic.json -> unit) option;
+    channel_create: (Yojson.Basic.json -> unit) option;
+    channel_delete: (Yojson.Basic.json -> unit) option;
+    channel_update: (Yojson.Basic.json -> unit) option;
+    channel_pins_update: (Yojson.Basic.json -> unit) option;
+    guild_create: (Yojson.Basic.json -> unit) option;
+    guild_delete: (Yojson.Basic.json -> unit) option;
+    guild_update: (Yojson.Basic.json -> unit) option;
+    guild_ban_add: (Yojson.Basic.json -> unit) option;
+    guild_ban_remove: (Yojson.Basic.json -> unit) option;
+    guild_emojis_update: (Yojson.Basic.json -> unit) option;
+    guild_integrations_update: (Yojson.Basic.json -> unit) option;
+    guild_member_add: (Yojson.Basic.json -> unit) option;
+    guild_member_remove: (Yojson.Basic.json -> unit) option;
+    guild_member_update: (Yojson.Basic.json -> unit) option;
+    guild_members_chunk: (Yojson.Basic.json -> unit) option; (* Not sure if this should be exposed *)
+    guild_role_create: (Yojson.Basic.json -> unit) option;
+    guild_role_delete: (Yojson.Basic.json -> unit) option;
+    guild_role_update: (Yojson.Basic.json -> unit) option;
+    message_create: (Yojson.Basic.json -> unit) option;
+    message_delete: (Yojson.Basic.json -> unit) option;
+    message_update: (Yojson.Basic.json -> unit) option;
+    message_delete_bulk: (Yojson.Basic.json -> unit) option;
+    message_reaction_add: (Yojson.Basic.json -> unit) option;
+    message_reaction_remove: (Yojson.Basic.json -> unit) option;
+    message_reaction_remove_all: (Yojson.Basic.json -> unit) option;
+    presence_update: (Yojson.Basic.json -> unit) option;
+    typing_start: (Yojson.Basic.json -> unit) option;
+    user_update: (Yojson.Basic.json -> unit) option;
+    voice_state_update: (Yojson.Basic.json -> unit) option;
+    voice_server_update: (Yojson.Basic.json -> unit) option;
+    webhooks_update: (Yojson.Basic.json -> unit) option;
 }
 
 module Shard = struct
     type t = {
-        mutable hb: Lwt_engine.event option;
+        mutable hb: unit Ivar.t option;
         mutable seq: int;
         mutable session: string option;
+        mutable handler: handler;
         token: string;
-        shard: int list;
-        send: Frame.t -> unit Lwt.t;
-        recv: unit -> Frame.t Lwt.t;
-        ready: unit Lwt.t;
+        shard: int * int;
+        write: string Pipe.Writer.t;
+        read: string Pipe.Reader.t;
+        ready: unit Ivar.t;
     }
 
-    let id_rt = Lwt_mutex.create ()
+    let identify_lock = Mutex.create ()
 
-    let parse (frame : Frame.t) =
-        frame.content
-        |> Yojson.Basic.from_string
+    let parse frame =
+        match frame with
+        | `Ok s -> Yojson.Basic.from_string s
+        | `Eof -> raise Invalid_Payload
 
-    let encode term =
-        let content = term |> Yojson.Basic.to_string in
-        Frame.create ~content ()
-
-    let push_frame ?payload shard (ev : Opcode.t) =
+    let push_frame ?payload shard ev =
         print_endline @@ "Pushing frame. OP: " ^ Opcode.to_string @@ ev;
         let content = match payload with
-        | None -> None
+        | None -> ""
         | Some p ->
-            Some (Yojson.Basic.to_string @@ `Assoc [
+            Yojson.Basic.to_string @@ `Assoc [
             ("op", `Int (Opcode.to_int ev));
             ("d", p);
-            ])
+            ]
         in
-        let frame = Frame.create ?content () in
-        print_endline @@ Frame.show frame;
-        shard.send frame
-        >|= fun () ->
+        Pipe.write shard.write content
+        >>| fun () ->
         shard
 
     let heartbeat shard =
@@ -59,24 +85,184 @@ module Shard = struct
         ] in
         push_frame ~payload shard HEARTBEAT
 
-    let dispatch shard payload resolver =
-        let t = List.assoc "t" payload
-        |> Yojson.Basic.Util.to_string in
-        let seq = List.assoc "s" payload
-        |> Yojson.Basic.Util.to_int in
-        let data = List.assoc "d" payload
-        |> Yojson.Basic.Util.to_assoc in
+    let dispatch shard payload =
+        let module J = Yojson.Basic.Util in
+        let seq = J.(member "s" payload |> to_int) in
         shard.seq <- seq;
+        let t = J.(member "t" payload |> to_string) in
+        let data = J.member "d" payload in
         let _ = match t with
-        | "READY" ->
-            Lwt.wakeup resolver ();
-            let session = List.assoc "session_id" data
-            |> Yojson.Basic.Util.to_string in
+        | "READY" -> begin
+            Ivar.fill_if_empty shard.ready ();
+            let session = J.(member "session_id" data |> to_string) in
             shard.session <- Some session;
+            match shard.handler.ready with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "RESUMED" -> begin
+            match shard.handler.resumed with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "CHANNEL_CREATE" -> begin
+            match shard.handler.channel_create with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "CHANNEL_DELETE" -> begin
+            match shard.handler.channel_delete with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "CHANNEL_UPDATE" -> begin
+            match shard.handler.channel_update with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "CHANNEL_PINS_UPDATE" -> begin
+            match shard.handler.channel_pins_update with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "GUILD_CREATE" -> begin
+            match shard.handler.guild_create with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "GUILD_DELETE" -> begin
+            match shard.handler.guild_delete with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "GUILD_UPDATE" -> begin
+            match shard.handler.guild_update with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "GUILD_BAN_ADD" -> begin
+            match shard.handler.guild_ban_add with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "GUILD_BAN_REMOVE" -> begin
+            match shard.handler.guild_ban_remove with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "GUILD_EMOJIS_UPDATE" -> begin
+            match shard.handler.guild_emojis_update with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "GUILD_INTEGRATIONS_UPDATE" -> begin
+            match shard.handler.guild_integrations_update with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "GUILD_MEMBER_ADD" -> begin
+            match shard.handler.guild_member_add with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "GUILD_MEMBER_REMOVE" -> begin
+            match shard.handler.guild_member_remove with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "GUILD_MEMBER_UPDATE" -> begin
+            match shard.handler.guild_member_update with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "GUILD_MEMBERS_CHUNK" -> begin
+            match shard.handler.guild_members_chunk with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "GUILD_ROLE_CREATE" -> begin
+            match shard.handler.guild_role_create with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "GUILD_ROLE_DELETE" -> begin
+            match shard.handler.guild_role_delete with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "GUILD_ROLE_UPDATE" -> begin
+            match shard.handler.guild_role_update with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "MESSAGE_CREATE" -> begin
+            match shard.handler.message_create with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "MESSAGE_DELETE" -> begin
+            match shard.handler.message_delete with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "MESSAGE_UPDATE" -> begin
+            match shard.handler.message_update with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "MESSAGE_DELETE_BULK" -> begin
+            match shard.handler.message_delete_bulk with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "MESSAGE_REACTION_ADD" -> begin
+            match shard.handler.message_reaction_add with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "MESSAGE_REACTION_REMOVE" -> begin
+            match shard.handler.message_reaction_remove with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "MESSAGE_REACTION_REMOVE_ALL" -> begin
+            match shard.handler.message_reaction_remove_all with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "PRESENCE_UPDATE" -> begin
+            match shard.handler.presence_update with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "TYPING_START" -> begin
+            match shard.handler.typing_start with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "USER_UPDATE" -> begin
+            match shard.handler.user_update with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "VOICE_STATE_UPDATE" -> begin
+            match shard.handler.voice_state_update with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "VOICE_SERVER_UPDATE" -> begin
+            match shard.handler.voice_server_update with
+            | Some f -> f data
+            | None -> ()
+            end
+        | "WEBHOOKS_UPDATE" -> begin
+            match shard.handler.webhooks_update with
+            | Some f -> f data
+            | None -> ()
+            end
         | _ -> ()
         in
-        Client.notify t data;
-        Lwt.return shard
+        return shard
 
     let set_status shard status =
         let payload = match status with
@@ -102,7 +288,8 @@ module Shard = struct
             ]
         | _ -> raise Invalid_Payload
         in
-        shard.ready >|= fun _ -> push_frame ~payload shard STATUS_UPDATE
+        Ivar.read shard.ready >>= fun _ ->
+        push_frame ~payload shard STATUS_UPDATE
 
     let request_guild_members ~guild ?(query="") ?(limit=0) shard =
         let payload = `Assoc [
@@ -110,28 +297,28 @@ module Shard = struct
             ("query", `String query);
             ("limit", `Int limit);
         ] in
-        shard.ready >|= fun _ -> push_frame ~payload shard REQUEST_GUILD_MEMBERS
-
-
+        Ivar.read shard.ready >>= fun _ ->
+        push_frame ~payload shard REQUEST_GUILD_MEMBERS
 
     let initialize shard data =
-        print_endline "Initializing...";
+        let module J = Yojson.Basic.Util in
         let hb = match shard.hb with
         | None -> begin
-            let hb_interval = List.assoc "heartbeat_interval" @@
-                Yojson.Basic.Util.to_assoc data
-                |> Yojson.Basic.Util.to_int
-            in
-            Lwt_engine.on_timer
-            (Float.of_int hb_interval /. 1000.0)
-            true
-            (fun _ev -> heartbeat shard |> ignore)
+            let hb_interval = J.(member "heartbeat_interval" data |> to_int) in
+            let finished = Ivar.create () in
+            Clock.every'
+            ~continue_on_error:true
+            ~finished
+            (Core.Time.Span.create ~ms:hb_interval ())
+            (fun () -> heartbeat shard >>= fun _ -> return ());
+            finished
         end
         | Some s -> s
         in
         shard.hb <- Some hb;
-        Lwt_mutex.lock id_rt
-        >>= fun () ->
+        Mutex.lock identify_lock;
+        let (cur, max) = shard.shard in
+        let shards = [`Int cur; `Int max] in
         match shard.session with
         | None ->
             let payload = `Assoc [
@@ -143,7 +330,7 @@ module Shard = struct
                 ]);
                 ("compress", `Bool false); (* TODO add compression handling*)
                 ("large_threshold", `Int 250);
-                ("shard", `List (List.map (fun i -> `Int i) shard.shard))
+                ("shard", `List shards);
             ] in
             push_frame ~payload shard IDENTIFY
         | Some s ->
@@ -153,119 +340,127 @@ module Shard = struct
                 ("seq", `Int shard.seq)
             ] in
             push_frame ~payload shard RESUME
-        >|= fun s ->
-        Lwt_engine.on_timer 5.0 false (fun _ -> Lwt_mutex.unlock id_rt)
+        >>| fun s ->
+        Clock.after (Core.Time.Span.create ~sec:5 ())
+        >>| (fun _ -> Mutex.unlock identify_lock)
         |> ignore;
         s
 
-    let handle_frame shard (term : Yojson.Basic.json) resolver =
-        match term with
-        | `Assoc term -> begin
-            (* Yojson.Basic.pretty_print Format.std_formatter @@ `Assoc term;
-            print_newline (); *)
-            let op = List.assoc "op" term
-            |> Yojson.Basic.Util.to_int
+    let handle_frame shard term =
+        let module J = Yojson.Basic.Util in
+        let op = J.(member "op" term |> to_int)
             |> Opcode.from_int
-            in
-            match op with
-            | DISPATCH -> dispatch shard term resolver
-            | HEARTBEAT -> heartbeat shard
-            | RECONNECT -> print_endline "OP 7"; Lwt.return shard (* TODO reconnect *)
-            | INVALID_SESSION -> print_endline "OP 9"; Lwt.return shard (* TODO invalid session *)
-            | HELLO -> initialize shard @@ List.assoc "d" term
-            | HEARTBEAT_ACK -> Lwt.return shard
-            | opcode ->
-                print_endline @@ "Invalid Opcode:" ^ Opcode.to_string opcode;
-                Lwt.return shard
-        end
-        | _ ->
-            print_endline "Invalid payload";
-            Lwt.return shard
+        in
+        match op with
+        | DISPATCH -> dispatch shard term
+        | HEARTBEAT -> heartbeat shard
+        | RECONNECT -> print_endline "OP 7"; return shard (* TODO reconnect *)
+        | INVALID_SESSION -> print_endline "OP 9"; return shard (* TODO invalid session *)
+        | HELLO -> initialize shard @@ J.member "d" term
+        | HEARTBEAT_ACK -> return shard
+        | opcode ->
+            print_endline @@ "Invalid Opcode:" ^ Opcode.to_string opcode;
+            return shard
 
-    let create data =
-        let uri = (data.url ^ "?v=6&encoding=json") |> Uri.of_string in
-        let http_uri = Uri.with_scheme uri (Some "https") in
-        let headers = Http.Base.process_request_headers () in
-        Resolver_lwt.resolve_uri ~uri:http_uri Resolver_lwt_unix.system >>= fun endp ->
-        let ctx = Conduit_lwt_unix.default_ctx in
-        Conduit_lwt_unix.endp_to_client ~ctx endp >>= fun client ->
-        Websocket_lwt_unix.with_connection
-            ~extra_headers:headers
-            client
-            uri
-        >>= fun (recv, send) ->
-        let (ready, ready_resolver) = Lwt.task () in
-        let rec recv_forever s = begin
-            s.recv ()
-            >>= fun frame ->
-            let p = parse frame in
-            handle_frame s p ready_resolver
-            >>= fun s -> recv_forever s
-        end in
-        let shard = {
-            send;
-            recv;
-            ready;
-            hb = None;
-            seq = 0;
-            shard = data.shards;
-            session = None;
-            token = data.token;
-        } in
-        Lwt.return (shard, recv_forever shard)
+    let create ~url ~shards ~token ~handler () =
+        let open Core in
+        let uri = (url ^ "?v=6&encoding=json") |> Uri.of_string in
+        let extra_headers = Http.Base.process_request_headers () in
+        let host = Option.value_exn ~message:"no host in uri" Uri.(host uri) in
+        let port =
+            match Uri.port uri, Uri_services.tcp_port_of_uri uri with
+            | Some p, _ -> p
+            | None, Some p -> p
+            | _ -> 443 in
+        let scheme = Option.value_exn ~message:"no scheme in uri" Uri.(scheme uri) in
+        let tcp_fun (r,w) =
+            let (read, write) = client_ez
+                ~extra_headers
+                uri r w
+            in
+            let rec ev_loop shard =
+                Pipe.read read
+                >>= fun frame ->
+                handle_frame shard @@ parse frame
+                >>= fun shard ->
+                ev_loop shard
+            in
+            let shard = {
+                read;
+                write;
+                handler;
+                ready = Ivar.create ();
+                hb = None;
+                seq = 0;
+                shard = shards;
+                session = None;
+                token = token;
+            }
+            in
+            ev_loop shard |> ignore;
+            return shard
+        in
+        match Unix.getaddrinfo host (string_of_int port) [] with
+        | [] -> failwithf "DNS resolution failed for %s" host ()
+        | { ai_addr; _ } :: _ ->
+            let addr =
+            match scheme, ai_addr with
+            | _, ADDR_UNIX path -> `Unix_domain_socket path
+            | "https", ADDR_INET (h, p)
+            | "wss", ADDR_INET (h, p) ->
+                let h = Ipaddr_unix.of_inet_addr h in
+                `OpenSSL (h, p, Conduit_async.V2.Ssl.Config.create ())
+            | _, ADDR_INET (h, p) ->
+                let h = Ipaddr_unix.of_inet_addr h in
+                `TCP (h, p)
+            in
+            Conduit_async.V2.connect addr >>= tcp_fun
 end
 
-type 'a t = {
-    shards: (Shard.t * 'a Lwt.t) list;
-    promise: 'a Lwt.t;
+type t = {
+    shards: Shard.t list;
 }
 
-let start ?count token =
-    Http.get_gateway_bot ()
-    >|= fun data ->
-    let data = Yojson.Basic.Util.to_assoc data in
-    let url = List.assoc "url" data
-    |> Yojson.Basic.Util.to_string in
+let start ?count ~handler token =
+    let module J = Yojson.Basic.Util in
+    Http.get_gateway_bot () >>= fun data ->
+    let url = J.(member "url" data |> to_string) in
     let count = match count with
     | Some c -> c
-    | None -> List.assoc "shards" data
-        |> Yojson.Basic.Util.to_int
+    | None -> J.(member "shards" data |> to_int)
     in
-    let shard_list = [0; count] in
-    let rec gen_shards l accum =
+    let shard_list = (0, count) in
+    let rec gen_shards l a =
         match l with
-        | [id; total;] when id < total ->
-            let shard_data = Lwt_main.run @@ Shard.create {
-                url;
-                shards = [id; total;];
-                token;
-            } in
-            shard_data :: gen_shards [id+1; total;] accum
-        | [_; _;] -> accum
-        | _ -> raise Invalid_Shards
+        | (id, total) when id >= total -> return a
+        | (id, total) ->
+            Shard.create ~url ~shards:(id, total) ~token ~handler ()
+            >>= fun shard ->
+            let a = shard :: a in
+            gen_shards (id+1, total) a
     in
-    let shards = gen_shards shard_list [] in
-    let p_list = List.map (fun (_, loop) -> loop) shards in
-    let promise = Lwt.choose p_list in
+    gen_shards shard_list []
+    >>| fun shards ->
     {
         shards;
-        promise;
     }
 
 let set_status sharder status =
-    List.map (fun (shard, _) ->
+    Deferred.all @@ List.map ~f:(fun shard ->
         Shard.set_status shard status
     ) sharder.shards
-    |> Lwt.nchoose
 
 let set_status_with sharder f =
-    List.map (fun (shard, _) ->
+    Deferred.all @@ List.map ~f:(fun shard ->
         Shard.set_status shard @@ f shard
     ) sharder.shards
-    |> Lwt.nchoose
 
 let request_guild_members ~guild ?query ?limit sharder =
-    List.map (fun (shard, _) ->
+    Deferred.all @@ List.map ~f:(fun shard ->
         Shard.request_guild_members ~guild ?query ?limit shard
     ) sharder.shards
-    |> Lwt.nchoose
\ No newline at end of file
+
+let update_handler sharder handler =
+    List.iter ~f:(fun shard ->
+        shard.handler <- handler
+    ) sharder.shards
\ No newline at end of file
diff --git a/lib/client/sharder.mli b/lib/client/sharder.mli
new file mode 100644
index 0000000..b49c264
--- /dev/null
+++ b/lib/client/sharder.mli
@@ -0,0 +1,138 @@
+open Async
+
+(**
+Record type for registering event handlers
+*)
+type handler = {
+    ready: (Yojson.Basic.json -> unit) option;
+    resumed: (Yojson.Basic.json -> unit) option;
+    channel_create: (Yojson.Basic.json -> unit) option;
+    channel_delete: (Yojson.Basic.json -> unit) option;
+    channel_update: (Yojson.Basic.json -> unit) option;
+    channel_pins_update: (Yojson.Basic.json -> unit) option;
+    guild_create: (Yojson.Basic.json -> unit) option;
+    guild_delete: (Yojson.Basic.json -> unit) option;
+    guild_update: (Yojson.Basic.json -> unit) option;
+    guild_ban_add: (Yojson.Basic.json -> unit) option;
+    guild_ban_remove: (Yojson.Basic.json -> unit) option;
+    guild_emojis_update: (Yojson.Basic.json -> unit) option;
+    guild_integrations_update: (Yojson.Basic.json -> unit) option;
+    guild_member_add: (Yojson.Basic.json -> unit) option;
+    guild_member_remove: (Yojson.Basic.json -> unit) option;
+    guild_member_update: (Yojson.Basic.json -> unit) option;
+    guild_members_chunk: (Yojson.Basic.json -> unit) option; (* Not sure if this should be exposed *)
+    guild_role_create: (Yojson.Basic.json -> unit) option;
+    guild_role_delete: (Yojson.Basic.json -> unit) option;
+    guild_role_update: (Yojson.Basic.json -> unit) option;
+    message_create: (Yojson.Basic.json -> unit) option;
+    message_delete: (Yojson.Basic.json -> unit) option;
+    message_update: (Yojson.Basic.json -> unit) option;
+    message_delete_bulk: (Yojson.Basic.json -> unit) option;
+    message_reaction_add: (Yojson.Basic.json -> unit) option;
+    message_reaction_remove: (Yojson.Basic.json -> unit) option;
+    message_reaction_remove_all: (Yojson.Basic.json -> unit) option;
+    presence_update: (Yojson.Basic.json -> unit) option;
+    typing_start: (Yojson.Basic.json -> unit) option;
+    user_update: (Yojson.Basic.json -> unit) option;
+    voice_state_update: (Yojson.Basic.json -> unit) option;
+    voice_server_update: (Yojson.Basic.json -> unit) option;
+    webhooks_update: (Yojson.Basic.json -> unit) option;
+}
+
+(**
+Represents a single Shard. Manual creation is discouraged; use Sharder.start instead
+*)
+module Shard : sig
+    type t = {
+        mutable hb: unit Ivar.t option;
+        mutable seq: int;
+        mutable session: string option;
+        mutable handler: handler;
+        token: string;
+        shard: int * int;
+        write: string Pipe.Writer.t;
+        read: string Pipe.Reader.t;
+        ready: unit Ivar.t;
+    }
+
+    val parse :
+        [< `Ok of string | `Eof] ->
+        Yojson.Basic.json
+
+    val push_frame :
+        ?payload:Yojson.Basic.json ->
+        t ->
+        Opcode.t ->
+        t Deferred.t
+
+    val heartbeat :
+        t ->
+        t Deferred.t
+
+    val dispatch :
+        t ->
+        Yojson.Basic.json ->
+        t Deferred.t
+
+    val set_status :
+        t ->
+        Yojson.Basic.json ->
+        t Deferred.t
+
+    val request_guild_members :
+        guild:int ->
+        ?query:string ->
+        ?limit:int ->
+        t ->
+        t Deferred.t
+
+    val initialize :
+        t ->
+        Yojson.Basic.json ->
+        t Deferred.t
+
+    val handle_frame :
+        t ->
+        Yojson.Basic.json ->
+        t Deferred.t
+
+    val create :
+        url:string ->
+        shards:int * int ->
+        token:string ->
+        handler: handler ->
+        unit ->
+        t Deferred.t
+end
+
+type t = {
+    shards: Shard.t list;
+}
+
+val start :
+    ?count:int ->
+    handler:handler ->
+    string ->
+    t Deferred.t
+
+val set_status :
+    t ->
+    Yojson.Basic.json ->
+    Shard.t list Deferred.t
+
+val set_status_with :
+    t ->
+    (Shard.t -> Yojson.Basic.json) ->
+    Shard.t list Deferred.t
+
+val request_guild_members :
+    guild:int ->
+    ?query:string ->
+    ?limit:int ->
+    t ->
+    Shard.t list Deferred.t
+
+val update_handler :
+    t ->
+    handler ->
+    unit
\ No newline at end of file
diff --git a/lib/http.ml b/lib/http.ml
index b6b0298..8d0b679 100644
--- a/lib/http.ml
+++ b/lib/http.ml
@@ -1,6 +1,5 @@
-open Lwt.Infix
+open Async
 open Cohttp
-open Cohttp_lwt_unix
 
 module Base = struct
     exception Invalid_Method
@@ -14,30 +13,31 @@ module Base = struct
     let process_request_body body =
         body
         |> Yojson.Basic.to_string
-        |> Cohttp_lwt.Body.of_string
+        |> Cohttp_async.Body.of_string
 
     let process_request_headers () =
-        let token = try
-            Sys.getenv "DISCORD_TOKEN"
-        with Not_found -> failwith "Please provide a token" in
+        let token = match Sys.getenv "DISCORD_TOKEN" with
+        | Some t -> t
+        | None -> failwith "Please provide a token"
+        in
         let h = Header.init_with "User-Agent" "Dis.ml v0.1.0" in
         let h = Header.add h "Authorization" ("Bot " ^ token) in
         Header.add h "Content-Type" "application/json"
 
     (* TODO Finish processor *)
     let process_response (_resp, body) =
-        body |> Cohttp_lwt.Body.to_string >|= Yojson.Basic.from_string
+        body |> Cohttp_async.Body.to_string >>| Yojson.Basic.from_string
 
     let request ?(body=`Null) m path =
         let uri = process_url path in
         let headers = process_request_headers () in
         let body = process_request_body body in
         (match m with
-        | `DELETE -> Client.delete ~headers ~body uri
-        | `GET -> Client.get ~headers uri
-        | `PATCH -> Client.patch ~headers ~body uri
-        | `POST -> Client.post ~headers ~body uri
-        | `PUT -> Client.put ~headers ~body uri
+        | `DELETE -> Cohttp_async.Client.delete ~headers ~body uri
+        | `GET -> Cohttp_async.Client.get ~headers uri
+        | `PATCH -> Cohttp_async.Client.patch ~headers ~body uri
+        | `POST -> Cohttp_async.Client.post ~headers ~body uri
+        | `PUT -> Cohttp_async.Client.put ~headers ~body uri
         | _ -> raise Invalid_Method)
         >>= process_response
 end
diff --git a/lib/model/channel.ml b/lib/model/channel.ml
new file mode 100644
index 0000000..eb6679e
--- /dev/null
+++ b/lib/model/channel.ml
@@ -0,0 +1 @@
+type t
\ No newline at end of file
diff --git a/lib/model/emoji.ml b/lib/model/emoji.ml
new file mode 100644
index 0000000..eb6679e
--- /dev/null
+++ b/lib/model/emoji.ml
@@ -0,0 +1 @@
+type t
\ No newline at end of file
diff --git a/lib/model/guild.ml b/lib/model/guild.ml
new file mode 100644
index 0000000..6345c17
--- /dev/null
+++ b/lib/model/guild.ml
@@ -0,0 +1,26 @@
+type t = {
+    afk_channel_id: int option;
+    afk_timeout: int;
+    application_id: int option;
+    channels: Channel.t list;
+    default_message_notifications: int;
+    emojis: Emoji.t list;
+    explicit_content_filter: int;
+    features: string list;
+    icon: string option;
+    id: int;
+    joined_at: string;
+    large: bool;
+    member_count: int;
+    members: Member.t list;
+    mfa_level: int;
+    name: string;
+    owner_id: int;
+    presences: Presence.t list;
+    region: string;
+    roles: Role.t list;
+    splash: string option;
+    system_channel_id: int option;
+    verification_level: int;
+    voice_states: VoiceState.t list;
+}
diff --git a/lib/model/member.ml b/lib/model/member.ml
new file mode 100644
index 0000000..eb6679e
--- /dev/null
+++ b/lib/model/member.ml
@@ -0,0 +1 @@
+type t
\ No newline at end of file
diff --git a/lib/model/message.ml b/lib/model/message.ml
new file mode 100644
index 0000000..eb6679e
--- /dev/null
+++ b/lib/model/message.ml
@@ -0,0 +1 @@
+type t
\ No newline at end of file
diff --git a/lib/model/presence.ml b/lib/model/presence.ml
new file mode 100644
index 0000000..eb6679e
--- /dev/null
+++ b/lib/model/presence.ml
@@ -0,0 +1 @@
+type t
\ No newline at end of file
diff --git a/lib/model/role.ml b/lib/model/role.ml
new file mode 100644
index 0000000..eb6679e
--- /dev/null
+++ b/lib/model/role.ml
@@ -0,0 +1 @@
+type t
\ No newline at end of file
diff --git a/lib/model/user.ml b/lib/model/user.ml
new file mode 100644
index 0000000..182ea6a
--- /dev/null
+++ b/lib/model/user.ml
@@ -0,0 +1,26 @@
+type t = {
+    id: int;
+    username: string;
+    discriminator: string;
+    avatar: string option;
+    bot: bool;
+}
+
+let from_json term =
+    let module J = Yojson.Basic.Util in
+    let id = J.member "id" term
+        |> J.to_string
+        |> int_of_string
+    in
+    let username = J.member "username" term
+        |> J.to_string in
+    let discriminator = J.member "discriminator" term
+        |> J.to_string in
+    let avatar = J.member "avatar" term
+        |> J.to_string_option in
+    let bot = J.member "bot" term
+        |> J.to_bool in
+    { id; username; discriminator; avatar; bot; }
+
+let tag user =
+    user.username ^ user.discriminator
diff --git a/lib/model/voiceState.ml b/lib/model/voiceState.ml
new file mode 100644
index 0000000..eb6679e
--- /dev/null
+++ b/lib/model/voiceState.ml
@@ -0,0 +1 @@
+type t
\ No newline at end of file