64field: lastdeltat
end-class ack-class

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


cmd-class class{ msg
    $10 +field dummy
    $value: name$ \ group name
    $value: id$
    $value: msg$  \ decrypted message
    field: peers[]
    field: keys[]
    field: log[]
    field: perms# \ pk -> permission map
    field: mode
    \ mode bits:
    1 4 bits: otr# redate# lock# visible#
    : bit-ops: ( bit -- )
        parse-name [{: d: name :}l name rot [: emit type ;] $tmp nextname ;]
	{: xt: gen-name :}
	'+' gen-name create dup , [: @        mode or!  ;] set-does>
	'-' gen-name create dup , [: @ invert mode and! ;] set-does>
	'?' gen-name create     , [: @ mode @ and 0<>   ;] set-does> ;
    otr#     bit-ops: otr
    redate#  bit-ops: redate
    lock#    bit-ops: lock
    visible# bit-ops: visible

    1 4 bits: role-admin# key-admin# moderator# troll#
    \ key admins can set keys, role-admins can set roles
    \ moderators can cancel other's and trolls are muted (they don't know)

    method start
    method tag
    method chain
    method signal
    method re
    method text
    method object
    method id
    method action
    method coord
    method otrify
    method payment
    method url
    method like
    method lock
    method unlock
    method away
    method perms
    method end
    method display   \ display one message
    method redisplay \ display full set
    method .nobody   \ show nobody is online
}class

cmd-class class{ pay

s" Invalid index"                throwcode !!inv-index!!
s" hash not last pk's state"     throwcode !!squid-hash!!
s" Double transaction!"          throwcode !!double-transaction!!
s" Insufficient asset!"          throwcode !!insufficient-asset!!
s" Transaction not balanced!"    throwcode !!not-balanced!!
s" Sink already cleared!"        throwcode !!sink-cleared!!
s" Sink not cleared!"            throwcode !!not-sunk!!
s" Invalid permission!"          throwcode !!inv-perm!!

next-exception !

: sig-enum>throw ( enum -- throwcode )
    [ ' !!inv-sig!! >body @ 1- ]L swap - ;
: !!sig!! ( n -- )
    ?dup-IF  sig-enum>throw throw  THEN ;

    case
	#-56 of .keyinfo true !!no-key-open!! endof
	#-28 of .keyinfo true !!no-key-open!! endof
	throw  0
    endcase ;

: args>keylist ( -- )
    key-list $[]free
    [: nick-key ?dup-IF  >o ke-pk $@ o> keysize umin key-list $+[]!  THEN ;]
    @arg-loop ;

\\\
Local Variables:
forth-local-words:
    (

    8 !!>=order? $> msg:coord ;
+net2o: msg-url ( $:url -- ) \g specify message URL
    $> msg:url ;
+net2o: msg-like ( xchar -- ) \g add a like
    64>n msg:like ;
+net2o: msg-lock ( $:key -- ) \g lock down communciation
    $> msg:lock ;
+net2o: msg-unlock ( -- ) \g unlock communication
    msg:unlock ;
+net2o: msg-perms ( $:pk perm -- ) \g permissions
    $> msg:perms ;
}scope

msg-table $save

' context-table is gen-table

\ Code for displaying messages

    2dup [: ." @" .simple-id ;] $tmp notify+ ; msg-notify-class is msg:signal
:noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:text
:noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:url
:noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:action
' drop  msg-notify-class is msg:like
' 2drop  msg-notify-class is msg:lock
' noop  msg-notify-class is msg:unlock
:noname 2drop 64drop ; msg-notify-class is msg:perms
' drop  msg-notify-class is msg:away
' 2drop msg-notify-class is msg:coord
:noname 2drop 2drop ; msg-notify-class is msg:otrify
:noname ( -- ) msg-notify ; msg-notify-class is msg:end
:noname ( xchar -- ) ['] xemit $tmp notify+ ; msg-notify-class is msg:like

:noname ( addr u -- )

	<info> ." chat is locked" <default>
    ELSE  2drop
	<err> ." locked out of chat" <default>
    THEN ; msg-class is msg:lock
:noname ( -- )  msg-group-o .msg:-lock
    <info> ." chat is free for all" <default> ; msg-class is msg:unlock
' drop msg-class is msg:away
:noname { 64^ perm d: pk -- }
    perm [ 1 64s ]L pk msg-group-o .msg:perms# #!
    pk .key-id ." : " perm 64@ 64>n s" 👹" bounds U+DO
	dup 1 and IF  I xc@ xemit  THEN  2/
    I I' over - x-size  +LOOP  drop space
; msg-class is msg:perms
:noname ( addr u type -- )
    space <warn> case
	msg:image#     of  ." img["      85type  endof
	msg:thumbnail# of  ." thumb["    85type  endof
	msg:patch#     of  ." patch["    85type  endof
	msg:snapshot#  of  ." snapshot[" 85type  endof
	msg:message#   of  ." message["  85type  endof

\ chat message, text only

: msg-tdisplay ( addr u -- )
    2dup 2 - + c@ $80 and IF  net2o-base:msg-dec-sig? IF
	    2drop <err> ." Undecryptable message" <default> cr  EXIT
	THEN  <info>  THEN
    sigpksize# - 2dup + sigpksize# >$  c-state off
    nest-cmd-loop msg:end <default> ;
' msg-tdisplay msg-class is msg:display
' msg-tdisplay msg-notify-class is msg:display
: ?search-lock ( addr u -- )
    BEGIN  dup  WHILE  cell- 2dup + $@ sigpksize# - 1- + c@ $2E = IF
		2dup + $@ ['] msg:display catch IF  2drop  THEN
		msg-group-o .msg:keys[] $[]# IF  drop 0  THEN
	    THEN

    \G lock: lock down communication to list of nicks
umethod /unlock ( addr u -- )
    \U unlock               stop lock down
    \G unlock: stop lock down
umethod /lock? ( addr u -- )
    \U lock?                check lock status
    \G lock?: report lock status
umethod /perms ( addr u -- )
    \U perms roles {@keys}  set and change permissions of users
    \G perms: set permissions
umethod /bye ( addr u -- )
    \U bye
    \G bye: leaves the current chat
umethod /chat ( addr u -- )
    \U chat [group][@user]  switch/connect chat
    \G chat: switch to chat with user or group
umethod /split ( addr u -- )

:noname ( addr u -- )
    2drop msg-group-o .msg:-lock
    [: net2o-base:msg-unlock ;] send-avalanche
; is /unlock
:noname ( addr u -- )
    2drop msg-group-o .msg:?lock 0= IF  ." un"  THEN  ." locked" forth:cr
; is /lock?

$100 buffer: permchar>bits
msg:role-admin# msg:key-admin# msg:moderator# or or 'a' permchar>bits + c!
msg:role-admin# 'r' permchar>bits + c!
msg:key-admin#  'k' permchar>bits + c!
msg:moderator#  'm' permchar>bits + c!
msg:troll#      't' permchar>bits + c!
: >perms ( addr u -- perms )
    0 -rot bounds ?DO  I c@ permchar>bits + c@
	dup 0= !!inv-perm!! or  LOOP ;

:noname ( addr u -- )
    word-args [: parse-name >perms args>keylist ;] execute-parsing
    [{: perm :}l
	perm key-list [: key| $, dup ulit, net2o-base:msg-perms ;] $[]map drop
    ;] send-avalanche
; is /perms

:noname ( addr u -- )
    2drop -1 [IFDEF] android android:level# [ELSE] level# [THEN] +! ; is /bye
}scope

: ?slash ( addr u -- addr u flag )
    over c@ dup '/' = swap '\' = or ;

* $2C msg-url ( $:url -- )
  specify message URL
* $2D msg-like ( xchar -- )
  add a like
* $2E msg-lock ( $:key -- )
  lock down communciation
* $2F msg-unlock ( -- )
  unlock communication
* $30 msg-perms ( $:pk perm -- )
  permissions

### group description commands ###

* $20 group-name ( $:name -- )
  group symbolic name
* $21 group-id ( $:group -- )
  group id, is a pubkey