Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

desk: migrate Tlon infrastructure from %landscape #4155

Draft
wants to merge 1 commit into
base: develop
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
224 changes: 224 additions & 0 deletions desk/app/bait.hoon
Original file line number Diff line number Diff line change
@@ -0,0 +1,224 @@
/- reel
/+ default-agent, verb, dbug, server, *reel
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
state-1
state-2
==
::
+$ state-0
$: %0
todd=(map [inviter=ship token=cord] description=cord)
==
+$ state-1
$: %1
token-metadata=(map [inviter=ship token=cord] metadata:reel)
==
+$ state-2
$: %2
token-metadata=(map token:reel metadata:reel)
==
--
::
|%
++ landing-page
|= =metadata:reel
^- manx
=/ description
?. =(tag.metadata 'groups-0') ""
(trip (~(got by fields.metadata) 'description'))
;html
;head
;title:"Lure"
==
;body
;p: {description}
Enter your @p:
;form(method "post")
;input(type "text", name "ship", id "ship", placeholder "~sampel");
;button(type "submit"):"Request invite"
==
;script: ship = document.cookie.split("; ").find((row) => row.startsWith("ship="))?.split("=")[1]; document.getElementById("ship").value=(ship || "~sampel-palnet")
==
==
::
++ sent-page
|= invitee=ship
^- manx
;html
;head
;title:"Lure"
==
;body
Your invite has been sent! Go to your ship to accept it.
;script: document.cookie="ship={(trip (scot %p invitee))}"
==
==
--
::
=| state-2
=* state -
::
%- agent:dbug
%+ verb |
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
[[%pass /eyre/connect %arvo %e %connect [~ /lure] dap.bowl]~ this]
::
++ on-save !>(state)
++ on-load
|= old-state=vase
^- (quip card _this)
=/ old !<(versioned-state old-state)
?- -.old
%2
`this(state old)
::
%1
=/ new-metadata
%- ~(gas by *(map token:reel metadata:reel))
%+ turn
~(tap by token-metadata.old)
|= [[inviter=ship =token:reel] meta=metadata:reel]
=/ new-token
(rap 3 (scot %p inviter) '/' token ~)
[new-token meta]
`this(state [%2 new-metadata])
::
%0
`this(state *state-2)
==
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?+ mark (on-poke:def mark vase)
%handle-http-request
=+ !<([id=@ta inbound-request:eyre] vase)
|^
:_ this
=/ full-line=request-line:server (parse-request-line:server url.request)
=/ line
?: ?=([%lure @ *] site.full-line)
t.site.full-line
?: ?=([@ @ *] site.full-line)
site.full-line
!!
?+ method.request (give not-found:gen:server)
%'GET' (get-request line)
::
%'POST'
?~ body.request
(give-not-found 'body not found')
?. =('ship=%7E' (end [3 8] q.u.body.request))
(give-not-found 'ship not found in body')
=/ joiner (slav %p (cat 3 '~' (rsh [3 8] q.u.body.request)))
=; [=bite:reel inviter=(unit ship)]
?~ inviter
(give-not-found 'inviter not found')
^- (list card)
:: TODO: figure out if we need to send both pokes
:* :* %pass /bite %agent [u.inviter %reel]
%poke %reel-bite !>(bite)
==
:* %pass /bite %agent [our.bowl %reel]
%poke %reel-bite !>(bite)
==
(give (manx-response:gen:server (sent-page joiner)))
==
=/ =(pole knot) line
?: ?=([@ @ ~] line)
=/ inviter (slav %p i.line)
=/ old-token i.t.line
:_ `inviter
[%bite-1 old-token joiner inviter]
=/ token
?~ ext.full-line i.line
(crip "{(trip i.line)}.{(trip u.ext.full-line)}")
=/ =metadata:reel (~(gut by token-metadata) token *metadata:reel)
?~ type=(~(get by fields.metadata) 'bite-type')
~|("no bite type for token: {<token>}" !!)
?> =('2' u.type)
:- [%bite-2 token joiner metadata]
?~ inviter-field=(~(get by fields.metadata) 'inviter') ~
`(slav %p u.inviter-field)
==
++ get-request
|= =(pole knot)
^- (list card)
?+ pole (give not-found:gen:server)
[%bait %who ~]
(give (json-response:gen:server s+(scot %p our.bowl)))
::
[ship=@ name=@ %metadata ~]
=/ token (crip "{(trip ship.pole)}/{(trip name.pole)}")
=/ =metadata:reel
(~(gut by token-metadata) token *metadata:reel)
(give (json-response:gen:server (enjs-metadata metadata)))
::
[token=@ %metadata ~]
=/ =metadata:reel
(~(gut by token-metadata) token.pole *metadata:reel)
(give (json-response:gen:server (enjs-metadata metadata)))
::
[token=* ~]
=/ token (crip (join '/' pole))
=/ =metadata:reel
(~(gut by token-metadata) token *metadata:reel)
(give (manx-response:gen:server (landing-page metadata)))
==
::
++ give-not-found
|= body=cord
(give [[404 ~] `(as-octs:mimes:html body)])
++ give
|= =simple-payload:http
(give-simple-payload:app:server id simple-payload)
--
%bait-describe
=+ !<([=nonce:reel =metadata:reel] vase)
=/ =token:reel (scot %uv (end [3 16] eny.bowl))
:_ this(token-metadata (~(put by token-metadata) token metadata))
=/ =cage reel-confirmation+!>([nonce token])
~[[%pass /confirm/[nonce] %agent [src.bowl %reel] %poke cage]]
::
%bait-undescribe
=+ !<(token=cord vase)
`this(token-metadata (~(del by token-metadata) token))
::
%bind-slash
:_ this
~[[%pass /eyre/connect %arvo %e %connect [~ /] dap.bowl]]
::
%unbind-slash
:_ this
~[[%pass /eyre/connect %arvo %e %connect [~ /] %docket]]
==
::
++ on-agent on-agent:def
++ on-watch
|= =path
^- (quip card _this)
?+ path (on-watch:def path)
[%http-response *] `this
==
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ sign-arvo (on-arvo:def wire sign-arvo)
[%eyre %bound *]
~? !accepted.sign-arvo
[dap.bowl 'eyre bind rejected!' binding.sign-arvo]
[~ this]
==
::
++ on-fail on-fail:def
--
142 changes: 142 additions & 0 deletions desk/app/bark.hoon
Original file line number Diff line number Diff line change
@@ -0,0 +1,142 @@
:: bark: gathers summaries from ships, sends emails to their owners
::
:: general flow is that bark gets configured with api keys and recipient
:: ships. on-demand, bark asks either all or a subset of recipients for
:: an activity summary (through the growl agent on their ships), and upon
:: receiving responses, uses the mailchimp api to upload the received
:: deets for that ship, and/or triggers an email send.
::
/+ default-agent, verb, dbug
::
|%
+$ card card:agent:gall
+$ state-0
$: %0
api=[tlon=@t mailchimp=[key=@t list-id=@t]]
recipients=(set ship)
==
::
++ next-timer
|= now=@da
:: west-coast midnights for minimal ameri-centric disruption
%+ add ~d1.h7
(sub now (mod now ~d1))
--
::
=| state-0
=* state -
%- agent:dbug
%+ verb |
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %.n) bowl)
++ on-init
^- (quip card _this)
:_ this
[%pass /fetch %arvo %b %wait (next-timer now.bowl)]~
::
++ on-arvo
|= [=wire sign=sign-arvo]
^- (quip card _this)
?+ wire ~|([%strange-wire wire] !!)
[%fetch ~]
?> ?=(%wake +<.sign)
=^ caz this (on-poke %bark-generate-summaries !>(~))
:_ this
:_ caz
[%pass /fetch %arvo %b %wait (next-timer now.bowl)]
::
[%save-summary @ @ ~]
?> ?=(%arow +<.sign)
?: ?=(%& -.p.sign) [~ this]
%- (slog 'bark: failed to save summary' p.p.sign)
[~ this]
==
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?+ mark (on-poke:def mark vase)
%noun
=+ !<([m=@ n=*] vase)
$(mark m, vase (need (slew 3 vase)))
::
%set-tlon-api-key
`this(tlon.api !<(@t vase))
::
%set-mailchimp-api-key
`this(mailchimp.api !<([key=@t list=@t] vase))
::
%bark-add-recipient
=+ !<(=ship vase)
?> =(src.bowl ship)
`this(recipients (~(put in recipients) ship))
::
%bark-remove-recipient
=+ !<(=ship vase)
?> =(src.bowl ship)
:_ this(recipients (~(del in recipients) ship))
:_ ~
:* %pass /save-summary/(scot %p src.bowl)/(scot %da now.bowl)
%arvo %k %fard
%landscape %save-summary %noun
!>(`[tlon.api mailchimp.api src.bowl %wipe ~])
==
::
%bark-generate-summaries
?> =(src.bowl our.bowl)
:_ this
=- ~(tap in -)
^- (set card)
%- ~(run in recipients)
|= =ship
^- card
[%pass /request-summary %agent [ship %growl] %poke %growl-summarize !>(now.bowl)]
::
%bark-target-summaries
?> =(src.bowl our.bowl)
:_ this
%+ turn
(skim !<((list ship) vase) ~(has in recipients))
|= =ship
^- card
[%pass /request-summary %agent [ship %growl] %poke %growl-summarize !>(now.bowl)]
::
%bark-receive-summary
=/ result
!< %- unit
$: requested=time
$= summary
::NOTE see also /lib/summarize
$% [%life active=[s=@ud r=@ud g=@t] inactive=[d=@ud c=@ud g=@t c=@t]]
== ==
vase
?~ result
$(mark %bark-remove-recipient, vase !>(src.bowl))
::TODO maybe drop the result (or re-request) if the timestamp is too old?
:_ this
:~ :* %pass /save-summary/(scot %p src.bowl)/(scot %da requested.u.result)
%arvo %k %fard
%landscape %save-summary %noun
!>(`[tlon.api mailchimp.api src.bowl summary.u.result])
==
==
==
++ on-watch on-watch:def
++ on-agent on-agent:def
++ on-fail
|= [=term =tang]
%- (slog 'bark: on-fail' term tang)
[~ this]
++ on-leave
|= =path
`this
++ on-save !>(state)
++ on-load
|= old-state=vase
^- (quip card _this)
=/ old !<(state-0 old-state)
`this(state old)
++ on-peek on-peek:def
--
4 changes: 2 additions & 2 deletions desk/app/chat.hoon
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
/- c=chat, d=channels, g=groups, u=ui, e=epic, old=chat-2, activity
/- meta
/- ha=hark
/- contacts
/- contacts-0
/+ default-agent, verb-lib=verb, dbug, neg=negotiate
/+ pac=dm
/+ utils=channel-utils
Expand Down Expand Up @@ -1750,7 +1750,7 @@
|= =diff:dm:c
=? net.dm &(?=(%inviting net.dm) !from-self) %done
=/ =wire /contacts/(scot %p ship)
=/ =cage [act:mar:contacts !>(`action:contacts`[%heed ~[ship]])]
=/ =cage contact-action+!>(`action-0:contacts-0`[%heed ~[ship]])
=. cor (emit %pass wire %agent [our.bowl %contacts] %poke cage)
=/ old-unread di-unread
=/ had=(unit [=time =writ:c])
Expand Down
Loading