64field: min-slack
    64field: max-slack
    64field: time-offset  \ make timestamps smaller
    64field: lastdeltat
end-class ack-class

cmd-class class
    $value: msging-id$
    field: peers[]
    field: silent-last#
end-class msging-class

cmd-class class{ msg
    $value: id$






    method start
    method tag
    method chain
    method signal
    method re
    method text
    method object
................................................................................
    1 pthread-mutexes +field code-sema
    0 +field end-semas
    \ contexts for subclasses
    field: next-context  \ link field to connect all contexts
    field: log-context
    field: ack-context
    field: msging-context
    field: msg-context
    field: file-state    \ files
    \ rest of state
    field: codebuf#
    field: context#
    field: wait-task
    value: max-timeouts \ initialized with timeouts#
    $10 +field return-address \ used as return address

    64field: min-slack
    64field: max-slack
    64field: time-offset  \ make timestamps smaller
    64field: lastdeltat
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#
    method start
    method tag
    method chain
    method signal
    method re
    method text
    method object
................................................................................
    1 pthread-mutexes +field code-sema
    0 +field end-semas
    \ contexts for subclasses
    field: next-context  \ link field to connect all contexts
    field: log-context
    field: ack-context
    field: msging-context

    field: file-state    \ files
    \ rest of state
    field: codebuf#
    field: context#
    field: wait-task
    value: max-timeouts \ initialized with timeouts#
    $10 +field return-address \ used as return address

Forward pk-connect? ( key u cmdlen datalen -- flag )
Forward addr-connect ( key+addr u cmdlen datalen xt -- )
Forward pk-peek? ( addr u0 -- flag )

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

: >group ( addr u -- )  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
................................................................................
User skip-sig?

Sema msglog-sema

: ?msg-context ( -- o )
    msging-context @ dup 0= IF
	drop
	msg-context @ 0= IF
	    net2o:new-msg msg-context !
	THEN
	net2o:new-msging dup msging-context !
    THEN ;

: >chatid ( group u -- id u )  defaultkey sec@ keyed-hash#128 ;

: msg-log@ ( last# -- addr u )
    [: cell+ $@ save-mem ;] msglog-sema c-section ;
................................................................................
: ?save-msg ( addr u -- )
    ?msg-log
    last# otr-mode @ replay-mode @ or 0= and
    IF  save-msgs&  THEN ;

Sema queue-sema

\ peer queue

: peer> ( -- addr / 0 )
    [: peers[] back> ;] queue-sema c-section ;
: >peer ( addr u -- )
    [: peers[] $+[]! ;] queue-sema c-section ;

\ events

msg-class class end-class msg-notify-class

msg-notify-class ' new static-a with-allocater Constant msg-notify-o

: >msg-log ( addr u -- addr' u )
    last# >r +msg-log last# ?dup-IF  $@ ?save-msg  THEN  r> to last# ;

: do-msg-nestsig ( addr u -- )
    2dup parent .msg-context @ .msg:display
    msg-notify-o .msg:display ;

: display-lastn ( n -- )
    net2o:new-msg >o 0 to parent msg:redisplay dispose o> ;
: display-sync-done ( -- )
    rows  msg-context @ .msg:redisplay ;

: display-one-msg { d: msgt -- }
    net2o:new-msg >o 0 to parent
    msgt ['] msg:display catch IF  ." invalid entry"  cr  2drop  THEN
    dispose o> ;

Forward silent-join

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

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

Forward pk-connect? ( key u cmdlen datalen -- flag )
Forward addr-connect ( key+addr u cmdlen datalen xt -- )
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
................................................................................
User skip-sig?

Sema msglog-sema

: ?msg-context ( -- o )
    msging-context @ dup 0= IF
	drop



	net2o:new-msging dup msging-context !
    THEN ;

: >chatid ( group u -- id u )  defaultkey sec@ keyed-hash#128 ;

: msg-log@ ( last# -- addr u )
    [: cell+ $@ save-mem ;] msglog-sema c-section ;
................................................................................
: ?save-msg ( addr u -- )
    ?msg-log
    last# otr-mode @ replay-mode @ or 0= and
    IF  save-msgs&  THEN ;

Sema queue-sema

\ peer queue, in msg context

: peer> ( -- addr / 0 )
    [: msg:peers[] back> ;] queue-sema c-section ;
: >peer ( addr u -- )
    [: msg:peers[] $+[]! ;] queue-sema c-section ;

\ events

msg-class class end-class msg-notify-class

msg-notify-class ' new static-a with-allocater Constant msg-notify-o

: >msg-log ( addr u -- addr' u )
    last# >r +msg-log last# ?dup-IF  $@ ?save-msg  THEN  r> to last# ;

: do-msg-nestsig ( addr u -- )
    2dup msg-group-o .msg:display
    msg-notify-o .msg:display ;

: display-lastn ( n -- )
    msg-group-o >o msg:redisplay o> ;
: display-sync-done ( -- )
    rows  msg-group-o .msg:redisplay ;

: display-one-msg { d: msgt -- }
    msg-group-o >o
    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

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#
Variable msg-groups


UValue connection

in net2o : new-log ( -- o )
    cmd-class new >o  log-table @ token-table ! o o> ;
in net2o : new-ack ( -- o )
    o ack-class new >o  parent!  ack-table @ token-table !
    init-delay# rtdelay 64!
................................................................................
      fstate-free
      \ erase crypto keys
      log-context @ ?dup-IF  .dispose  THEN
      ack-context @ ?dup-IF
	  >o timing-stat $off track-timing $off dispose o>
      THEN
      msging-context @ ?dup-IF  .dispose  THEN
      msg-context    @ ?dup-IF  .dispose  THEN
      unlink-ctx  ungroup-ctx
      end-semas start-semas DO  I pthread_mutex_destroy drop
      1 pthread-mutexes +LOOP
      dispose  0 to connection
      cmd( ." disposed" cr ) ;] file-sema c-section ;

event: :>dispose-context ( o -- )  .net2o:dispose-context ;
................................................................................
\\\
Local Variables:
forth-local-words:
    (
     (("net2o:" "+net2o:") definition-starter (font-lock-keyword-face . 1)
      "[ \t\n]" t name (font-lock-function-name-face . 3))
     (("64field:") non-immediate (font-lock-type-face . 2)


      "[ \t\n]" t name (font-lock-variable-name-face . 3))
     (("with") compile-only (font-lock-type-face . 2)
      "[ \t\n]" t name (font-lock-variable-name-face . 3))
     (("endwith") compile-only (font-lock-type-face . 2))
    )
forth-local-indent-words:
    (
    (("net2o:" "+net2o:") (0 . 2) (0 . 2) non-immediate)
    (("with") (0 . 2) (0 . 2) compile-only)
    (("endwith") (-2 . 0) (0 . -2) compile-only)
    )
End:
[THEN]

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 )
    o ack-class new >o  parent!  ack-table @ token-table !
    init-delay# rtdelay 64!
................................................................................
      fstate-free
      \ erase crypto keys
      log-context @ ?dup-IF  .dispose  THEN
      ack-context @ ?dup-IF
	  >o timing-stat $off track-timing $off dispose o>
      THEN
      msging-context @ ?dup-IF  .dispose  THEN

      unlink-ctx  ungroup-ctx
      end-semas start-semas DO  I pthread_mutex_destroy drop
      1 pthread-mutexes +LOOP
      dispose  0 to connection
      cmd( ." disposed" cr ) ;] file-sema c-section ;

event: :>dispose-context ( o -- )  .net2o:dispose-context ;
................................................................................
\\\
Local Variables:
forth-local-words:
    (
     (("net2o:" "+net2o:") definition-starter (font-lock-keyword-face . 1)
      "[ \t\n]" t name (font-lock-function-name-face . 3))
     (("64field:") non-immediate (font-lock-type-face . 2)
      "[ \t\n]" t name (font-lock-variable-name-face . 3))
     (("hash:") non-immediate (font-lock-type-face . 2)
      "[ \t\n]" t name (font-lock-variable-name-face . 3))
     (("with") compile-only (font-lock-type-face . 2)
      "[ \t\n]" t name (font-lock-variable-name-face . 3))
     (("endwith") compile-only (font-lock-type-face . 2))
    )
forth-local-indent-words:
    (
    (("net2o:" "+net2o:") (0 . 2) (0 . 2) non-immediate)
    (("with") (0 . 2) (0 . 2) compile-only)
    (("endwith") (-2 . 0) (0 . -2) compile-only)
    )
End:
[THEN]

  turn a past message into OTR
* $2B msg-coord ( $:gps -- )
  GPS coordinates
* $2C msg-url ( $:url -- )
  specify message URL
* $2D msg-like ( xchar -- )
  add a like




### group description commands ###

* $20 group-name ( $:name -- )
  group symbolic name
* $21 group-id ( $:group -- )
  group id, is a pubkey
................................................................................
  join a chat group
* $23 msg-leave ( $:group -- )
  leave a chat group
* $24 msg-reconnect ( $:pubkey+addr -- )
  rewire distribution tree
* $25 msg-last? ( start end n -- )
* $26 msg-last ( $:[tick0,msgs,..tickn] n -- )
* $27 msg-key ( $:key -- )
* $A msg-nestsig ( $:cmd+sig -- )
  check sig+nest
* $28 msg-nestencsig ( $:enc[cmd]+sig -- )
  decrypt, chech sig+nest

### DVCS patch commands ###

DVCS metadata is stored in messages, containing message text, refs
and patchset objects. Patchset objects are constructed in a way
that makes identical transactions have the same hash.

  turn a past message into OTR
* $2B msg-coord ( $:gps -- )
  GPS coordinates
* $2C msg-url ( $:url -- )
  specify message URL
* $2D msg-like ( xchar -- )
  add a like
* $2E msg-lock ( $:key -- )
  lock down communciation
* $2F msg-unlock ( -- )

### group description commands ###

* $20 group-name ( $:name -- )
  group symbolic name
* $21 group-id ( $:group -- )
  group id, is a pubkey
................................................................................
  join a chat group
* $23 msg-leave ( $:group -- )
  leave a chat group
* $24 msg-reconnect ( $:pubkey+addr -- )
  rewire distribution tree
* $25 msg-last? ( start end n -- )
* $26 msg-last ( $:[tick0,msgs,..tickn] n -- )

* $A msg-nestsig ( $:cmd+sig -- )
  check sig+nest



### DVCS patch commands ###

DVCS metadata is stored in messages, containing message text, refs
and patchset objects. Patchset objects are constructed in a way
that makes identical transactions have the same hash.