mirror of
https://github.com/tloncorp/landscape.git
synced 2024-11-28 12:14:31 +03:00
Merge pull request #27 from tloncorp/m/new-summaries
bark: new summaries, save to mailchimp
This commit is contained in:
fang
GitHub
commit
b7437f5069
@ -1,12 +1,27 @@
|
||||
:: 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.
|
||||
::
|
||||
/- hark
|
||||
/+ default-agent, verb, dbug
|
||||
::
|
||||
|%
|
||||
+$ card card:agent:gall
|
||||
+$ versioned-state
|
||||
$% state-0
|
||||
+$ state-0
|
||||
$: %0
|
||||
api=[tlon=@t mailchimp=[key=@t list-id=@t]]
|
||||
recipients=(set ship)
|
||||
==
|
||||
+$ state-0 [%0 tlon-api-key=tape mailchimp-api-key=tape 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
|
||||
@ -17,16 +32,34 @@
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
def ~(. (default-agent this %.n) bowl)
|
||||
++ on-init `this
|
||||
++ on-init
|
||||
^- (quip card _this)
|
||||
:_ this
|
||||
[%pass /fetch %arvo %b %wait (next-timer now.bowl)]~
|
||||
::
|
||||
++ on-arvo
|
||||
|= [=wire sign=sign-arvo]
|
||||
^- (quip card _this)
|
||||
?> =(/fetch wire)
|
||||
?> ?=(%wake +<.sign)
|
||||
=^ caz this (on-poke %bark-generate-summaries !>(~))
|
||||
:_ this
|
||||
:_ caz
|
||||
[%pass /fetch %arvo %b %wait (next-timer now.bowl)]
|
||||
::
|
||||
++ 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-key !<(tape vase))
|
||||
`this(tlon.api !<(@t vase))
|
||||
::
|
||||
%set-mailchimp-api-key
|
||||
`this(mailchimp-api-key !<(tape vase))
|
||||
`this(mailchimp.api !<([key=@t list=@t] vase))
|
||||
::
|
||||
%bark-add-recipient
|
||||
=+ !<(=ship vase)
|
||||
@ -58,14 +91,22 @@
|
||||
[%pass /request-summary %agent [ship %growl] %poke %growl-summarize !>(now.bowl)]
|
||||
::
|
||||
%bark-receive-summary
|
||||
=/ result !<((unit [requested=time =carpet:hark]) vase)
|
||||
=/ 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
|
||||
`this(recipients (~(del in recipients) src.bowl))
|
||||
::TODO maybe drop the result (or re-request) if the timestamp is too old?
|
||||
:_ this
|
||||
:~ :* %pass /mail-hosted-users/(scot %p src.bowl)/(scot %da requested.u.result)
|
||||
:~ :* %pass /save-summary/(scot %p src.bowl)/(scot %da requested.u.result)
|
||||
%arvo %k %fard
|
||||
%bark %mail-hosted-user %noun
|
||||
!>(`[tlon-api-key mailchimp-api-key src.bowl carpet.u.result])
|
||||
%garden %save-summary %noun
|
||||
!>(`[tlon.api mailchimp.api src.bowl summary.u.result])
|
||||
==
|
||||
==
|
||||
==
|
||||
@ -81,11 +122,7 @@
|
||||
++ on-load
|
||||
|= old-state=vase
|
||||
^- (quip card _this)
|
||||
=/ old !<(versioned-state old-state)
|
||||
?- -.old
|
||||
%0
|
||||
`this(state old)
|
||||
==
|
||||
++ on-arvo on-arvo:def
|
||||
=/ old !<(state-0 old-state)
|
||||
`this(state old)
|
||||
++ on-peek on-peek:def
|
||||
--
|
||||
|
||||
@ -1,12 +1,12 @@
|
||||
/- hark
|
||||
/+ default-agent, verb, dbug
|
||||
/- hark, settings
|
||||
/+ summarize, default-agent, verb, dbug
|
||||
::
|
||||
|%
|
||||
+$ card card:agent:gall
|
||||
+$ versioned-state
|
||||
$% state-0
|
||||
==
|
||||
+$ state-0 [%0 enabled=? bark-host=ship]
|
||||
+$ state-0 [%0 enabled=_| bark-host=_~rilfet-palsum]
|
||||
--
|
||||
::
|
||||
:: This agent should eventually go into landscape
|
||||
@ -19,13 +19,37 @@
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
def ~(. (default-agent this %.n) bowl)
|
||||
::
|
||||
++ on-init
|
||||
:_ this(enabled %.n)
|
||||
~[[%pass /hark %agent [our.bowl %hark] %watch /ui]]
|
||||
=; consent=?
|
||||
=^ caz this (on-poke ?:(consent %enable %disable) !>(~))
|
||||
:_ this
|
||||
::NOTE sadly, we cannot subscribe to items that may not exist right now,
|
||||
:: so we subscribe to the whole bucket instead
|
||||
[[%pass /settings %agent [our.bowl %settings] %watch /desk/groups] caz]
|
||||
=+ .^ =data:settings
|
||||
%gx
|
||||
(scot %p our.bowl)
|
||||
%settings
|
||||
(scot %da now.bowl)
|
||||
/desk/groups/settings-data
|
||||
==
|
||||
?> ?=(%desk -.data)
|
||||
=; =val:settings
|
||||
?>(?=(%b -.val) p.val)
|
||||
%+ %~ gut by
|
||||
(~(gut by desk.data) %groups ~)
|
||||
'logActivity'
|
||||
[%b |]
|
||||
::
|
||||
++ 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-host
|
||||
?> =(src.bowl our.bowl)
|
||||
`this(bark-host !<(ship vase))
|
||||
@ -43,13 +67,44 @@
|
||||
:_ this
|
||||
~[[%pass /bark-summary %agent [bark-host %bark] %poke %bark-receive-summary !>(~)]]
|
||||
=/ requested !<(time vase)
|
||||
=/ scry-path [(scot %p our.bowl) %hark (scot %da now.bowl) %all %latest %hark-carpet ~]
|
||||
=/ =carpet:hark .^(carpet:hark %gx scry-path)
|
||||
=/ activity ~(summarize-activity summarize [our now]:bowl)
|
||||
=/ inactivity ~(summarize-inactivity summarize [our now]:bowl)
|
||||
:_ this
|
||||
~[[%pass /bark-summary %agent [bark-host %bark] %poke %bark-receive-summary !>(`[requested carpet])]]
|
||||
~[[%pass /bark-summary %agent [bark-host %bark] %poke %bark-receive-summary !>(`[requested %life activity inactivity])]]
|
||||
==
|
||||
::
|
||||
++ on-agent
|
||||
|= [=wire =sign:agent:gall]
|
||||
^- (quip card _this)
|
||||
?. ?=([%settings ~] wire) (on-agent:def wire sign)
|
||||
?- -.sign
|
||||
%poke-ack !!
|
||||
::
|
||||
%watch-ack
|
||||
?~ p.sign [~ this]
|
||||
%- (slog 'growl failed settings subscription' u.p.sign)
|
||||
[~ this]
|
||||
::
|
||||
%kick
|
||||
[[%pass /settings %agent [our.bowl %settings] %watch /desk/groups]~ this]
|
||||
::
|
||||
%fact
|
||||
?. =(%settings-event p.cage.sign) (on-agent:def wire sign)
|
||||
=+ !<(=event:settings q.cage.sign)
|
||||
=/ new=?
|
||||
=; =val:settings
|
||||
?:(?=(%b -.val) p.val |)
|
||||
?+ event b+|
|
||||
[%put-bucket %groups %groups *] (~(gut by bucket.event) 'logActivity' b+|)
|
||||
[%del-bucket %groups %groups] b+|
|
||||
[%put-entry %groups %groups %'logActivity' *] val.event
|
||||
[%del-entry %groups %groups %'logActivity'] b+|
|
||||
==
|
||||
?: =(new enabled) [~ this]
|
||||
(on-poke ?:(new %enable %disable) !>(~))
|
||||
==
|
||||
::
|
||||
++ on-watch on-watch:def
|
||||
++ on-agent on-agent:def
|
||||
++ on-fail
|
||||
|= [=term =tang]
|
||||
(mean ':sub +on-fail' term tang)
|
||||
|
||||
99
desk/lib/summarize.hoon
Normal file
99
desk/lib/summarize.hoon
Normal file
@ -0,0 +1,99 @@
|
||||
:: summarize: utilities for summarizing groups/chat state in various ways
|
||||
::
|
||||
/- chat, hark, groups
|
||||
::
|
||||
|_ [our=@p now=@da]
|
||||
:: +range: period of time to summarize over
|
||||
:: +limit: max amount of msgs to count per channel
|
||||
::
|
||||
++ range ~d7
|
||||
++ limit 9.999
|
||||
::
|
||||
++ scry-path
|
||||
|= [=term =spur]
|
||||
[(scot %p our) term (scot %da now) spur]
|
||||
::
|
||||
++ summarize-activity
|
||||
^- $: sent=@ud
|
||||
received=@ud
|
||||
most-sent-group=@t
|
||||
==
|
||||
=- :+ s r
|
||||
=/ g=flag:chat
|
||||
=< -
|
||||
::TODO crashes if no groups
|
||||
%+ snag 0
|
||||
%+ sort ~(tap by g)
|
||||
|=([[* a=@ud] [* b=@ud]] (gth a b))
|
||||
=< title.meta
|
||||
.^ group:groups
|
||||
%gx
|
||||
(scry-path %groups /groups/(scot %p p.g)/[q.g]/group)
|
||||
==
|
||||
%+ roll
|
||||
%~ tap in
|
||||
.^ (map flag:chat chat:chat)
|
||||
%gx
|
||||
(scry-path %chat /chats/chats)
|
||||
==
|
||||
=* onn ((on time writ:chat) lte)
|
||||
|= [[c=flag:chat chat:chat] g=(map flag:chat @ud) s=@ud r=@ud]
|
||||
=+ .^ log=((mop time writ:chat) lte)
|
||||
%gx
|
||||
%+ scry-path %chat
|
||||
/chat/(scot %p p.c)/[q.c]/writs/newer/(scot %ud (sub now range))/(scot %ud limit)/chat-writs
|
||||
==
|
||||
:- %+ ~(put by g) group.perm
|
||||
(add (~(gut by g) group.perm 0) (wyt:onn log))
|
||||
%+ roll (tap:onn log)
|
||||
|= [[time writ:chat] s=_s r=_r]
|
||||
?:(=(our author) [+(s) r] [s +(r)])
|
||||
::
|
||||
++ summarize-inactivity
|
||||
^- $: unread-dms=@ud :: unread dm count
|
||||
unread-etc=@ud :: unread chats count
|
||||
top-group=@t :: most active group
|
||||
top-channel=@t :: most active channel
|
||||
==
|
||||
=+ .^ =briefs:chat
|
||||
%gx
|
||||
(scry-path %chat /briefs/chat-briefs)
|
||||
==
|
||||
:: accumulate unread counts
|
||||
::
|
||||
=/ [dum=@ud duc=@ud]
|
||||
%- ~(rep by briefs)
|
||||
|= [[w=whom:chat brief:briefs:chat] n=@ud m=@ud]
|
||||
?: ?=(%flag -.w) [n (add m count)]
|
||||
[(add n count) m]
|
||||
:+ dum duc
|
||||
:: gather all chat channels & their groups & unread counts
|
||||
::
|
||||
=/ faz=(list [g=flag:chat c=flag:chat n=@ud])
|
||||
%+ turn
|
||||
%~ tap in
|
||||
.^ (map flag:chat chat:chat)
|
||||
%gx
|
||||
(scry-path %chat /chats/chats)
|
||||
==
|
||||
|= [c=flag:chat chat:chat]
|
||||
:+ group.perm c
|
||||
count:(~(gut by briefs) flag+c *brief:briefs:chat)
|
||||
=. faz (sort faz |=([[* * a=@ud] [* * b=@ud]] (gth a b)))
|
||||
:: get display titles of most active channel and its group
|
||||
::
|
||||
::NOTE in rare cases, we might not know of the existence of the associated
|
||||
:: group. simply skip past it and try the next one...
|
||||
=+ .^ =groups:groups
|
||||
%gx
|
||||
=- ~& [%scrying -] -
|
||||
(scry-path %groups /groups/groups)
|
||||
==
|
||||
|-
|
||||
?~ faz ['???' '???'] ::TODO better copy
|
||||
?. (~(has by groups) g.i.faz)
|
||||
$(faz t.faz)
|
||||
=/ =group:^groups (~(got by groups) g.i.faz)
|
||||
:- title.meta.group
|
||||
title.meta:(~(got by channels.group) %chat c.i.faz)
|
||||
--
|
||||
@ -1,9 +1,17 @@
|
||||
/- hark
|
||||
|_ result=(unit [requested=time =carpet:hark])
|
||||
=> |%
|
||||
+$ 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]]
|
||||
== ==
|
||||
--
|
||||
|_ =result
|
||||
++ grad %noun
|
||||
++ grab
|
||||
|%
|
||||
++ noun (unit (pair time carpet:hark))
|
||||
++ noun ^result
|
||||
--
|
||||
++ grow
|
||||
|%
|
||||
|
||||
@ -17,7 +17,7 @@
|
||||
^- form:m
|
||||
=/ arg-mold
|
||||
$: tlon-api-key=tape
|
||||
mailchimp-api-key=tape
|
||||
mandrill-api-key=tape
|
||||
=ship
|
||||
=carpet:hark
|
||||
==
|
||||
@ -27,7 +27,7 @@
|
||||
%- send-raw-card
|
||||
:* %pass /check-email/(scot %p ship.u.args)
|
||||
%arvo %k %fard
|
||||
%bark %hosting-email %noun
|
||||
%garden %hosting-email %noun
|
||||
!>(`[tlon-api-key.u.args ship.u.args])
|
||||
==
|
||||
;< [mire=wire mine=sign-arvo] bind:m take-sign-arvo
|
||||
@ -43,8 +43,8 @@
|
||||
%- send-raw-card
|
||||
:* %pass /send-mailchimp-email/(scot %p ship.u.args)
|
||||
%arvo %k %fard
|
||||
%bark %mailchimp-send-template %noun
|
||||
!>(`[mailchimp-api-key.u.args (trip email) "landscape-weekly-digest" (template-vars ship.u.args carpet.u.args)])
|
||||
%garden %mailchimp-send-template %noun
|
||||
!>(`[mandrill-api-key.u.args (trip email) "landscape-weekly-digest" (template-vars ship.u.args carpet.u.args)])
|
||||
==
|
||||
;< [wimp=wire simp=sign-arvo] bind:m take-sign-arvo
|
||||
?> ?=([%send-mailchimp-email @ *] wimp)
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
:: Mailchimp/Send Template
|
||||
:: send an email template via the Mailchimp Transactional API
|
||||
::
|
||||
:: > -bark!mailchimp-send-template "[API_KEY]" "someone@example.com" "template-name" vars :: vars is a (map cord cord)
|
||||
:: > -bark!mailchimp-send-template "[MANDRILL_API_KEY]" "someone@example.com" "template-name" vars :: vars is a (map cord cord)
|
||||
::
|
||||
/- spider
|
||||
/+ *strandio
|
||||
|
||||
77
desk/ted/mailchimp/update-merge-fields.hoon
Normal file
77
desk/ted/mailchimp/update-merge-fields.hoon
Normal file
@ -0,0 +1,77 @@
|
||||
:: -mailchimp-update-merge-fields: set/update merge field(s) for an email
|
||||
::
|
||||
:: produces a success flag (whether response status was 200 or not) and
|
||||
:: either the response body, or some error string in case of local failure.
|
||||
::
|
||||
:: > -bark!mailchimp-update-merge-fields 'apikey' 'list-id' 'sampel@example.com' fields
|
||||
:: where fields is a (map cord json)
|
||||
:: and the list-id is most easily discovered through the /lists api
|
||||
::
|
||||
/- spider
|
||||
/+ *strandio
|
||||
=, strand=strand:spider
|
||||
=, dejs:format
|
||||
=/ m (strand ,vase)
|
||||
|^ ted
|
||||
++ api-post
|
||||
|= [[apik=@t list-id=@t] mail=@t vars=(map cord json)]
|
||||
%: send-request
|
||||
method=%'PATCH'
|
||||
url=(url list-id mail)
|
||||
::
|
||||
^= header-list
|
||||
:~ ['content-type' 'application/json']
|
||||
(basic-auth-header 'anystring' apik)
|
||||
==
|
||||
::
|
||||
^= body
|
||||
%- some
|
||||
%- as-octt:mimes:html
|
||||
%- en-json:html
|
||||
%- pairs:enjs:format
|
||||
['merge_fields' o+vars]~
|
||||
==
|
||||
::
|
||||
++ url
|
||||
|= [list-id=@t email=@t]
|
||||
^- @t
|
||||
%+ rap 3
|
||||
::NOTE us14 is the datacenter for our account, hardcoded
|
||||
:~ 'https://us14.api.mailchimp.com/3.0/lists/'
|
||||
list-id
|
||||
'/members/'
|
||||
email ::TODO force lowercase?
|
||||
'?skip_merge_validation=false'
|
||||
==
|
||||
::
|
||||
++ basic-auth-header ::TODO into http auth library
|
||||
|= [user=@t pass=@t]
|
||||
^- [key=@t value=@t]
|
||||
:- 'authorization'
|
||||
=+ full=(rap 3 user ':' pass ~)
|
||||
%^ cat 3 'Basic '
|
||||
(en:base64:mimes:html (met 3 full) full)
|
||||
::
|
||||
++ ted
|
||||
^- thread:spider
|
||||
|= arg=vase
|
||||
=/ m (strand ,vase) :: [gud=? res=@t]
|
||||
^- form:m
|
||||
=/ arg-mold
|
||||
$: api=[key=cord list-id=cord]
|
||||
to-email=cord
|
||||
vars=(map cord json)
|
||||
==
|
||||
=/ args !<((unit arg-mold) arg)
|
||||
?~ args (pure:m !>(|^%bad-args))
|
||||
;< ~ bind:m
|
||||
(api-post u.args)
|
||||
;< rep=client-response:iris bind:m
|
||||
take-client-response
|
||||
?> ?=(%finished -.rep)
|
||||
%- pure:m
|
||||
!> ^- [gud=? res=@t]
|
||||
:- =(200 status-code.response-header.rep)
|
||||
?~ full-file.rep %empty-body
|
||||
q.data.u.full-file.rep
|
||||
--
|
||||
66
desk/ted/save-summary.hoon
Normal file
66
desk/ted/save-summary.hoon
Normal file
@ -0,0 +1,66 @@
|
||||
:: -save-summary: unpack growl summary, store in mailchimp merge fields
|
||||
::
|
||||
:: crashes on failure. on success, produces the result message from the
|
||||
:: -mailchimp-update-merge-fields thread.
|
||||
::
|
||||
/- spider, hark
|
||||
/+ *strandio
|
||||
=, strand=strand:spider
|
||||
=, dejs:format
|
||||
^- thread:spider
|
||||
|= arg=vase
|
||||
=/ m (strand ,vase)
|
||||
^- form:m
|
||||
=/ arg-mold
|
||||
$: tlon-api-key=cord
|
||||
mailchimp=[key=cord list-id=cord]
|
||||
=ship
|
||||
::
|
||||
$= summary
|
||||
$% [%life [sen=@ud rec=@ud gro=@t] [dms=@ud etc=@ud group=@t chat=@t]]
|
||||
==
|
||||
==
|
||||
=/ args !<([~ arg-mold] arg)
|
||||
;< ~ bind:m
|
||||
%- send-raw-card
|
||||
:* %pass /check-email/(scot %p ship.args)
|
||||
%arvo %k %fard
|
||||
%garden %hosting-email %noun
|
||||
!>(`[(trip tlon-api-key.args) ship.args])
|
||||
==
|
||||
;< [mire=wire mine=sign-arvo] bind:m take-sign-arvo
|
||||
?> ?=([%check-email @ *] mire)
|
||||
?> =(i.t.mire (scot %p ship.args))
|
||||
?> ?=([%khan %arow %.y %noun *] mine)
|
||||
::
|
||||
=/ [%khan %arow %.y %noun vs=vase] mine
|
||||
=+ !<(mail=(unit cord) vs)
|
||||
?> ?=(^ mail)
|
||||
;< ~ bind:m
|
||||
%- send-raw-card
|
||||
:* %pass /update-merge-fields/(scot %p ship.args)
|
||||
%arvo %k %fard
|
||||
%garden %mailchimp-update-merge-fields %noun
|
||||
=; vars=(map @t json)
|
||||
!>(`[mailchimp.args u.mail vars])
|
||||
%- ~(gas by *(map @t json))
|
||||
=, summary.args
|
||||
:~ ['MSGS_SENT' (numb:enjs:format sen)]
|
||||
['MSGS_RECD' (numb:enjs:format rec)]
|
||||
['GROUP_SENT' s+gro]
|
||||
::
|
||||
['UNREAD_DMS' (numb:enjs:format dms)]
|
||||
['UNREAD_MSG' (numb:enjs:format etc)]
|
||||
['GROUP_NAME' s+group]
|
||||
['CHNL_NAME' s+chat]
|
||||
==
|
||||
==
|
||||
;< [wimp=wire simp=sign-arvo] bind:m take-sign-arvo
|
||||
?> ?=([%update-merge-fields @ *] wimp)
|
||||
?> =(i.t.wimp (scot %p ship.args))
|
||||
?> ?=([%khan %arow %.y %noun *] simp)
|
||||
::
|
||||
=/ [%khan %arow %.y %noun vs=vase] simp
|
||||
=+ !<([gud=? msg=@t] vs)
|
||||
?. gud ~|(msg !!)
|
||||
(pure:m !>(msg))
|
||||
Loading…
Reference in New Issue
Block a user