discord: don't reconnect in a loop, wait on a mailbox til disconnected

diff --git a/basis/http/websockets/websockets.factor b/basis/http/websockets/websockets.factor
index d3f450d5a5741ca7fde9d8dbd48fb8af56fcc124..04c2cdaedfb9e2469fac10a6fbe759e938b71a71 100644 (file)
--- a/basis/http/websockets/websockets.factor
+++ b/basis/http/websockets/websockets.factor
@@ -1,9 +1,9 @@
 ! 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 namespaces random sequences
-strings ;
+continuations crypto.xor endian http io io.encodings.string
+io.encodings.utf8 kernel math math.bitwise multiline namespaces
+random sequences strings ;
 IN: http.websockets
 
 CONSTANT: websocket-version "13"
@@ -103,24 +103,28 @@ ENUM: WEBSOCKET-CLOSE
 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
+    [
+        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*
     ] [
-        f f f
-    ] if* ;
+        drop f f f
+    ] recover ;
 
 : read-websocket-loop ( quot: ( obj opcode -- loop? ) -- )
     '[ read-websocket _ dip and ] loop ; inline

diff --git a/extra/discord/discord.factor b/extra/discord/discord.factor
index 5174ffd4b95171a30629b6e7765f9e7258993022..da1a82f6aca0b5c92a1a90b5948375cf616f2505 100644 (file)
--- a/extra/discord/discord.factor
+++ b/extra/discord/discord.factor
@@ -1,12 +1,13 @@
 ! Copyright (C) 2023 Doug Coleman.
 ! See https://factorcode.org/license.txt for BSD license.
 USING: accessors alien.syntax arrays assocs byte-arrays calendar
-combinators combinators.short-circuit continuations destructors
-formatting hashtables help http http.client http.websockets io
-io.encodings.string io.encodings.utf8 io.streams.string json
-kernel math multiline namespaces prettyprint
-prettyprint.sections random sequences sets splitting strings
-threads tools.hexdump unicode vocabs words ;
+combinators combinators.short-circuit concurrency.mailboxes
+continuations destructors formatting hashtables help http
+http.client http.websockets io io.encodings.string
+io.encodings.utf8 io.streams.string json kernel math multiline
+namespaces prettyprint prettyprint.sections random sequences
+sets splitting strings threads tools.hexdump unicode vocabs
+words ;
 IN: discord
 
 CONSTANT: discord-api-url "https://discord.com/api/v10"
@@ -19,7 +20,7 @@ TUPLE: discord-bot-config
     token application-id guild-id channel-id permissions
     user-callback obey-names
     metadata
-    discord-bot ;
+    discord-bot mailbox connect-thread ;
 
 TUPLE: discord-bot
     config in out bot-thread heartbeat-thread
@@ -430,6 +431,7 @@ DEFER: discord-reconnect
                     [ handle-discord-websocket discord-bot-config get discord-bot>> stop?>> not ] read-websocket-loop
                 ] with-streams
             ] with-variable
+            discord-bot-config get mailbox>> "disconnected" swap mailbox-put
         ] "Discord Bot" spawn >>bot-thread discord-bot-config get discord-bot<<
     ] if ;
 
@@ -443,13 +445,22 @@ M: discord-bot dispose
         [ f >>in f >>out drop ] tri
     ] with-destructors ;
 
+M: discord-bot-config dispose
+    discord-bot>> dispose ;
+
 : discord-connect ( config -- )
+    <mailbox> >>mailbox
     \ discord-bot-config [
         [
-            "connecting" g.
-            discord-reconnect discord-bot-config get discord-bot>>
-            [ reconnect?>> ] [ stop?>> not ] bi and
-        ] loop
+            [
+                "connecting" g.
+                discord-reconnect
+                discord-bot-config get
+                ! wait here for signal to maybe reconnect
+                [ mailbox>> mailbox-get ] [ discord-bot>> ] bi
+                [ reconnect?>> ] [ stop?>> not ] bi and
+            ] loop
+        ] "Discord bot connect loop" spawn discord-bot-config get connect-thread<<
     ] with-variable ;
 
 : reply-command ( json -- ? )