--- /dev/null
+! Copyright (C) 2023 Doug Coleman.
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors alien.syntax assocs base64 combinators
+crypto.xor endian http io io.encodings.string io.encodings.utf8
+kernel math math.bitwise multiline random sequences strings ;
+IN: http.websockets
+
+CONSTANT: websocket-version "13"
+
+: random-websocket-key ( -- base64 )
+ 16 random-bytes >base64 >string ;
+
+: add-websocket-upgrade-headers ( request -- request )
+ "connection" over header>> delete-at
+ websocket-version "Sec-WebSocket-Version" set-header
+ random-websocket-key "Sec-WebSocket-Key" set-header
+ ! websocket-extensions "Sec-WebSocket-Extensions" set-header
+ ! websocket-protocol "Sec-WebSocket-Protocol" set-header
+ "Upgrade" "Connection" set-header
+ "websocket" "Upgrade" set-header
+ "no-cache" "Pragma" set-header
+ "no-cache" "Cache-Control" set-header
+ "permessage-deflate; client_max_window_bits" "Sec-WebSocket-Extensions" set-header
+ dup url>> host>> "Host" set-header ;
+
+CONSTANT: websocket-opcode-continue-frame 0
+CONSTANT: websocket-opcode-text-frame 1
+CONSTANT: websocket-opcode-binary-frame 2
+CONSTANT: websocket-opcode-connection-close-frame 8
+CONSTANT: websocket-opcode-ping-frame 9
+CONSTANT: websocket-opcode-pong-frame 0xa
+
+ENUM: WEBSOCKET-CLOSE
+{ WEBSOCKET-CLOSE-NORMAL 1000 }
+{ WEBSOCKET-CLOSE-GOING-AWAY 1001 }
+{ WEBSOCKET-CLOSE-PROTOCOL-ERROR 1002 }
+{ WEBSOCKET-CLOSE-UNSUPPORTED-DATA 1003 }
+{ WEBSOCKET-CLOSE-RESERVED 1004 }
+{ WEBSOCKET-CLOSE-NO-STATUS-RECEIVED 1005 }
+{ WEBSOCKET-CLOSE-ABNORMAL-CLOSURE 1006 }
+{ WEBSOCKET-CLOSE-INVALID-FRAME-PAYLOAD-DATA 1007 }
+{ WEBSOCKET-CLOSE-PRIVACY-VIOLATION 1008 }
+{ WEBSOCKET-CLOSE-MESSAGE-TOO-BIG 1009 }
+{ WEBSOCKET-CLOSE-MANDATORY-EXT 1010 }
+{ WEBSOCKET-CLOSE-INTERNAL-SERVER-ERRO 1011 }
+{ WEBSOCKET-CLOSE-TLS-HANDSHAKE 1015 } ;
+
+: get-read-payload-length ( -- length masked? )
+ read1 [
+ {
+ { [ dup 125 <= ] [ ] }
+ { [ dup 126 = ] [ drop 2 read be> ] }
+ { [ dup 127 = ] [ drop 8 read be> ] }
+ } cond
+ ] [
+ 0x80 mask?
+ ] bi ;
+
+: get-write-payload-length ( bytes -- length-byte length-bytes/f )
+ length {
+ { [ dup 125 <= ] [ f ] }
+ { [ dup 0xffff <= ] [ [ drop 126 ] [ 2 >be ] bi ] }
+ [ [ drop 127 ] [ 8 >be ] bi ]
+ } cond ;
+
+! : send-websocket-fragmented ( bytes opcode -- ) 0b10000000 bitor
+
+: send-websocket-bytes ( bytes mask? opcode final? -- )
+ 0b10000000 0b0 ? bitor write1
+ [
+ [
+ get-write-payload-length [ 0x80 bitor ] dip
+ [ write1 ] [ [ write ] when* ] bi*
+ ] [
+ 4 random-bytes
+ [ write drop ]
+ [ xor-crypt [ write ] when* ] 2bi
+ ] bi
+ ] [
+ [ get-write-payload-length [ write1 ] [ [ write ] when* ] bi* ]
+ [ [ write ] when* ] bi
+ ] if flush ;
+
+: send-websocket-text ( bytes mask? opcode fin? -- )
+ [ utf8 encode ] 3dip send-websocket-bytes ;
+
+: read-payload ( -- payload )
+ get-read-payload-length [ [ 4 read ] dip read xor-crypt ] [ read ] if ;
+
+: send-pong ( payload -- )
+ t 0xa t send-websocket-bytes ;
+
+: send-masked-message ( payload -- )
+ t 0x1 t send-websocket-text ;
+
+: send-unmasked-message ( payload -- )
+ f 0x2 t send-websocket-text ;
+
+ERROR: unimplemented-opcode opcode message ;
+
+: read-websocket ( -- obj opcode loop? )
+ read1 [
+ ! [ 0x80 mask? drop ] [ 7 clear-bit ] bi
+ 7 clear-bit
+ [
+ {
+ { f [ "disconnected" f ] }
+ { 0 [ 0 "continuation frame" unimplemented-opcode t ] }
+ { 1 [ read-payload t ] }
+ { 2 [ read-payload utf8 decode t ] }
+ { 8 [ read-payload be> f ] }
+ { 9 [ read-payload [ send-pong ] keep t ] }
+ { 0xa [ read-payload t ] }
+ [ "fall-through" unimplemented-opcode ]
+ } case
+ ] keep swap
+ ] [
+ f f f
+ ] if* ;
+
+: read-websocket-loop ( quot: ( obj opcode -- loop? ) -- )
+ '[ read-websocket _ dip and ] loop ; inline
+
+![[
+: handle-websocket ( obj opcode -- loop? )
+ {
+ { f [ [ "closed with error, code %d" sprintf . flush ] with-global f ] }
+ { 1 [ [ [ hexdump. flush ] with-global ] when* t ] }
+ { 2 [ [ [ hexdump. flush ] with-global ] when* t ] }
+ { 8 [ [ "close received, code: %d" sprintf print flush ] with-global t ] }
+ { 9 [ [ [ "ping received" print hexdump. flush ] with-global ] when* t ] }
+ [ 2drop t ]
+ } case ;
+]]
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2023 Doug Coleman.
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors alien.syntax assocs calendar combinators
+formatting hashtables http http.client http.client.private
+http.websockets io io.encodings.string io.encodings.utf8 json
+kernel math multiline namespaces prettyprint random sequences
+threads tools.hexdump ;
+IN: discord
+
+CONSTANT: discord-api-url "https://discord.com/api/v10"
+CONSTANT: discord-bot-gateway "https://gateway.discord.gg/gateway/bot?v=10&encoding=json"
+
+TUPLE: discord-webhook url id token ;
+
+TUPLE: discord-bot-config
+ client-id client-secret
+ token application-id guild-id channel-id permissions ;
+
+TUPLE: discord-bot
+ config in out ui-stdout bot-thread heartbeat-thread
+ send-heartbeat? messages sequence-number
+ name application guilds user session_id resume_gateway_url ;
+
+: <discord-bot> ( in out config -- discord-bot )
+ discord-bot new
+ swap >>config
+ swap >>out
+ swap >>in
+ t >>send-heartbeat?
+ V{ } clone >>messages ;
+
+: add-discord-auth-header ( request -- request )
+ discord-bot-config get token>> "Bot " prepend "Authorization" set-header ;
+
+: add-json-header ( request -- request )
+ "application/json" "Content-Type" set-header ;
+
+: json-request ( request -- json ) http-request nip utf8 decode json> ;
+
+: >discord-url ( route -- url ) discord-api-url prepend ;
+: discord-get-request ( route -- request )
+ >discord-url <get-request> add-discord-auth-header ;
+: discord-get ( route -- json )
+ discord-get-request json-request ;
+: discord-post-request ( payload route -- request )
+ >discord-url <post-request> add-discord-auth-header ;
+: discord-post ( payload route -- json )
+ discord-post-request json-request ;
+: discord-post-json ( payload route -- json )
+ [ >json ] dip discord-post-request add-json-header json-request ;
+
+: bot-guild-join-uri ( discord-bot-config -- uri )
+ [ permissions>> ] [ client-id>> ] [ guild-id>> ] tri
+ "https://discord.com/oauth2/authorize?scope=bot&permissions=%d&client_id=%s&guild_id=%s" sprintf ;
+
+: gateway-identify-json ( -- json )
+ \ discord-bot get config>> token>> [[ {
+ "op": 2,
+ "d": {
+ "token": "%s",
+ "properties": {
+ "os": "darwin",
+ "browser": "discord.factor",
+ "device": "discord.factor"
+ },
+ "large_threshold": 250,
+ "intents": 3276541
+ }
+ }]] sprintf json> >json ;
+
+: jitter-millis ( heartbeat-millis -- millis ) 0 1 uniform-random-float * >integer ;
+
+: send-heartbeat ( seq/f -- )
+ json-null or "d" associate H{ { "op" 1 } } assoc-union!
+ >json send-masked-message ;
+
+: start-heartbeat-thread ( millis -- )
+ '[
+ _
+ [ jitter-millis sleep f send-heartbeat ]
+ [
+ milliseconds
+ '[
+ _ sleep discord-bot get
+ [ send-heartbeat?>> ] [ sequence-number>> ] bi
+ '[ _ send-heartbeat t ] [ f ] if
+ ] loop
+ ] bi
+ ] "discord-bot-heartbeat" spawn discord-bot get heartbeat-thread<< ;
+
+ENUM: discord-opcode
+ { DISPATCH 0 }
+ { HEARTBEAT 1 }
+ { IDENTIFY 2 }
+ { PRESENCE 3 }
+ { VOICE_STATE 4 }
+ { VOICE_PING 5 }
+ { RESUME 6 }
+ { RECONNECT 7 }
+ { REQUEST_MEMBERS 8 }
+ { INVALIDATE_SESSION 9 }
+ { HELLO 10 }
+ { HEARTBEAT_ACK 11 }
+ { GUILD_SYNC 12 } ;
+
+: handle-discord-DISPATCH ( json -- )
+ dup "t" of {
+ { "AUTOMOD_ACTION" [ drop ] }
+ { "AUTOMOD_RULE_CREATE" [ drop ] }
+ { "AUTOMOD_RULE_UPDATE" [ drop ] }
+ { "AUTOMOD_RULE_DELETE" [ drop ] }
+
+ { "CHANNEL_CREATE" [ drop ] }
+ { "CHANNEL_UPDATE" [ drop ] }
+ { "CHANNEL_DELETE" [ drop ] }
+ { "CHANNEL_PINS_UPDATE" [ drop ] }
+
+ { "GUILD_CREATE" [ drop ] }
+ { "GUILD_UPDATE" [ drop ] }
+ { "GUILD_EMOJIS_UPDATE" [ drop ] }
+ { "GUILD_STICKERS_UPDATE" [ drop ] }
+ { "GUILD_INTEGRATION_UPDATE" [ drop ] }
+ { "GUILD_CHANNEL_CREATE" [ drop ] }
+ { "GUILD_CHANNEL_UPDATE" [ drop ] }
+ { "GUILD_CHANNEL_DELETE" [ drop ] }
+ { "GUILD_CHANNEL_PINS_UPDATE" [ drop ] }
+ { "GUILD_JOIN" [ drop ] }
+ { "GUILD_REMOVE" [ drop ] }
+ { "GUILD_AVAILABLE" [ drop ] }
+ { "GUILD_UNAVAILABLE" [ drop ] }
+ { "GUILD_MEMBER_ADD" [ drop ] }
+ { "GUILD_MEMBER_REMOVE" [ drop ] }
+ { "GUILD_MEMBER_UPDATE" [ drop ] }
+ { "GUILD_BAN_ADD" [ drop ] }
+ { "GUILD_BAN_REMOVE" [ drop ] }
+ { "GUILD_ROLE_CREATE" [ drop ] }
+ { "GUILD_ROLE_UPDATE" [ drop ] }
+ { "GUILD_ROLE_DELETE" [ drop ] }
+
+ { "INVITE_CREATE" [ drop ] }
+ { "INVITE_DELETE" [ drop ] }
+
+ { "READY" [
+ discord-bot get swap
+ {
+ [ "user" of >>user ]
+ [ "session_id" of >>session_id ]
+ [ "application" of >>application ]
+ [ "guilds" of >>guilds ]
+ [ "resume_gateway_url" of >>resume_gateway_url ]
+ } cleave drop
+ ] }
+
+ { "MESSAGE_CREATE" [ drop ] }
+ { "MESSAGE_UPDATE" [ drop ] }
+ { "MESSAGE_EDIT" [ drop ] }
+ { "MESSAGE_DELETE" [ drop ] }
+
+ { "MESSAGE_REACTION_ADD" [ drop ] }
+ { "MESSAGE_REACTION_REMOVE" [ drop ] }
+
+ { "MEMBER_BAN" [ drop ] }
+ { "MEMBER_UNBAN" [ drop ] }
+ { "MEMBER_JOIN" [ drop ] }
+ { "MEMBER_REMOVE" [ drop ] }
+ { "MEMBER_UPDATE" [ drop ] }
+
+ { "PRESENCE_UPDATE" [ drop ] }
+
+ { "RAW_MESSAGE_EDIT" [ drop ] }
+ { "RAW_MESSAGE_DELETE" [ drop ] }
+
+ { "REACTION_ADD" [ drop ] }
+ { "REACTION_REMOVE" [ drop ] }
+ { "REACTION_CLEAR" [ drop ] }
+
+ { "SCHEDULED_EVENT_CREATE" [ drop ] }
+ { "SCHEDULED_EVENT_REMOVE" [ drop ] }
+ { "SCHEDULED_EVENT_UPDATE" [ drop ] }
+ { "SCHEDULED_EVENT_USER_ADD" [ drop ] }
+ { "SCHEDULED_EVENT_USER_REMOVE" [ drop ] }
+
+ { "SHARD_CONNECT" [ drop ] }
+ { "SHARD_DISCONNECT" [ drop ] }
+ { "SHARD_READY" [ drop ] }
+ { "SHARD_RESUMED" [ drop ] }
+
+ { "THREAD_CREATE" [ drop ] }
+ { "THREAD_JOIN" [ drop ] }
+ { "THREAD_UPDATE" [ drop ] }
+ { "THREAD_DELETE" [ drop ] }
+
+ { "THREAD_MEMBER_JOIN" [ drop ] }
+ { "THREAD_MEMBER_REMOVE" [ drop ] }
+
+ { "TYPING_START" [ drop ] }
+
+ { "USER_UPDATE" [ drop ] }
+ { "VOICE_STATE_UPDATE" [ drop ] }
+ { "VOICE_SERVER_UPDATE" [ drop ] }
+ { "WEBHOOKS_UPDATE" [ drop ] }
+ [ 2drop ]
+ } case ;
+
+: handle-discord-RESUME ( json -- ) drop ;
+
+: handle-discord-RECONNECT ( json -- ) drop ;
+
+: handle-discord-HELLO ( json -- )
+ "d" of "heartbeat_interval" of start-heartbeat-thread
+ gateway-identify-json send-masked-message ;
+
+: handle-discord-HEARTBEAT_ACK ( json -- ) drop ;
+
+: parse-discord-op ( json -- )
+ [ clone now "timestamp" pick set-at discord-bot get messages>> push ] keep
+ [ ] [ "s" of discord-bot get sequence-number<< ] [ "op" of ] tri {
+ { 0 [ handle-discord-DISPATCH ] }
+ { 6 [ handle-discord-RESUME ] }
+ { 7 [ handle-discord-RECONNECT ] }
+ { 10 [ handle-discord-HELLO ] }
+ { 11 [ handle-discord-HEARTBEAT_ACK ] }
+ [ 2drop ]
+ } case ;
+
+: handle-discord-websocket ( obj opcode -- loop? )
+ {
+ { f [ [ "closed with error, code %d" sprintf . flush ] with-global f ] }
+ { 1 [
+ [ [ hexdump. flush ] with-global ]
+ [ utf8 decode json> parse-discord-op ] bi
+ t
+ ] }
+ { 2 [ [ [ hexdump. flush ] with-global ] when* t ] }
+ { 8 [ [ drop "close received" print flush ] with-global t ] }
+ { 9 [ [ [ "ping received" print flush ] with-global send-heartbeat ] when* t ] }
+ [ 2drop t ]
+ } case ;
+
+: get-discord-user ( user -- json ) "/users/%s" sprintf discord-get ;
+: get-discord-users-me ( -- json ) "/users/@me" discord-get ;
+: get-discord-users-guilds ( -- json ) "/users/@me/guilds" discord-get ;
+: get-discord-users-guild-member ( guild-id -- json ) "/users/@me/guilds/%s/member" sprintf discord-get ;
+: get-discord-user-connections ( -- json ) "/users/@me/connections" discord-get ;
+: get-discord-user-application-role-connection ( application-id -- json )
+ "/users/@me/applications/%s/role-connection" sprintf discord-get ;
+: get-discord-channel ( channel-id -- json ) "/channels/%s" sprintf discord-get ;
+: get-discord-channel-pins ( channel-id -- json ) "/channels/%s/pins" sprintf discord-get ;
+: get-discord-channel-messages ( channel-id -- json ) "/channels/%s/messages" sprintf discord-get ;
+: get-discord-channel-message ( channel-id message-id -- json ) "/channels/%s/messages/%s" sprintf discord-get ;
+: send-discord-message ( hashtable channel-id -- json ) "/channels/%s/messages" sprintf discord-post-json ;
+
+: get-channel-webhooks ( channel-id -- json ) "/channels/%s/webhooks" sprintf discord-get ;
+: get-guild-webhooks ( guild-id -- json ) "/guilds/%s/webhooks" sprintf discord-get ;
+: get-webhook ( webhook-id -- json ) "/webhooks/%s" sprintf discord-get ;
+
+: get-guilds-me ( -- json ) "/users/@me/guilds" discord-get ;
+: get-guild-active-threads ( channel-id -- json ) "/guilds/%s/threads/active" sprintf discord-get ;
+: get-application-info ( -- json ) "/oauth2/applications/@me" discord-get ;
+
+: get-discord-gateway ( -- json ) "/gateway" discord-get ;
+: get-discord-bot-gateway ( -- json ) "/gateway/bot" discord-get ;
+
+: discord-connect ( config -- discord-bot )
+ \ discord-bot-config [
+ discord-bot-gateway <get-request>
+ add-websocket-upgrade-headers
+ add-discord-auth-header
+ [ drop ] do-http-request
+ [ in>> stream>> ] [ out>> stream>> ] bi
+ \ discord-bot-config get <discord-bot>
+ dup '[
+ _ \ discord-bot [
+ discord-bot get [ in>> ] [ out>> ] bi
+ [
+ [ handle-discord-websocket ] read-websocket-loop
+ ] with-streams
+ ] with-variable
+ ] "Discord Bot" spawn
+ >>bot-thread
+ ] with-variable ;
projects / factor.git / commitdiff