Merge branch 'acme-dns-notifications' (#1894)

* acme-dns-notifications:
  dns: clear request from state on %coup error
  Revert "moves :dns scry for ames domains in :dns|auto generator"
  dns: sends notifications directly to %dill (and adds tapp support)
  acme: sends notifications directly to %dill

Signed-off-by: Jared Tobin <jared@tlon.io>
This commit is contained in:
Jared Tobin 2019-10-31 14:06:57 +08:00
commit f53d3f3143
No known key found for this signature in database
GPG Key ID: 0E4647D58F8A69E4
6 changed files with 97 additions and 45 deletions

View File

@ -153,6 +153,7 @@
[%request wire request:http outbound-config:iris] [%request wire request:http outbound-config:iris]
[%rule wire %cert (unit [wain wain])] [%rule wire %cert (unit [wain wain])]
[%wait wire @da] [%wait wire @da]
[%flog wire flog:dill]
== ==
:: +poke: outgoing app pokes :: +poke: outgoing app pokes
:: ::
@ -360,6 +361,15 @@
++ emit ++ emit
|= car=card |= car=card
this(mov [[ost.bow car] mov]) this(mov [[ost.bow car] mov])
:: +emil: emit a list of moves
::
++ emil
|= rac=(list card)
|- ^+ this
?~ rac
this
=. mov [[ost.bow i.rac] mov]
$(rac t.rac)
:: +abet: finalize transaction :: +abet: finalize transaction
:: ::
++ abet ++ abet
@ -380,9 +390,20 @@
|= [try=@ud act=@tas =wire] |= [try=@ud act=@tas =wire]
^- ^wire ^- ^wire
(weld /acme/try/(scot %ud try)/[act] wire) (weld /acme/try/(scot %ud try)/[act] wire)
:: +notify: send :hall notification :: +notify: send notification message
:: ::
++ notify ++ notify
|= [=cord =tang]
^- (list card)
:- [%flog / %text :(weld (trip dap.bow) ": " (trip cord))]
%+ turn
`wall`(zing (turn (flop tang) (cury wash [0 80])))
|=(=tape [%flog / %text tape])
:: +notify: send :hall notification
::
:: XX disabled due to :hall status
::
++ notify-disabled
|= [=cord =tang] |= [=cord =tang]
^- card ^- card
=/ msg=speech:hall =/ msg=speech:hall
@ -472,7 +493,7 @@
(join-turf ~(tap in dom.u.rod)) (join-turf ~(tap in dom.u.rod))
'. retrying in ~d7.' '. retrying in ~d7.'
== ==
(emit (notify msg ~)) (emil (notify msg ~))
:: too many certificates for top-level-domain :: too many certificates for top-level-domain
:: ::
?: ?=(^ (find "too many certificates already" detail)) ?: ?=(^ (find "too many certificates already" detail))
@ -489,7 +510,7 @@
'. retrying in ' '. retrying in '
(scot %dr lul) '.' (scot %dr lul) '.'
== ==
(emit (notify msg ~)) (emil (notify msg ~))
:: XX match more rate-limit conditions :: XX match more rate-limit conditions
:: or backoff by wire :: or backoff by wire
:: ::
@ -616,7 +637,7 @@
:: ::
=/ msg=cord =/ msg=cord
(cat 3 'retrying certificate request in ' (scot %dr lul)) (cat 3 'retrying certificate request in ' (scot %dr lul))
=. ..this (emit (notify msg ~)) =. ..this (emil (notify msg ~))
=. ..this (retry:effect try %new-order / lul) =. ..this (retry:effect try %new-order / lul)
:: domains might already be validated :: domains might already be validated
:: ::
@ -774,7 +795,7 @@
:~ 'unable to reach ' (scot %p our.bow) :~ 'unable to reach ' (scot %p our.bow)
' via http at ' (en-turf:html turf.i.item) ':80' ' via http at ' (en-turf:html turf.i.item) ':80'
== ==
(emit(next-order ~) (notify msg [(sell !>(rep)) ~])) (emil(next-order ~) (notify msg [(sell !>(rep)) ~]))
?: ?=(~ (skip ~(val by dom.u.next-order) |=([@ud valid=?] valid))) ?: ?=(~ (skip ~(val by dom.u.next-order) |=([@ud valid=?] valid)))
new-order:effect new-order:effect
(validate-domain:effect +(idx)) (validate-domain:effect +(idx))
@ -786,7 +807,7 @@
?. =(200 p.rep) ?. =(200 p.rep)
?: (lth try 10) ?: (lth try 10)
(retry:effect try %directory / (min ~m30 (backoff try))) (retry:effect try %directory / (min ~m30 (backoff try)))
(emit (notify (failure-message directory-base) [(sell !>(rep)) ~])) (emil (notify (failure-message directory-base) [(sell !>(rep)) ~]))
=. dir (directory:grab (need (de-json:html q:(need r.rep)))) =. dir (directory:grab (need (de-json:html q:(need r.rep))))
?~(reg.act register:effect this) ?~(reg.act register:effect this)
:: +nonce: accept new nonce and trigger next effect :: +nonce: accept new nonce and trigger next effect
@ -805,7 +826,7 @@
?. =(204 p.rep) ?. =(204 p.rep)
?: (lth try 10) ?: (lth try 10)
(retry:effect try %nonce t.wire (min ~m30 (backoff try))) (retry:effect try %nonce t.wire (min ~m30 (backoff try)))
(emit (notify (failure-message nonce.dir) [(sell !>(rep)) ~])) (emil (notify (failure-message nonce.dir) [(sell !>(rep)) ~]))
?- nex ?- nex
%register register:effect %register register:effect
%new-order new-order:effect %new-order new-order:effect
@ -822,7 +843,7 @@
:: ::
?: (lth try 10) ?: (lth try 10)
(retry:effect try %register / (min ~h1 (backoff try))) (retry:effect try %register / (min ~h1 (backoff try)))
(emit (notify (failure-message register.dir) [(sell !>(rep)) ~])) (emil (notify (failure-message register.dir) [(sell !>(rep)) ~]))
=/ loc=@t =/ loc=@t
q:(head (skim q.rep |=((pair @t @t) ?=(%location p)))) q:(head (skim q.rep |=((pair @t @t) ?=(%location p))))
:: XX @da once parser is fixed :: XX @da once parser is fixed
@ -852,7 +873,7 @@
(retry:effect try %new-order / (min ~h1 (backoff try))) (retry:effect try %new-order / (min ~h1 (backoff try)))
:: XX next steps, retrying in ?? :: XX next steps, retrying in ??
:: ::
(emit (notify (failure-message register.dir) [(sell !>(rep)) ~])) (emil (notify (failure-message register.dir) [(sell !>(rep)) ~]))
?> ?=(^ next-order) ?> ?=(^ next-order)
=/ loc=@t =/ loc=@t
q:(head (skim q.rep |=((pair @t @t) ?=(%location p)))) q:(head (skim q.rep |=((pair @t @t) ?=(%location p))))
@ -902,7 +923,7 @@
(retry:effect try %check-order / (min ~m10 (backoff try))) (retry:effect try %check-order / (min ~m10 (backoff try)))
:: XX next steps, retrying in, delete order ?? :: XX next steps, retrying in, delete order ??
:: ::
(emit (notify (failure-message ego.u.rod) [(sell !>(rep)) ~])) (emil (notify (failure-message ego.u.rod) [(sell !>(rep)) ~]))
=/ bod=order:body =/ bod=order:body
(order:grab (need (de-json:html q:(need r.rep)))) (order:grab (need (de-json:html q:(need r.rep))))
?+ sas.bod ?+ sas.bod
@ -916,7 +937,7 @@
:: XX possible to retry any reasons? :: XX possible to retry any reasons?
:: ::
=< cancel-order:effect =< cancel-order:effect
(emit (notify 'certificate order failed' [(sell !>(rep)) ~])) (emil (notify 'certificate order failed' [(sell !>(rep)) ~]))
:: initial order state :: initial order state
:: ::
%pending %pending
@ -958,7 +979,7 @@
:~ 'unable to download certificate. ' :~ 'unable to download certificate. '
'please confirm that your urbit has network connectivity.' 'please confirm that your urbit has network connectivity.'
== ==
(emit (notify msg [(sell !>(rep)) ~])) (emil (notify msg [(sell !>(rep)) ~]))
=/ cer=wain (to-wain:format q:(need r.rep)) =/ cer=wain (to-wain:format q:(need r.rep))
=/ fig=config =/ fig=config
:: XX expiration date :: XX expiration date
@ -978,7 +999,7 @@
:~ 'received https certificate for ' :~ 'received https certificate for '
(join-turf ~(tap in dom.u.liv)) (join-turf ~(tap in dom.u.liv))
== ==
(emit (notify msg ~)) (emil (notify msg ~))
:: set renewal timer, install certificate in %eyre :: set renewal timer, install certificate in %eyre
:: ::
:: Certificates expire after ~d90. We want time for retries and :: Certificates expire after ~d90. We want time for retries and
@ -1009,7 +1030,7 @@
(retry:effect try %get-authz / (min ~m10 (backoff try))) (retry:effect try %get-authz / (min ~m10 (backoff try)))
:: XX next steps, retrying in ?? :: XX next steps, retrying in ??
:: ::
(emit (notify (failure-message i.pending.aut.u.rod) [(sell !>(rep)) ~])) (emil (notify (failure-message i.pending.aut.u.rod) [(sell !>(rep)) ~]))
=/ bod=auth:body =/ bod=auth:body
(auth:grab (need (de-json:html q:(need r.rep)))) (auth:grab (need (de-json:html q:(need r.rep))))
=/ cal=trial =/ cal=trial
@ -1054,7 +1075,7 @@
'via ' (en-turf:html dom.aut) '. ' 'via ' (en-turf:html dom.aut) '. '
'please confirm your urbit has network connectivity.' 'please confirm your urbit has network connectivity.'
== ==
(emit (notify msg [(sell !>(rep)) ~])) (emil (notify msg [(sell !>(rep)) ~]))
=/ bod =/ bod
%- as-octs:mimes:html %- as-octs:mimes:html
(rap 3 [tok.cal.aut '.' (pass:thumb:jwk key.act) ~]) (rap 3 [tok.cal.aut '.' (pass:thumb:jwk key.act) ~])
@ -1069,7 +1090,7 @@
(sell !>((some bod))) (sell !>((some bod)))
leaf+"expected:" leaf+"expected:"
== ==
(emit (notify 'domain validation value is wrong' tang)) (emil (notify 'domain validation value is wrong' tang))
finalize-trial:effect finalize-trial:effect
:: +finalize-trial: :: +finalize-trial:
:: ::
@ -1091,7 +1112,7 @@
(retry:effect try %finalize-trial / (min ~m10 (backoff try))) (retry:effect try %finalize-trial / (min ~m10 (backoff try)))
:: XX next steps, check connectivity, etc. ?? :: XX next steps, check connectivity, etc. ??
:: ::
(emit (notify (failure-message ego.cal.aut) [(sell !>(rep)) ~])) (emil (notify (failure-message ego.cal.aut) [(sell !>(rep)) ~]))
:: XX get challenge, confirm urn:ietf:params:acme:error:connection :: XX get challenge, confirm urn:ietf:params:acme:error:connection
:: ::
:: =/ err=error:body :: =/ err=error:body
@ -1101,7 +1122,7 @@
=< cancel-order:effect =< cancel-order:effect
=/ msg=cord =/ msg=cord
'unable to finalize domain validation challenge' 'unable to finalize domain validation challenge'
(emit (notify msg [(sell !>(rep)) ~])) (emil (notify msg [(sell !>(rep)) ~]))
=/ bod=challenge:body =/ bod=challenge:body
(challenge:grab (need (de-json:html q:(need r.rep)))) (challenge:grab (need (de-json:html q:(need r.rep))))
:: XX check for other possible values in 200 response :: XX check for other possible values in 200 response
@ -1383,7 +1404,7 @@
:~ 'requesting an https certificate for ' :~ 'requesting an https certificate for '
(join-turf ~(tap in dom)) (join-turf ~(tap in dom))
== ==
(emit (notify msg ~)) (emil (notify msg ~))
:: if registered, create order :: if registered, create order
:: ::
?^ reg.act ?^ reg.act

View File

@ -12,7 +12,9 @@
== ==
+$ peek-data _!! +$ peek-data _!!
+$ in-poke-data +$ in-poke-data
$% [%dns-auto ames-domains=(list turf)] $% :: XX ames-domains unused, remove
::
[%dns-auto ames-domains=(list turf)]
[%dns-address =address:dns] [%dns-address =address:dns]
== ==
+$ out-poke-data +$ out-poke-data
@ -93,7 +95,17 @@
(pure:m |) (pure:m |)
loop(try +(try)) loop(try +(try))
:: ::
++ hall-app-message ++ app-message
|= [app=term =cord =tang]
=/ m (async:stdio ,~)
^- form:m
=/ msg=tape :(weld (trip app) ": " (trip cord))
;< ~ bind:m (flog-text:stdio msg)
(flog-tang:stdio tang)
::
:: XX disabled due to :hall's status
::
++ hall-app-message-disabled
|= [app=term =cord =tang] |= [app=term =cord =tang]
=/ m (async:stdio ,~) =/ m (async:stdio ,~)
^- form:m ^- form:m
@ -125,15 +137,12 @@
:: +galaxy-domains :: +galaxy-domains
:: ::
++ galaxy-domains ++ galaxy-domains
|= ames-domains=(list turf)
=/ m (async:stdio ,~) =/ m (async:stdio ,~)
^- form:m ^- form:m
;< our=@p bind:m get-identity:stdio ;< our=@p bind:m get-identity:stdio
:: XX urbit/urbit#1314 ;< now=@da bind:m get-time:stdio
:: =/ ames-domains=(list turf)
:: ;< now=@da bind:m get-time:stdio .^((list turf) %j /(scot %p our)/turf/(scot %da now))
:: =/ ames-domains=(list turf)
:: .^((list turf) %j /(scot %p our)/turf/(scot %da now))
|- ^- form:m |- ^- form:m
=* loop $ =* loop $
?~ ames-domains ?~ ames-domains
@ -148,7 +157,7 @@
:~ leaf+"XX check via nslookup" :~ leaf+"XX check via nslookup"
leaf+"XX confirm port 80" leaf+"XX confirm port 80"
== ==
;< ~ bind:m (hall-app-message %dns msg) ;< ~ bind:m (app-message %dns msg)
loop(ames-domains t.ames-domains) loop(ames-domains t.ames-domains)
:: ::
:: +request-by-ip :: +request-by-ip
@ -197,7 +206,7 @@
:: ::
~& %galaxy-only ~& %galaxy-only
(pure:m state) (pure:m state)
;< ~ bind:m (galaxy-domains ames-domains.in-poke-data) ;< ~ bind:m galaxy-domains
(pure:m state) (pure:m state)
:: ::
:: manual dns binding -- by explicit ipv4 :: manual dns binding -- by explicit ipv4
@ -242,7 +251,7 @@
:~ leaf+"XX check via nslookup" :~ leaf+"XX check via nslookup"
leaf+"XX confirm port 80" leaf+"XX confirm port 80"
== ==
;< ~ bind:m (hall-app-message %dns msg) ;< ~ bind:m (app-message %dns msg)
=? completed.state good (some binding) =? completed.state good (some binding)
:: XX save failure?s :: XX save failure?s
:: XX unsubscribe? :: XX unsubscribe?
@ -263,12 +272,12 @@
?~ error.sign ?~ error.sign
=/ msg=cord =/ msg=cord
(cat 3 'request for DNS sent to ' (scot %p p:collector-app)) (cat 3 'request for DNS sent to ' (scot %p p:collector-app))
;< ~ bind:m (hall-app-message %dns msg ~) ;< ~ bind:m (app-message %dns msg ~)
(pure:m state) (pure:m state)
:: XX details :: XX details
~& %dns-ip-request-failed ~& %dns-ip-request-failed
%- (slog u.error.sign) %- (slog u.error.sign)
(pure:m state) (pure:m state(requested ~))
:: re-subscribe if (involuntarily) unsubscribed :: re-subscribe if (involuntarily) unsubscribed
:: ::
%quit %quit
@ -284,7 +293,7 @@
?~ error.sign ?~ error.sign
=/ msg=cord =/ msg=cord
(cat 3 'awaiting response from ' (scot %p p:collector-app)) (cat 3 'awaiting response from ' (scot %p p:collector-app))
;< ~ bind:m (hall-app-message %dns msg ~) ;< ~ bind:m (app-message %dns msg ~)
(pure:m state) (pure:m state)
:: XX details :: XX details
~& %dns-domain-subscription-failed ~& %dns-domain-subscription-failed

View File

@ -6,7 +6,7 @@
/+ *generators /+ *generators
:- %ask :- %ask
|= [[now=@da eny=@uvJ bec=beak] ~ ~] |= [[now=@da eny=@uvJ bec=beak] ~ ~]
^- (sole-result [%dns-auto (list turf)]) ^- (sole-result [%dns-auto ~])
=* our p.bec =* our p.bec
=/ rac (clan:title our) =/ rac (clan:title our)
:: ::
@ -23,7 +23,4 @@
%+ print leaf+msg3 %+ print leaf+msg3
%+ print leaf+msg2 %+ print leaf+msg2
(print leaf+msg1 no-product) (print leaf+msg1 no-product)
:: (produce [%dns-auto ~])
=/ ames-domains=(list turf)
.^((list turf) %j /(scot %p our)/turf/(scot %da now))
(produce [%dns-auto ames-domains])

View File

@ -344,6 +344,35 @@
:: ::
:: ---- :: ----
:: ::
:: Output
::
++ flog
|= =flog:dill
=/ m (async ,~)
^- form:m
(send-raw-card %flog / flog)
::
++ flog-text
|= =tape
=/ m (async ,~)
^- form:m
(flog %text tape)
::
++ flog-tang
|= =tang
=/ m (async ,~)
^- form:m
=/ =wall
(zing (turn (flop tang) (cury wash [0 80])))
|- ^- form:m
=* loop $
?~ wall
(pure:m ~)
;< ~ bind:m (flog-text i.wall)
loop(wall t.wall)
::
:: ----
::
:: Apps :: Apps
:: ::
++ poke-app ++ poke-app

View File

@ -20,6 +20,7 @@
[%sources wire ~] [%sources wire ~]
[%new-event wire =ship =udiff:point:able:jael] [%new-event wire =ship =udiff:point:able:jael]
[%listen wire whos=(set ship) =source:jael] [%listen wire whos=(set ship) =source:jael]
[%flog wire flog:dill]
== ==
:: ::
:: Possible async responses :: Possible async responses

View File

@ -16,15 +16,10 @@
++ test-first-order ++ test-first-order
=/ dom=(set turf) (sy /org/urbit/zod ~) =/ dom=(set turf) (sy /org/urbit/zod ~)
=^ moves app (~(poke-acme-order app *bowl:gall *acme:app) dom) =^ moves app (~(poke-acme-order app *bowl:gall *acme:app) dom)
=/ msg 'requesting an https certificate for zod.urbit.org'
;: weld ;: weld
%+ expect-eq %+ expect-eq
!> :~ =- [ost.bow.app [%poke / -]] !> 2
=- [[~zod %hall] %hall-action %phrase (sy [~zod %inbox] ~) -] !> (lent moves)
~[[%app %$ [%lin & msg]]]
[ost.bow.app %wait /acme/try/1/directory +(now.bow.app)]
==
!> moves
:: ::
%+ expect-eq %+ expect-eq
!> [~ dom] !> [~ dom]