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

View File

@ -12,7 +12,9 @@
==
+$ peek-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]
==
+$ out-poke-data
@ -93,7 +95,17 @@
(pure:m |)
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]
=/ m (async:stdio ,~)
^- form:m
@ -125,15 +137,12 @@
:: +galaxy-domains
::
++ galaxy-domains
|= ames-domains=(list turf)
=/ m (async:stdio ,~)
^- form:m
;< our=@p bind:m get-identity:stdio
:: XX urbit/urbit#1314
::
:: ;< now=@da bind:m get-time:stdio
:: =/ ames-domains=(list turf)
:: .^((list turf) %j /(scot %p our)/turf/(scot %da now))
;< now=@da bind:m get-time:stdio
=/ ames-domains=(list turf)
.^((list turf) %j /(scot %p our)/turf/(scot %da now))
|- ^- form:m
=* loop $
?~ ames-domains
@ -148,7 +157,7 @@
:~ leaf+"XX check via nslookup"
leaf+"XX confirm port 80"
==
;< ~ bind:m (hall-app-message %dns msg)
;< ~ bind:m (app-message %dns msg)
loop(ames-domains t.ames-domains)
::
:: +request-by-ip
@ -197,7 +206,7 @@
::
~& %galaxy-only
(pure:m state)
;< ~ bind:m (galaxy-domains ames-domains.in-poke-data)
;< ~ bind:m galaxy-domains
(pure:m state)
::
:: manual dns binding -- by explicit ipv4
@ -242,7 +251,7 @@
:~ leaf+"XX check via nslookup"
leaf+"XX confirm port 80"
==
;< ~ bind:m (hall-app-message %dns msg)
;< ~ bind:m (app-message %dns msg)
=? completed.state good (some binding)
:: XX save failure?s
:: XX unsubscribe?
@ -263,12 +272,12 @@
?~ error.sign
=/ msg=cord
(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)
:: XX details
~& %dns-ip-request-failed
%- (slog u.error.sign)
(pure:m state)
(pure:m state(requested ~))
:: re-subscribe if (involuntarily) unsubscribed
::
%quit
@ -284,7 +293,7 @@
?~ error.sign
=/ msg=cord
(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)
:: XX details
~& %dns-domain-subscription-failed

View File

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

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
::
++ poke-app

View File

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

View File

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