\ ACL.fth -- word-level access control: the policy.
\
\ This is v3's capsules/ACL.4th, as FORTH source the node compiles itself.
\ The capsule supplies the fields of an entry and the check (acl.v4,
\ compile.v4); what is strict, how long a TTL lasts and what is pinned is
\ decided here.  Loading this file switches access control on: its last
\ line runs ACL-BOOT.  A system that does not load it has none.
\
\ The xt these words take is what FIND and ['] give: the word's code.

FORTH DEFINITIONS

1 CONSTANT ACL-STRICT-MODE
0 CONSTANT ACL-TTL-MODE-VAL
\ the TTL of a cold word, tuned 2026-06-15 on v3
256 CONSTANT ACL-BASE-TTL
65535 CONSTANT ACL-MAX-TTL

\ ( xt -- xt )  for symmetry: the xt is the entry
: ACL-ENTRY ;

: ACL-STRICT ( xt -- )
  DUP ACL-PINNED? IF DROP EXIT THEN  ACL-STRICT-MODE SWAP ACL-MODE! ;
: ACL-TTL-MODE ( xt -- )
  DUP ACL-PINNED? IF DROP EXIT THEN  ACL-TTL-MODE-VAL SWAP ACL-MODE! ;

\ ( xt -- ttl )  a hotter word earns a longer TTL: heat/4 + 256, at most 65535
: ACL-TTL-COMPUTE  ACL-HEAT@ 4 / ACL-BASE-TTL + ACL-MAX-TTL MIN ;

\ ( xt -- )  what the check runs when a word's TTL is 0.
\ STRICT: allow, and leave the TTL 0 so that every use comes back here.
\ TTL: compute a TTL from the word's heat; allow.
: ACL-RECHECK
  DUP ACL-PINNED? IF DROP EXIT THEN
  DUP ACL-MODE@ ACL-STRICT-MODE = IF
    1 OVER ACL-ALLOW!  0 OVER ACL-TTL!  DROP EXIT
  THEN
  DUP ACL-TTL-COMPUTE OVER ACL-TTL!  1 SWAP ACL-ALLOW! ;

\ the system CA's public key; placeholders, as in v3
0 CONSTANT ACL-CA-KEY-LO
0 CONSTANT ACL-CA-KEY-HI

\ ( req-hi req-lo -- allow? )  the fabric asks this word whether a channel
\ may be opened.  The default approves every request; a policy edits this.
: HERMES-CHANNEL-OPEN?  2DROP 1 ;

\ ( -- )  default fields on every word; the words that enforce the policy
\ pinned; the recheck switched on
: ACL-BOOT
  ACL-INIT-PRIMITIVES
  ['] ACL-RECHECK ACL-PIN  ['] ACL-INIT-PRIMITIVES ACL-PIN
  ['] ACL-RECHECK ACL-HOOK !
  LOG-INFO" ACL: active" ;
' ACL-BOOT ACL-PIN

ACL-BOOT