end-class ack-class

cmd-class class
    field: silent-last#
end-class msging-class

cmd-class class{ msg

    $value: id$
    field: peers[]
    field: keys[]
    field: log[]
    field: mode
    \ mode bits:
    0 5 bits: otr# chain# redate# lock# visible#

    log !time end-with dvcs-join, get-ip end-code ;

: dvcs-connect ( addr u -- )
    dvcs-bufs# chat#-connect? IF  2 dvcs-request# !  dvcs-greet  THEN ;

: dvcs-connect-key ( addr u -- )
    key>group ?load-msgn
    dup 0= IF  2drop "" msg-group$ $@ msg-groups #!  THEN
    2dup search-connect ?dup-IF  >o +group rdrop 2drop  EXIT  THEN
    \ check for disconnected here or in pk-peek?
    2dup pk-peek?  IF  dvcs-connect  ELSE  2drop  THEN ;

: dvcs-connects? ( -- flag )
    chat-keys ['] dvcs-connect-key $[]map dvcs-request# @ 0> ;

    end-code| -setip net2o:send-replace  announced on ;

\ NAT retraversal

Forward insert-addr ( o -- )

: renat ( -- )
    msg-groups [:
      cell+ $@ bounds ?DO
	  I @ >o o-beacon pings
	  \ !!FIXME!! should maybe do a re-lookup?
	  ret-addr $10 erase  dest-0key dest-0key> !
	  punch-addrs $@ bounds ?DO
	      I @ insert-addr IF
		  o to connection
		  net2o-code new-request true gen-punchload gen-punch

Forward pk-peek? ( addr u0 -- flag )

: ?hash ( addr u hash -- ) >r
    2dup r@ #@ d0= IF  "" 2swap r> #!  ELSE  2drop rdrop  THEN ;

: >group ( addr u -- )
    2dup msg-group# #@ d0= IF

	net2o:new-msg cell- [ msg-class >osize @ cell+ ]L
	2over msg-group# #!
    THEN  last# cell+ $@ drop cell+ to msg-group-o

    msg-groups ?hash ;


: avalanche-msg ( msg u1 o:connect -- )
    \G forward message to all next nodes of that message group
    { d: msg }
    last# cell+ $@ dup IF
	bounds ?DO  I @ o <> IF  msg I @ .avalanche-to  THEN
	cell +LOOP
    ELSE  2drop  THEN ;


Variable msg-group$
Variable group-master
Variable msg-logs
Variable otr-mode
Variable chain-mode
Variable redate-mode
Variable lock-mode
Variable msg-keys[]
User replay-mode

    msgt ['] msg:display catch IF  ." invalid entry"  cr  2drop  THEN
    o> ;

Forward silent-join

\ !!FIXME!! should use an asynchronous "do-when-connected" thing

: +unique-con ( -- ) o last# cell+ +unique$ ;
Forward +chat-control

: chat-silent-join ( -- )
    reconnect( ." silent join " o hex. connection hex. cr )
    o to connection
    ?msg-context >o silent-last# @ to last# o>
    reconnect( ." join: " last# $. cr )

    $> >group ;
+net2o: msg-join ( $:group -- ) \g join a chat group
    $> >load-group parent >o
    +unique-con +chat-control
    wait-task @ ?dup-IF  <hide>  THEN
    o> ;
+net2o: msg-leave ( $:group -- ) \g leave a chat group
    $> msg-groups #@ d0<> IF
	parent last# cell+ del$cell  THEN ;
+net2o: msg-reconnect ( $:pubkey+addr -- ) \g rewire distribution tree
    $> $make
    <event last-msg 2@ e$, elit, o elit, last# elit, :>chat-reconnect
    parent .wait-task @ ?query-task over select event> ;
+net2o: msg-last? ( start end n -- ) 64>n msg:last? ;
+net2o: msg-last ( $:[tick0,msgs,..tickn] n -- ) 64>n msg:last ;

: send-leave ( -- )
    connection .data-rmap IF  net2o-code expect-msg leave, end-code|  THEN ;
: send-silent-leave ( -- )
    connection .data-rmap IF  net2o-code expect-msg silent-leave, end-code|  THEN ;

: [group] ( xt -- flag )
    msg-group$ $@ msg-groups #@ IF
	@ >o ?msg-context .execute o> true
    ELSE
	drop "" msg-group$ $@ msg-groups #!
	0 .execute false
    THEN ;
: .chat ( addr u -- )
    [: last# >r o IF  2dup do-msg-nestsig
      ELSE  2dup display-one-msg  THEN  r> to last#
      0 .avalanche-msg ;] [group] drop notify- ;

    version-string forth:type '-' forth:emit
    machine forth:type ;

forward avalanche-text

false value away?




also net2o-base scope: /chat

: /me ( addr u -- )
    \U me <action>          send string as action
    \G me: send remaining string as action
    [: $, msg-action ;] send-avalanche ;

	."  chain mode ==="
    ELSE  <err> ." only 'chain on|off' are allowed" rdrop  THEN
    <default> forth:cr ;

: /peers ( addr u -- ) 2drop
    \U peers                list peers
    \G peers: list peers in all groups
    msg-groups [: dup $@ .group ." : "
      cell+ $@ bounds ?DO
	  space I @ >o .con-id space
	  ack@ .rtdelay 64@ 64>f 1n f* (.time) o>
      cell +LOOP  forth:cr ;] #map ;

: /gps ( addr u -- ) 2drop
    \U gps                  send coordinates
    \G gps: send your coordinates
    coord! coord@ 2dup 0 -skip nip 0= IF  2drop
    ELSE
	[: $, msg-coord ;] send-avalanche

    \U invitations          handle invitations
    \G invitations: handle invitations: accept, ignore or block invitations
    2drop .invitations ;

: /chats ( addr u -- ) 2drop ." ===== chats: "
    \U chats                list chats
    \G chats: list all chats
    msg-groups [: >r
      r@ $@ msg-group$ $@ str= IF ." *" THEN
      r@ $@ .group
      ." [" r@ cell+ $@len cell/ 0 .r ." ]#"
      r@ $@ msg-logs #@ nip cell/ u. rdrop ;] #map
    ." =====" forth:cr ;

: /nat ( addr u -- )  2drop
    \U nat                  list NAT info
    \G nat: list nat traversal information of all peers in all groups
    \U renat                redo NAT traversal
    \G renat: redo nat traversal
    msg-groups [: dup ." ===== Group: " $@ .group ."  =====" forth:cr
      cell+ $@ bounds ?DO
	  ." --- " I @ >o .con-id ." : " return-address .addr-path
	  ."  ---" forth:cr .nat-addrs o>
      cell +LOOP ;] #map ;

: /myaddrs ( addr u -- )
    \U myaddrs              list my addresses
    \G myaddrs: list my own local addresses (debugging)
    2drop
    ." ===== all =====" forth:cr    .my-addr$s
    ." ===== public =====" forth:cr .pub-addr$s

    \U n2o <cmd>            execute n2o command
    \G n2o: Execute normal n2o command

: /sync ( addr u -- )
    \U sync [+date] [-date] synchronize logs
    \G sync: synchronize chat logs, starting and/or ending at specific
    \G sync: time/date
    0 >o 2drop msg-group$ $@ msg-groups #@
    IF @ >o rdrop ?msg-context ELSE o> EXIT THEN
    o to connection
    ." === sync ===" forth:cr
    net2o-code expect-msg [: msg-group last?, ;] [msg,] end-code o> ;

: /version ( addr u -- )
    \U version              version string
    \G version: print version string
    2drop .n2o-version space .gforth-version forth:cr ;

    [: parse-text ;] send-avalanche ;

previous

: load-msgn ( addr u n -- )
    >r 2dup load-msg ?msg-log r> display-lastn ;

: +group ( -- )
    msg-group$ $@ dup IF
	2dup msg-groups #@ d0<> IF
	    +unique-con 2drop
	ELSE  o { w^ group } group cell 2swap msg-groups #!  THEN
    ELSE  2drop  THEN ;

: msg-timeout ( -- )
    packets2 @  connected-timeout  packets2 @ <>
    IF  reply( ." Resend to " pubkey $@ key>nick type cr )
	timeout-expired? IF
	    timeout( <err> ." Excessive timeouts from "
	    pubkey $@ key>nick type ." : "

    \G return a bit mask for the control key pressed
    1 key dup bl < >r lshift r> and ;

: wait-key ( -- )
    BEGIN  key-ctrlbit [ 1 ctrl L lshift 1 ctrl Z lshift or ]L
    and 0=  UNTIL ;

: chats# ( -- n ) 0 msg-groups
    [: dup $@len keysize < IF  drop 1  ELSE  cell+ $[]# THEN  + ;] #map ;

: wait-chat ( -- )
    chat-keys [: @/2 dup 0= IF  2drop  EXIT  THEN
      2dup keysize2 safe/string tuck <info> type IF '.' emit  THEN
      .key-id space ;] $[]map
    ." is not online. press key to recheck."
    [: 0 to connection -56 throw ;] is do-disconnect
    [: false chat-keys [: @/2 key| pubkey $@ key| str= or ;] $[]map
	IF  bl inskey  THEN  up@ wait-task ! ;] is do-connect
    wait-key cr [: up@ wait-task ! ;] IS do-connect ;

: last-chat-peer ( -- chat )
    msg-group$ $@ msg-groups #@ dup cell- 0 max /string
    IF  @  ELSE  drop 0  THEN ;

: search-connect ( key u -- o/0 )  key|
    0 [: drop 2dup pubkey $@ key| str= o and  dup 0= ;] search-context
    nip nip  dup to connection ;

: search-peer ( -- chat )
    false chat-keys
    [: @/2 key| rot dup 0= IF drop search-connect
      ELSE  nip nip  THEN ;] $[]map ;

: search-chat ( -- chat )
    group-master @ IF  last-chat-peer  ELSE  search-peer  ThEN ;

: key>group ( addr u -- pk u )
    @/ 2swap tuck msg-group$ $!  0=
    IF  2dup key| msg-group$ $!  THEN ; \ 1:1 chat-group=key

: ?load-msgn ( -- )
    msg-group$ $@ msg-logs #@ d0= IF
	msg-group$ $@ rows load-msgn  THEN ;

: chat-connects ( -- )
    chat-keys [: key>group ?load-msgn
      dup 0= IF  2drop msg-group$ $@ >group  EXIT  THEN
      2dup search-connect ?dup-IF  >o +group greet o> 2drop EXIT  THEN
      2dup pk-peek?  IF  chat-connect  ELSE  2drop  THEN ;] $[]map ;

: ?wait-chat ( -- ) #0. /chat:/chats
    BEGIN  chats# 0= WHILE  wait-chat chat-connects  REPEAT
    msg-group$ $@ ; \ stub

scope{ /chat
: /chat ( addr u -- )
    \U chat [group][@user]  switch/connect chat
    \G chat: switch to chat with user or group
    chat-keys $[]off nick>chat 0 chat-keys $[]@ key>group
    msg-group$ $@ msg-groups #@ dup 0= IF  2drop
	nip IF  chat-connects
	ELSE  ." That chat isn't active" forth:cr  THEN
    ELSE
	bounds ?DO  2dup I @ .pubkey $@ key2| str= 0= WHILE  cell +LOOP
	    2drop chat-connects  ELSE  UNLOOP 2drop THEN
    THEN  #0. /chats ;
}scope

    $, msg-reconnect ;

: reconnects, ( group -- )
    cell+ $@ cell safe/string bounds U+DO
	I @ .reconnect,
    cell +LOOP ;

: send-reconnects ( group o:connection -- )  o to connection
    net2o-code expect-msg
    [: dup  $@ ?destpk 2dup >group $, msg-leave
	sign[ msg-start "left" $, msg-action msg-otr>
	reconnects, ;] [msg,]
    end-code| ;

: send-reconnect1 ( o o:connection -- ) o to connection
    net2o-code expect-msg
    [: last# $@ $, msg-leave
	sign[ msg-start "left" $, msg-action msg-otr>
	.reconnect, ;] [msg,]
    end-code| ;
previous

: send-reconnect ( group -- )
    dup cell+ $@
    case
	0    of  2drop  endof
	cell of  nip @ >o o to connection send-leave o>  endof
	drop @ .send-reconnects
    0 endcase ;
: send-silent-reconnect ( group -- )
    dup cell+ $@
    case
	0    of  2drop  endof
	cell of  nip @ >o o to connection send-silent-leave o>  endof
	drop @ .send-reconnects
    0 endcase ;
: disconnect-group ( group -- ) >r
    r@ cell+ $@ bounds ?DO  I @  cell +LOOP
    r> cell+ $@len 0 +DO  >o o to connection
	disconnect-me o>
    cell +LOOP ;
: disconnect-all ( group -- ) >r
    r@ cell+ $@ bounds ?DO  I @  cell +LOOP
    r> cell+ $@len 0 +DO  >o o to connection
	send-leave  disconnect-me o>
    cell +LOOP ;

: leave-chat ( group -- )
    dup send-reconnect disconnect-group ;
: silent-leave-chat ( group -- )
    dup send-silent-reconnect disconnect-group ;

: leave-chats ( -- )
    msg-groups ['] leave-chat #map ;

: split-load ( group -- )
    cell+ >r 0
    BEGIN  dup 1+ r@ $[]# u<  WHILE
	    dup r@ $[] 2@ .send-reconnect1
	    1+ dup r@ $[] @ >o o to connection disconnect-me o>
    REPEAT drop rdrop ;

scope{ /chat
: /split ( addr u -- )  2drop
    \U split                split load
    \G split: reduce distribution load by reconnecting
    msg-group$ $@ >group last# split-load ;
}scope

\ chat toplevel

: do-chat ( addr u -- )
    get-order n>r
    chat-history  ['] /chat >body 1 set-order

2 Value flybursts#
$100 Value flybursts-max#
$20 cells Value resend-size#
#50.000.000 d>64 64Constant init-delay# \ 50ms initial timeout step
#60.000.000.000 d>64 64Constant connect-timeout# \ 60s connect timeout

Variable init-context#
hash: msg-groups
hash: msg-group# ( hash for group objects )
UValue msg-group-o
UValue connection

in net2o : new-log ( -- o )
    cmd-class new >o  log-table @ token-table ! o o> ;
in net2o : new-ack ( -- o )

\ dispose context

: unlink-ctx ( next hit ptr -- )
    next-context @ o contexts
    BEGIN  2dup @ <> WHILE  @ dup .next-context swap 0= UNTIL
	2drop drop EXIT  THEN  nip ! ;
: ungroup-ctx ( -- )
    msg-groups [: >r o r> cell+ del$cell ;] #map ;

Defer extra-dispose ' noop is extra-dispose

in net2o : dispose-context ( o:addr -- o:addr )
    [: cmd( ." Disposing context... " o hex. cr )
      timeout( ." Disposing context... " o hex. ." task: " task# ? cr )
      o-timeout o-chunks extra-dispose