/- asn1 /+ base64, der, primitive-rsa, *pkcs, *jose =, eyre =* rsa primitive-rsa :: |% :: +en-base64url: url-safe base64 encoding, without padding :: ++ en-base64url ~(en base64 | &) :: +de-base64url: url-safe base64 decoding, without padding :: ++ de-base64url ~(de base64 | &) :: |octn: encode/decode unsigned atoms as big-endian octet stream :: ++ octn |% ++ en |=(a=@u `octs`[(met 3 a) (swp 3 a)]) ++ de |=(a=octs `@u`(rev 3 p.a q.a)) -- :: |body: acme api response body types :: ++ body |% +$ acct [id=@t wen=@t sas=@t] :: +$ order $: exp=@t sas=@t aut=(list purl) fin=(unit purl) cer=(unit purl) == :: +$ auth $: dom=turf sas=@t exp=@t cal=challenge == :: +$ challenge [typ=@t sas=@t url=purl tok=@t err=(unit error)] :: +$ error [type=@t detail=@t] -- :: :: |grab: acme api response json reparsers :: ++ grab =, dejs:format |% :: +json-purl: parse url :: ++ json-purl (su auri:de-purl:html) :: +json-date: parse iso-8601 :: :: XX actually parse :: ++ json-date so :: +directory: parse ACME service directory :: ++ directory %- ot :~ 'newAccount'^json-purl 'newNonce'^json-purl 'newOrder'^json-purl 'revokeCert'^json-purl 'keyChange'^json-purl == :: +acct: parse ACME service account :: ++ acct ^- $-(json acct:body) :: ignoring key, contact, initialIp :: (ot 'id'^no 'createdAt'^json-date 'status'^so ~) :: +order: parse certificate order :: ++ order ^- $-(json order:body) %- ou :~ 'expires'^(un json-date) 'status'^(un so) 'authorizations'^(uf ~ (ar json-purl)) 'finalize'^(uf ~ (mu json-purl)) 'certificate'^(uf ~ (mu json-purl)) == :: +auth: parse authorization :: ++ auth => |% :: +iden: extract +turf from service identifier :: ++ iden |= [typ=@t hot=host] ^- turf ?>(&(?=(%dns typ) ?=([%& *] hot)) p.hot) :: +http-trial: extract %http-01 challenge :: ++ trial |= a=(list challenge:body) ^- challenge:body =/ b (skim a |=([typ=@t *] ?=(%http-01 typ))) ?>(?=(^ b) i.b) -- ^- $-(json auth:body) %- ot :~ 'identifier'^(cu iden (ot type+so value+(su thos:de-purl:html) ~)) 'status'^so 'expires'^json-date 'challenges'^(cu trial (ar challenge)) == :: +challenge: parse domain validation challenge :: ++ challenge ^- $-(json challenge:body) %- ou :~ 'type'^(un so) 'status'^(un so) 'url'^(un json-purl) 'token'^(un so) 'error'^(uf ~ (mu error)) == :: +error: parse ACME service error response :: ++ error ^- $-(json error:body) (ot type+so detail+so ~) -- -- :: :::: acme state :: |% :: +move: output effect :: += move [bone card] :: +card: output effect payload :: += card $% [%flog wire flog:dill] [%hiss wire ~ %httr %hiss hiss:eyre] [%rule wire %cert (unit [wain wain])] [%wait wire @da] [%well wire path (unit mime)] == :: +nonce-next: next effect to emit upon receiving nonce :: += nonce-next $? %register %new-order %finalize-order %finalize-trial == :: +acct: an ACME service account :: += acct $: :: key: account keypair :: key=key:rsa :: reg: account registration :: :: XX wen=@da once parser is fixed :: reg=(unit [wen=@t kid=@t]) == :: +config: finalized configuration :: += config $: :: dom: domains :: dom=(set turf) :: key: certificate keypair :: key=key:rsa :: cer: signed certificate :: cer=wain :: exp: expiration date :: exp=@da :: dor: source ACME service order URL :: dor=purl == :: +trial: domain validation challenge :: += trial $% :: %http only for now :: $: %http :: ego: ACME service challenge url :: ego=purl :: tok: challenge token :: tok=@t :: sas: challenge status :: sas=?(%recv %pend %auth) == == :: +auth: domain authorization :: += auth $: :: ego: ACME service authorization url :: ego=purl :: dom: domain under authorization :: dom=turf :: cal: domain validation challenge :: cal=trial == :: +order-auth: domain authorization state for order processing :: += order-auth $: :: pending: remote authorization urls :: pending=(list purl) :: active: authorization in progress :: active=(unit [idx=@ auth]) :: done: finalized authorizations (XX or failed?) :: done=(list auth) == :: +order: ACME certificate order :: += order $: :: dom: domains :: dom=(set turf) :: sas: order state :: sas=$@(%wake [%rest wen=@da]) :: exp: expiration date :: :: XX @da once ISO-8601 parser :: exp=@t :: ego: ACME service order url :: ego=purl :: fin: ACME service order finalization url :: fin=purl :: key: certificate keypair :: key=key:rsa :: csr: DER-encoded PKCS10 certificate signing request :: csr=@ux :: aut: authorizations required by this order :: aut=order-auth == :: +history: archive of past ACME service interactions :: += history $: :: act: list of revoked account keypairs :: act=(list acct) :: fig: list of expired configurations :: fig=(list config) :: fal: list of failed order attempts :: fal=(list order) == :: +directory: ACME v2 service directory :: += directory $: :: register: registration url (newAccount) :: register=purl :: nonce: nonce creation url (newNonce) :: nonce=purl :: new-order: order creation url (newOrder) :: new-order=purl :: revoke: certificate revocation url (revokeCert) :: revoke=purl :: rekey: account key revocation url (keyChange) :: rekey=purl == :: +acme: complete app state :: += acme $: :: dir: ACME service directory :: dir=directory :: act: ACME service account :: act=acct :: liv: active, live configuration :: liv=(unit config) :: hit: ACME account history :: hit=history :: nonces: list of unused nonces :: nonces=(list @t) :: rod: active, in-progress order :: rod=(unit order) :: next-order: queued domains for validation :: next-order=(unit (map turf [idx=@ud valid=? try=@ud])) :: cey: certificate key XX move? :: cey=key:rsa == -- :: :::: acme app :: :: mov: list of outgoing moves for the current transaction :: =| mov=(list move) :: |_ [bow=bowl:gall acme] :: +this: self :: :: XX Should be a +* core alias, see urbit/arvo#712 :: ++ this . :: +emit: emit a move :: ++ emit |= car=card this(mov [[ost.bow car] mov]) :: +abet: finalize transaction :: ++ abet ^- (quip move _this) [(flop mov) this(mov ~)] :: +backoff: calculate exponential backoff :: ++ backoff |= try=@ud ^- @dr ?: =(0 try) ~s0 %+ add (mul ~s1 (bex (dec try))) (mul ~s0..0001 (~(rad og eny.bow) 1.000)) :: +request: unauthenticated http request :: ++ request |= [wir=wire req=hiss] ^- card [%hiss wir ~ %httr %hiss req] :: +signed-request: JWS JSON POST :: ++ signed-request |= [url=purl non=@t bod=json] ^- hiss :^ url %post (my content-type+['application/jose+json' ~] ~) :- ~ ^- octs =; pro=json (as-octt:mimes:html (en-json:html (sign:jws key.act pro bod))) :- %o %- my :~ nonce+s+non url+s+(crip (en-purl:html url)) ?^ reg.act kid+s+kid.u.reg.act jwk+(pass:en:jwk key.act) == :: +stateful-request: emit signed, nonce'd request :: ++ stateful-request |= [act=@tas =wire =purl =json] ^+ this ?~ nonces (nonce:effect act) %- emit(nonces t.nonces) %+ request [%acme act wire] (signed-request purl i.nonces json) :: +bad-nonce: check if an http response is a badNonce error :: ++ bad-nonce |= rep=httr ^- ? :: XX always 400? :: ?. =(400 p.rep) | ?~ r.rep | =/ jon=(unit json) (de-json:html q.u.r.rep) ?~ jon | =('urn:ietf:params:acme:error:badNonce' type:(error:grab u.jon)) :: |effect: send moves to advance :: ++ effect |% :: +validate-domain: confirm that a pending domain resolves to us :: ++ validate-domain |= idx=@ud ^+ this ~| %validate-domain-effect-fail ?. ?=(^ next-order) ~|(%no-next-order !!) =/ pending (skip ~(tap by u.next-order) |=([* * valid=? *] valid)) ?: =(~ pending) new-order:effect =/ next=[=turf idx=@ud valid=? try=@ud] ~| [%no-next-domain idx=idx] (head (skim pending |=([* idx=@ud * *] =(idx ^idx)))) :: XX should confirm that :turf points to us :: confirms that domain exists (and an urbit is on :80) :: =/ =purl :- [sec=| por=~ host=[%& turf.next]] [[ext=`~.udon path=/static] query=~] =/ =wire /acme/validate-domain/idx/(scot %ud idx.next)/try/(scot %ud try.next) (emit (request wire purl %get ~ ~)) :: +directory: get ACME service directory :: ++ directory ^+ this =/ url =- (need (de-purl:html -)) 'https://acme-staging-v02.api.letsencrypt.org/directory' :: XX now in wire? :: (emit (request /acme/directory/(scot %p our.bow) url %get ~ ~)) :: +nonce: get a new nonce for the next request :: ++ nonce |= nex=@tas ~| [%bad-nonce-next nex] ?> ?=(nonce-next nex) ^+ this :: XX now? :: (emit (request /acme/nonce/next/[nex] nonce.dir %get ~ ~)) :: +register: create ACME service account :: :: Note: accepts services ToS. :: XX add rekey mechanism :: ++ register ^+ this =/ =json [%o (my [['termsOfServiceAgreed' b+&] ~])] :: XX date in wire? :: (stateful-request %register /(scot %p our.bow) register.dir json) :: +renew: renew certificate :: ++ renew ^+ this ~| %renew-effect-fail ?. ?=(^ reg.act) ~|(%no-account !!) ?. ?=(^ liv) ~|(%no-live-config !!) =< new-order:effect (queue-next-order & dom.u.liv) :: +new-order: create a new certificate order :: ++ new-order ^+ this ~| %new-order-effect-fail ?. ?=(^ reg.act) ~|(%no-account !!) ?. ?=([~ ^] next-order) ~|(%no-domains !!) =/ =json :- %o %- my :~ :- %identifiers :- %a %+ turn ~(tap in ~(key by `(map turf *)`u.next-order)) |=(a=turf [%o (my type+s+'dns' value+s+(join '.' a) ~)]) == (stateful-request %new-order /(scot %da now.bow) new-order.dir json) :: +cancel-order: cancel failed order, set retry timer :: ++ cancel-order ^+ this ~| %cancel-order-effect-fail ?> ?=(^ rod) :: XX get failure reason :: domains might already be validated :: => (queue-next-order & dom.u.rod) => cancel-current-order :: XX backoff, count retries, how long, etc. :: (retry:effect /new-order ~m10) :: +finalize-order: finalize completed order :: ++ finalize-order ^+ this ~| %finalize-order-effect-fail ?. ?=(^ reg.act) ~|(%no-account !!) ?. ?=(^ rod) ~|(%no-active-order !!) ?. ?=(~ pending.aut.u.rod) ~|(%pending-authz !!) ?. ?=(~ active.aut.u.rod) ~|(%active-authz !!) :: XX revisit wrt rate limits :: ?> ?=(%wake sas.u.rod) =/ =json [%o (my csr+s+(en-base64url (met 3 csr.u.rod) `@`csr.u.rod) ~)] (stateful-request %finalize-order /(scot %da now.bow) fin.u.rod json) :: +check-order: check completed order for certificate availability :: ++ check-order ^+ this ~| %check-order-effect-fail ?. ?=(^ reg.act) ~|(%no-account !!) ?. ?=(^ rod) ~|(%no-active-order !!) ?. ?=(~ pending.aut.u.rod) ~|(%pending-authz !!) ?. ?=(~ active.aut.u.rod) ~|(%active-authz !!) :: XX revisit wrt rate limits :: ?> ?=(%wake sas.u.rod) (emit (request /acme/check-order/(scot %da now.bow) ego.u.rod %get ~ ~)) :: +certificate: download PEM-encoded certificate :: ++ certificate |= url=purl ^+ this ~| %certificate-effect-fail ?. ?=(^ reg.act) ~|(%no-account !!) ?. ?=(^ rod) ~|(%no-active-order !!) =/ hed (my accept+['applicate/x-pem-file' ~] ~) (emit (request /acme/certificate/(scot %da now.bow) url %get hed ~)) :: +install: tell %eyre about our certificate :: ++ install ^+ this ~| %install-effect-fail ?> ?=(^ liv) =/ key=wain (ring:en:pem:pkcs8 key.u.liv) (emit %rule /install %cert `[key `wain`cer.u.liv]) :: +get-authz: get next ACME service domain authorization object :: ++ get-authz ^+ this ~| %get-authz-effect-fail ?. ?=(^ reg.act) ~|(%no-account !!) ?. ?=(^ rod) ~|(%no-active-order !!) ?. ?=(^ pending.aut.u.rod) ~|(%no-pending-authz !!) :: XX revisit wrt rate limits :: ?> ?=(%wake sas.u.rod) %- emit (request /acme/get-authz/(scot %da now.bow) i.pending.aut.u.rod %get ~ ~) :: XX check/finalize-authz ?? :: :: +save-trial: save ACME domain validation challenge to /.well-known/ :: ++ save-trial ^+ this ~| %save-trial-effect-fail ?. ?=(^ reg.act) ~|(%no-account !!) ?. ?=(^ rod) ~|(%no-active-order !!) ?. ?=(^ active.aut.u.rod) ~|(%no-active-authz !!) :: XX revisit wrt rate limits :: ?> ?=(%wake sas.u.rod) =* aut u.active.aut.u.rod %- emit :^ %well :: XX idx in wire? :: /acme/save-trial/(scot %da now.bow) /acme-challenge/[tok.cal.aut] :+ ~ /text/plain %- as-octs:mimes:html (rap 3 [tok.cal.aut '.' (pass:thumb:jwk key.act) ~]) :: +test-trial: confirm that ACME domain validation challenge is available :: ++ test-trial ^+ this ~| %test-trial-effect-fail ?. ?=(^ reg.act) ~|(%no-account !!) ?. ?=(^ rod) ~|(%no-active-order !!) ?. ?=(^ active.aut.u.rod) ~|(%no-active-authz !!) :: XX revisit wrt rate limits :: ?> ?=(%wake sas.u.rod) =* aut u.active.aut.u.rod =/ pat=path /'.well-known'/acme-challenge/[tok.cal.aut] :: note: requires port 80, just as the ACME service will :: =/ url=purl [[sec=| por=~ hos=[%& dom.aut]] [ext=~ pat] hed=~] :: =/ url=purl [[sec=| por=`8.081 hos=[%& /localhost]] [ext=~ pat] hed=~] :: XX idx in wire? :: (emit (request /acme/test-trial/(scot %da now.bow) url %get ~ ~)) :: +finalize-trial: notify ACME service that challenge is ready :: ++ finalize-trial ^+ this ~| %finalize-trial-effect-fail ?. ?=(^ reg.act) ~|(%no-account !!) ?. ?=(^ rod) ~|(%no-active-order !!) ?. ?=(^ active.aut.u.rod) ~|(%no-active-authz !!) :: XX revisit wrt rate limits :: ?> ?=(%wake sas.u.rod) =* aut u.active.aut.u.rod :: empty object included for signature :: XX include index in wire? :: (stateful-request %finalize-trial /(scot %da now.bow) ego.cal.aut [%o ~]) :: XX delete-trial? :: :: +retry: retry effect after timeout :: ++ retry |= [=wire lull=@dr] :: XX validate wire :: (emit %wait [%acme wire] (add now.bow lull)) -- :: |event: accept event, emit next effect(s) :: :: XX should these next effects be triggered at call sites instead? :: ++ event |% :: +validate-domain: accept a pending domain confirmation response :: ++ validate-domain |= [=wire rep=httr] ^+ this ?> ?=([%validate-domain %idx @ %try @ *] wire) ?. ?=(^ next-order) this =/ idx (slav %ud i.t.t.wire) =/ try (slav %ud i.t.t.t.t.wire) =/ valid =(200 p.rep) =/ item=(list [=turf idx=@ud valid=? try=@ud]) (skim ~(tap by u.next-order) |=([* idx=@ud *] =(^idx idx))) ?. ?& ?=([^ ~] item) !valid.i.item == this =. u.next-order (~(put by u.next-order) turf.i.item [idx valid +(try)]) ?. valid ?: (lth try 8) =/ wire /validate-domain/idx/(scot %ud idx) (retry:effect wire (min ~h1 (backoff try))) :: XX remove next-order, cancel pending requests :: XX more detailed error message :: =/ msg=tape "unable to reach {(trip (join '.' turf.i.item))}" (emit [%flog / %text msg]) ?: ?=(~ (skip ~(tap by u.next-order) |=([* * valid=? *] valid))) new-order:effect (validate-domain:effect +(idx)) :: +directory: accept ACME service directory, trigger registration :: ++ directory |= [wir=wire rep=httr] ^+ this ?. =(200 p.rep) ~& [%directory-fail rep] ?: =(504 p.rep) :: retry timeouts :: XX count retries? backoff? :: ~& %retrying (retry:effect /directory ~s10) :: XX never happened yet, wat do? :: this =. dir (directory:grab (need (de-json:html q:(need r.rep)))) ?~(reg.act register:effect this) :: +nonce: accept new nonce and trigger next effect :: :: Nonce has already been saved in +sigh-httr. The next effect :: is specified in the wire. :: ++ nonce |= [wir=wire rep=httr] ^+ this ~| [%unrecognized-nonce-wire wir] ?> &(?=(^ wir) ?=([%next ^] t.wir)) =* nex i.t.t.wir ~| [%unknown-nonce-next nex] ?> ?=(nonce-next nex) ?. =(204 p.rep) ~& [%nonce-fail wir rep] :: cttp i/o timeout, always retry :: XX set timer? count retries? backoff? :: ?: =(504 p.rep) (nonce:effect nex) :: XX never happened yet, retry nonce anyway? :: this ?- nex %register register:effect %new-order new-order:effect %finalize-order finalize-order:effect %finalize-trial finalize-trial:effect == :: +register: accept ACME service registration :: ++ register |= [wir=wire rep=httr] ^+ this ?. |(=(200 p.rep) =(201 p.rep)) :: XX possible 204? :: ?: (bad-nonce rep) (nonce:effect %register) ~& [%register-fail wir rep] ?: =(504 p.rep) :: retry timeouts :: XX count retries? backoff? :: ~& %retrying (retry:effect /register ~s10) :: XX retry service failures? :: this =/ loc=@t q:(head (skim q.rep |=((pair @t @t) ?=(%location p)))) :: XX @da once parser is fixed :: =/ wen=@t ?~ r.rep (scot %da now.bow) =/ bod=acct:body (acct:grab (need (de-json:html q.u.r.rep))) ?> ?=(%valid sas.bod) wen.bod =. reg.act `[wen loc] ?: =(~ next-order) this (validate-domain:effect 0) :: XX rekey :: :: +new-order: order created, begin processing authorizations :: ++ new-order |= [wir=wire rep=httr] ^+ this ?. =(201 p.rep) :: XX possible 204? :: ?: (bad-nonce rep) (nonce:effect %new-order) ~& [%new-order-fail wir rep] ?: =(504 p.rep) :: retry timeouts :: XX count retries? backoff? :: ~& %retrying (retry:effect /new-order ~s10) :: XX retry service failures? :: this :: XX delete order if not? :: ?> ?=(^ next-order) =/ loc=@t q:(head (skim q.rep |=((pair @t @t) ?=(%location p)))) =/ ego=purl (need (de-purl:html loc)) :: XX parse identifiers, confirm equal to pending domains :: XX check status :: =/ bod=order:body (order:grab (need (de-json:html q:(need r.rep)))) =/ dom=(set turf) ~(key by u.next-order) :: XX maybe generate key here? :: =/ csr=@ux +:(en:der:pkcs10 cey ~(tap in dom)) =/ dor=order [dom sas=%wake exp.bod ego (need fin.bod) cey csr [aut.bod ~ ~]] get-authz:effect(rod `dor, next-order ~) :: +finalize-order: order finalized, poll for certificate :: ++ finalize-order |= [wir=wire rep=httr] ^+ this ?: (bad-nonce rep) (nonce:effect %finalize-order) ?: =(504 p.rep) :: retry timeouts :: XX count retries? backoff? :: ~& [%finalize-order-fail wir rep] ~& %retrying (retry:effect /finalize-order ~s10) :: check-order regardless of status code :: check-order:effect :: +check-order: check order status, dispatch appropriately :: ++ check-order |= [wir=wire rep=httr] ^+ this ?. =(200 p.rep) ~& [%check-order-fail wir rep] ?: =(504 p.rep) :: retry timeouts :: XX count retries? backoff? :: ~& %retrying (retry:effect /check-order ~s10) :: XX retry service failures? :: this ?> ?=(^ rod) =/ bod=order:body (order:grab (need (de-json:html q:(need r.rep)))) ?+ sas.bod ~& [%check-order-status-unknown sas.bod] this :: order failed (at any stage) :: %invalid ~& [%check-order-fail %invalid wir rep] :: XX check authz, get the failure reason :: XX possible to retry any reasons? :: XX send notification somehow? :: cancel-order:effect :: initial order state :: %pending check-order:effect :: validations completed :: %ready finalize-order:effect :: finalization requested :: %processing check-order:effect :: certificate issued :: %valid :: XX update order state :: XX =< delete-trial :: ~| impossible-order+[wir rep bod] (certificate:effect (need cer.bod)) == :: :: +certificate: accept PEM-encoded certificate :: ++ certificate |= [wir=wire rep=httr] ^+ this ?. =(200 p.rep) ~& [%certificate-fail wir rep] ?: =(504 p.rep) :: retry timeouts :: XX count retries? backoff? :: ~& %retrying :: will re-attempt certificate download per order status :: (retry:effect /check-order ~s10) :: XX retry service failures? :: this ?> ?=(^ rod) =/ cer=wain (to-wain:format q:(need r.rep)) =/ fig=config :: XX expiration date :: [dom.u.rod key.u.rod cer (add now.bow ~d90) ego.u.rod] :: archive live config :: =? fig.hit ?=(^ liv) [u.liv fig.hit] :: =/ msg=tape =- "received https certificate for {(trip -)}" (join ', ' (turn ~(tap in dom.u.rod) |=(a=turf (join '.' a)))) %. [%flog / %text msg] =< emit :: set live config, install certificate, set renewal timer :: =< install:effect (retry:effect(liv `fig, rod ~) /renew ~d60) :: +get-authz: accept ACME service authorization object :: ++ get-authz |= [wir=wire rep=httr] ^+ this ?. =(200 p.rep) ~& [%get-authz-fail wir rep] ?: =(504 p.rep) :: retry timeouts :: XX count retries? backoff? :: ~& %retrying (retry:effect /get-authz ~s10) :: XX retry service failures? :: this ?> ?=(^ rod) ?> ?=(^ pending.aut.u.rod) =/ bod=auth:body (auth:grab (need (de-json:html q:(need r.rep)))) =/ cal=trial :: XX parse token to verify url-safe base64? :: [%http url.cal.bod tok.cal.bod %recv] :: XX check that URLs are the same :: =/ tau=auth [i.pending.aut.u.rod dom.bod cal] :: XX get idx from wire instead? :: =/ idx=@ud +((lent done.aut.u.rod)) =/ rod-aut=order-auth %= aut.u.rod pending t.pending.aut.u.rod active `[idx tau] == =< test-trial:effect save-trial:effect(aut.u.rod rod-aut) :: XX check/finalize-authz ?? :: :: +test-trial: accept response from challenge test :: :: Note that +save-trial:effect has no corresponding event. :: ++ test-trial |= [wir=wire rep=httr] ^+ this ?. =(200 p.rep) ~& [%test-trial-fail wir rep] :: XX this condition will need to change if vere/cttp timeouts change :: ?: &(=(504 p.rep) ?=(~ r.rep)) :: retry timeouts :: XX count retries, backoff :: (retry:effect /test-trial ~s10) this ?> ?=(^ rod) ?> ?=(^ active.aut.u.rod) =* aut u.active.aut.u.rod =/ bod %- as-octs:mimes:html (rap 3 [tok.cal.aut '.' (pass:thumb:jwk key.act) ~]) ?. ?& ?=(^ r.rep) =(bod u.r.rep) == :: XX save-trail again? :: XX probably a DNS misconfiguration :: ~& [%test-trial-mismatch expected=bod got=[wir rep]] this finalize-trial:effect :: +finalize-trial: :: ++ finalize-trial |= [wir=wire rep=httr] ^+ this ?. =(200 p.rep) :: XX possible 204? assume pending? :: XX handle "challenge is not pending" :: ?: (bad-nonce rep) (nonce:effect %finalize-trial) ?: =(504 p.rep) :: retry timeouts :: XX count retries? backoff? :: ~& %finalize-trial-retrying (retry:effect /finalize-trial ~s10) :: XX get challenge, confirm urn:ietf:params:acme:error:connection :: :: =/ err=error:body :: (error:grab (need (de-json:html q:(need r.rep)))) :: ?: =('urn:ietf:params:acme:error:malformed' status.err) :: ~& [%finalize-trial-fail wir rep] cancel-order:effect ?> ?=(^ rod) ?> ?=(^ active.aut.u.rod) =* aut u.active.aut.u.rod =/ bod=challenge:body (challenge:grab (need (de-json:html q:(need r.rep)))) :: XX check for other possible values in 200 response :: note: may have already been validated :: ?> ?=(?(%pending %valid) sas.bod) =/ rod-aut=order-auth aut.u.rod(active ~, done [+.aut(sas.cal %pend) done.aut.u.rod]) ?~ pending.aut.u.rod check-order:effect(aut.u.rod rod-aut) get-authz:effect(aut.u.rod rod-aut) :: XX delete-trial? :: :: +retry: retry effect after timeout :: ++ retry |= wir=wire ^+ this ?> ?=(^ wir) ?+ i.wir ~&(unknown-retry+wir this) %validate-domain ?> ?=([%validate-domain %idx @ ~] wir) (validate-domain:effect (slav %ud i.t.t.wir)) %directory directory:effect %register register:effect %renew renew:effect %new-order new-order:effect %finalize-order finalize-order:effect %check-order check-order:effect %get-authz get-authz:effect %test-trial test-trial:effect %finalize-trial finalize-trial:effect == -- :: +sigh-tang: handle http request failure :: ++ sigh-tang |= [wir=wire saw=tang] ^- (quip move _this) ~& [%sigh-tang wir] :: XX take evasive action :: [((slog saw) ~) this] :: +sigh-recoverable-error: handle http rate-limit response :: ++ sigh-recoverable-error |= [wir=wire %429 %rate-limit lim=(unit @da)] ^- (quip move _this) ~& [%sigh-recoverable wir lim] :: XX retry :: [~ this] :: +sigh-httr: accept http response :: ++ sigh-httr |= [wir=wire rep=httr] ^- (quip move _this) ?> ?=([%acme ^] wir) :: add nonce to pool, if present :: =/ nonhed (skim q.rep |=((pair @t @t) ?=(%replay-nonce p))) =? nonces ?=(^ nonhed) [q.i.nonhed nonces] =< abet ~| [%sigh-fail wir rep] %. [t.wir rep] ?+ i.t.wir ~&([%unknown-wire i.t.wir] !!) %validate-domain validate-domain:event %directory directory:event %nonce nonce:event %register register:event :: XX rekey :: %new-order new-order:event %finalize-order finalize-order:event %check-order check-order:event %certificate certificate:event %get-authz get-authz:event :: XX check/finalize-authz ?? :: %test-trial test-trial:event %finalize-trial finalize-trial:event :: XX delete-trial? :: == :: +wake: timer wakeup event :: ++ wake |= [wir=wire ~] ^- (quip move _this) ~& [%wake wir] ?> ?=([%acme *] wir) abet:(retry:event t.wir) :: +poke-acme-order: create new order for a set of domains :: ++ poke-acme-order |= a=(set turf) ~& [%poke-acme a] abet:(add-order a) :: +poke-noun: for debugging :: ++ poke-noun |= a=* ^- (quip move _this) =< abet ?+ a ~&(+<+.this this) %dbug ~& [%private (ring:en:pem:pkcs1 key.act)] ~& [%public (pass:en:pem:pkcs1 key.act)] this %init init %reg register:effect %order new-order:effect %auth get-authz:effect %trial test-trial:effect %final finalize-order:effect %poll check-order:effect %our (add-order (sy /org/urbit/(crip +:(scow %p our.bow)) ~)) %rule install:effect %fake fake %none none == :: +none: uninstall cert for testing :: :: XX remove :: ++ none ^+ this (emit %rule /uninstall %cert ~) :: +fake: install fake cert for testing :: :: XX remove :: ++ fake ^+ this =/ key=wain :~ '-----BEGIN RSA PRIVATE KEY-----' 'MIIEpAIBAAKCAQEAisQPzzmGWNZSNNAwY59XrqK/bU0NKNZS2ETOiJeSpzPAHYl+' 'c39V96/QUR0tra2zQI4QD6kpMYX/7R5nwuvsA4o7ypfYupNrlzLPThCKEHpZomDD' '0Bb3T8u7YGrMjEX5cOmZIU2T/iy4GK/wWuBIy2TEp/0J+RoSCIr8Df/A7GIM8bwn' 'v23Vq0kE2xBqqaT5LjvuQoXfiLJ42F33DDno9lVikKEyt55D/08rH41KpXvn3tWZ' '46tZK6Ds7Zr1hEV1LbDx1CXDzQ6gKObBe54DWDV3h7TJhr0BSW68dFJhro7Y60Ns' 'zTcFqY1RC9F0ePtsnKGFzMOe/U+fPvsGe2oWvwIDAQABAoIBACCf19ewfpWETe98' 'wuOpIsQ8HyVjaCShvvh5tNUITcJhuFk5ajFdTqjc/O0VHxgmLm6O99e2vaiXCISH' 'EX4SWXq7lTMcYCf9YN47Y+HGoa8eFNTIS0ExJRPtojAY695O1UZmpUnfI1wux1mG' 'g8vZz0OCfXnBVAbsyjCX/IqOBp2MVzfMyMuaF/oQ2xiX4AZ1hDIMDpUTGw7OKX15' 'JAUlTZUhzifmijPg1gViD8Lf5w42nlwYPC5j6wWKpJSx76CNUxLdJAaaZb3QYE96' 'zu/jOCdy25sPHIux3XTdV6fqZ2iTvt31+bcnSAvmbDpmcujsZPVRXRu5OO/0xBh6' 'GGlTLAECgYEAwSyNkbNk0mBRxet68IW02wXYaxIEVUWqhSeE2MGaXg4h9VSgh83q' '7wly0ujy9Sj79aF2frkpMbIoeeGIOTIYI4RCYuBKx+/NNWFoggu4UK5xOMr0dfQK' '2Ggr2agUH3KExvOpAW3rvWzepLl8ppySLNipLcFQHOJ0kxwPd2ig3Z8CgYEAt+WM' 'JoW9dLxUu/zTih5Dacubl+fnnm8BsypKmv88mzcqEVwXOo6Z6bmlw0NeWxmlwHu7' 'vs+XQ8MDUDvQvIul8sFagZk7RvWcXTlaHtPQ1D8/ztrg5d58TwxpwXshBytfR6NA' 'tIZa+tNvzQF5AKVlB+lZEWF6E6FoI5NmGDAZ8uECgYB4FV4cCMzQCphK1Muj4TpA' 'PS3/wT94Usph4+Mta4yuk1KA047HXTaCSflbKvx9cnDOjQTAWhJFll6bBZxNEdr3' 'mSw7kvppt6R1Xow861Q0s3wmteOpv39Ob9Nyho2bzvDDTIzvGonFQ3xUIgpe+E3W' 'GwlwLA/FJPEa0gK7VAtMOQKBgQCgcPtX2LM0l+Ntp+V/yWuTb/quC7w+tCbNhAZX' 'OHxOB1ECmFAD3MpX6oq+05YM8VF1n/5rOX6Ftiy74ZP6C/Sa2Sr3ixL2k+76PsFr' 'x+2YYB5xgPFaXEQkS3YxQhXMxYB5ZetcFSRnVfVi7Pf/Ik4FGweEbIEvg1DySPV4' 'AO+CwQKBgQCFnjHsFeNZVvtiL2wONT6osjRCpMvaUiVecMW9oUBtjpLHI2gQr7+4' 'dvCm2Sj7uq9OWO0rBz1px/kI+ONjhwsFPLK5v8hyVDoIE791Qg3qAY1a6JOXRl9P' '6TBc3dQ2qUVqt8gi9RLCDFJU18Td6La4mkJSP5YrioGtwUJow0F07Q==' '-----END RSA PRIVATE KEY-----' == =/ cert=wain :~ '-----BEGIN CERTIFICATE-----' 'MIIF8jCCBNqgAwIBAgITAPrPc8Udwmv5dJ+hx2Uh+gZF1TANBgkqhkiG9w0BAQsF' 'ADAiMSAwHgYDVQQDDBdGYWtlIExFIEludGVybWVkaWF0ZSBYMTAeFw0xODA3MDMx' 'ODAyMTZaFw0xODEwMDExODAyMTZaMB8xHTAbBgNVBAMTFHpvZC5keW5kbnMudXJi' 'aXQub3JnMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAisQPzzmGWNZS' 'NNAwY59XrqK/bU0NKNZS2ETOiJeSpzPAHYl+c39V96/QUR0tra2zQI4QD6kpMYX/' '7R5nwuvsA4o7ypfYupNrlzLPThCKEHpZomDD0Bb3T8u7YGrMjEX5cOmZIU2T/iy4' 'GK/wWuBIy2TEp/0J+RoSCIr8Df/A7GIM8bwnv23Vq0kE2xBqqaT5LjvuQoXfiLJ4' '2F33DDno9lVikKEyt55D/08rH41KpXvn3tWZ46tZK6Ds7Zr1hEV1LbDx1CXDzQ6g' 'KObBe54DWDV3h7TJhr0BSW68dFJhro7Y60NszTcFqY1RC9F0ePtsnKGFzMOe/U+f' 'PvsGe2oWvwIDAQABo4IDIjCCAx4wDgYDVR0PAQH/BAQDAgWgMB0GA1UdJQQWMBQG' 'CCsGAQUFBwMBBggrBgEFBQcDAjAMBgNVHRMBAf8EAjAAMB0GA1UdDgQWBBTokXAU' 'vPwcrbkLxcVBCNNQ588pfjAfBgNVHSMEGDAWgBTAzANGuVggzFxycPPhLssgpvVo' 'OjB3BggrBgEFBQcBAQRrMGkwMgYIKwYBBQUHMAGGJmh0dHA6Ly9vY3NwLnN0Zy1p' 'bnQteDEubGV0c2VuY3J5cHQub3JnMDMGCCsGAQUFBzAChidodHRwOi8vY2VydC5z' 'dGctaW50LXgxLmxldHNlbmNyeXB0Lm9yZy8wHwYDVR0RBBgwFoIUem9kLmR5bmRu' 'cy51cmJpdC5vcmcwgf4GA1UdIASB9jCB8zAIBgZngQwBAgEwgeYGCysGAQQBgt8T' 'AQEBMIHWMCYGCCsGAQUFBwIBFhpodHRwOi8vY3BzLmxldHNlbmNyeXB0Lm9yZzCB' 'qwYIKwYBBQUHAgIwgZ4MgZtUaGlzIENlcnRpZmljYXRlIG1heSBvbmx5IGJlIHJl' 'bGllZCB1cG9uIGJ5IFJlbHlpbmcgUGFydGllcyBhbmQgb25seSBpbiBhY2NvcmRh' 'bmNlIHdpdGggdGhlIENlcnRpZmljYXRlIFBvbGljeSBmb3VuZCBhdCBodHRwczov' 'L2xldHNlbmNyeXB0Lm9yZy9yZXBvc2l0b3J5LzCCAQIGCisGAQQB1nkCBAIEgfME' 'gfAA7gB1ALDMg+Wl+X1rr3wJzChJBIcqx+iLEyxjULfG/SbhbGx3AAABZGGGG6QA' 'AAQDAEYwRAIgJHrIawVea5/++wteocdbt1QUBxysW7uJqYgvnOWOQMgCIGRlioyE' 'vzunUm/HZre3fF2jBsJr45C1tz5FTe/cYQwmAHUA3Zk0/KXnJIDJVmh9gTSZCEmy' 'Sfe1adjHvKs/XMHzbmQAAAFkYYYjLQAABAMARjBEAiAWovIKERYeNbJlAKvNorwn' 'RnSFP0lJ9sguwcpbcsYJ1gIgRJxTolkMOr0Fwq62q4UYnpREY8zu4hiL90Mhntky' 'EwYwDQYJKoZIhvcNAQELBQADggEBAMYxvA+p4Qj0U23AHAe61W3+M6T1M0BfrGE2' 'jJCaq4c3d7b9NEN1qFJHl8t/+Z/7RHUIzbm4CIOZynSM8mBxg2NgXymvXQkRrrBo' 'fhO9u8Yxizx4+KOtiigt9JBVlpyCm6I9uifM+7rZYh45s2IkfDBPKd+M1tfIUOne' 'YgUt1YguEkM2xqRG16JyHA0Xwn6mn+4pWiTdfNzlqol6vyGT7WfIvmV7cdGoYKjB' 'wOt/g1wWMTwhSWBCVqCyn+f2rl8u3wbXrIUeRng2ryNVXO03nukTp7OLN3HUO6PR' 'hC4NdS4o2geBNZr8RJiORtCelDaJprY7lhh2MFzVpsodc2eB5sQ=' '-----END CERTIFICATE-----' '' '-----BEGIN CERTIFICATE-----' 'MIIEqzCCApOgAwIBAgIRAIvhKg5ZRO08VGQx8JdhT+UwDQYJKoZIhvcNAQELBQAw' 'GjEYMBYGA1UEAwwPRmFrZSBMRSBSb290IFgxMB4XDTE2MDUyMzIyMDc1OVoXDTM2' 'MDUyMzIyMDc1OVowIjEgMB4GA1UEAwwXRmFrZSBMRSBJbnRlcm1lZGlhdGUgWDEw' 'ggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDtWKySDn7rWZc5ggjz3ZB0' '8jO4xti3uzINfD5sQ7Lj7hzetUT+wQob+iXSZkhnvx+IvdbXF5/yt8aWPpUKnPym' 'oLxsYiI5gQBLxNDzIec0OIaflWqAr29m7J8+NNtApEN8nZFnf3bhehZW7AxmS1m0' 'ZnSsdHw0Fw+bgixPg2MQ9k9oefFeqa+7Kqdlz5bbrUYV2volxhDFtnI4Mh8BiWCN' 'xDH1Hizq+GKCcHsinDZWurCqder/afJBnQs+SBSL6MVApHt+d35zjBD92fO2Je56' 'dhMfzCgOKXeJ340WhW3TjD1zqLZXeaCyUNRnfOmWZV8nEhtHOFbUCU7r/KkjMZO9' 'AgMBAAGjgeMwgeAwDgYDVR0PAQH/BAQDAgGGMBIGA1UdEwEB/wQIMAYBAf8CAQAw' 'HQYDVR0OBBYEFMDMA0a5WCDMXHJw8+EuyyCm9Wg6MHoGCCsGAQUFBwEBBG4wbDA0' 'BggrBgEFBQcwAYYoaHR0cDovL29jc3Auc3RnLXJvb3QteDEubGV0c2VuY3J5cHQu' 'b3JnLzA0BggrBgEFBQcwAoYoaHR0cDovL2NlcnQuc3RnLXJvb3QteDEubGV0c2Vu' 'Y3J5cHQub3JnLzAfBgNVHSMEGDAWgBTBJnSkikSg5vogKNhcI5pFiBh54DANBgkq' 'hkiG9w0BAQsFAAOCAgEABYSu4Il+fI0MYU42OTmEj+1HqQ5DvyAeyCA6sGuZdwjF' 'UGeVOv3NnLyfofuUOjEbY5irFCDtnv+0ckukUZN9lz4Q2YjWGUpW4TTu3ieTsaC9' 'AFvCSgNHJyWSVtWvB5XDxsqawl1KzHzzwr132bF2rtGtazSqVqK9E07sGHMCf+zp' 'DQVDVVGtqZPHwX3KqUtefE621b8RI6VCl4oD30Olf8pjuzG4JKBFRFclzLRjo/h7' 'IkkfjZ8wDa7faOjVXx6n+eUQ29cIMCzr8/rNWHS9pYGGQKJiY2xmVC9h12H99Xyf' 'zWE9vb5zKP3MVG6neX1hSdo7PEAb9fqRhHkqVsqUvJlIRmvXvVKTwNCP3eCjRCCI' 'PTAvjV+4ni786iXwwFYNz8l3PmPLCyQXWGohnJ8iBm+5nk7O2ynaPVW0U2W+pt2w' 'SVuvdDM5zGv2f9ltNWUiYZHJ1mmO97jSY/6YfdOUH66iRtQtDkHBRdkNBsMbD+Em' '2TgBldtHNSJBfB3pm9FblgOcJ0FSWcUDWJ7vO0+NTXlgrRofRT6pVywzxVo6dND0' 'WzYlTWeUVsO40xJqhgUQRER9YLOLxJ0O6C8i0xFxAMKOtSdodMB3RIwt7RFQ0uyt' 'n5Z5MqkYhlMI3J1tPRTp1nEt9fyGspBOO05gi148Qasp+3N+svqKomoQglNoAxU=' '-----END CERTIFICATE-----' == =/ k=key:rsa (need (ring:de:pem:pkcs1 key)) =/ k8=wain (ring:en:pem:pkcs8 k) (emit %rule /install %cert `[k8 cert]) :: +poke-path: for debugging :: ++ poke-path |=(a=path abet:(add-order (sy a ~))) :: +prep: initialize and adapt state :: :: ++ prep _[~ this] ++ prep |= old=(unit acme) ^- (quip move _this) ?~ old [~ this] [~ this(+<+ u.old)] :: +rekey: create new 2.048 bit RSA key :: :: XX do something about this iteration :: ++ rekey |= eny=@ =| i=@ |- ^- key:rsa =/ k (new-key:rsa 2.048 eny) =/ m (met 0 n.pub.k) :: ?: =(0 (mod m 8)) k ?: =(2.048 m) k ~& [%key iter=i width=m] $(i +(i), eny +(eny)) :: +init: initialize :acme state :: :: We defer the initial request for independence from the causal event, :: which is necessary to init on the boot event. Which we no longer do, :: but we're preserving the pattern for future flexibility. :: ++ init =< (retry:effect /directory `@dr`1) %= this act [(rekey eny.bow) ~] cey (rekey (mix eny.bow (shaz now.bow))) == :: +queue-next-order: enqueue domains for validation :: ++ queue-next-order |= [valid=? dom=(set turf)] ^+ this %= this next-order :- ~ %+ roll ~(tap in dom) |= [=turf state=(map turf [idx=@ud valid=? try=@ud])] (~(put by state) turf [~(wyt by state) valid try=0]) == :: +cancel-current-order: and archive failure for future autopsy :: :: XX we may have pending moves out for this order :: put dates in wires, check against order creation date? :: or re-use order-id? :: ++ cancel-current-order ^+ this ?~ rod this %= this rod ~ fal.hit [u.rod fal.hit] == :: +add-order: add new certificate order :: ++ add-order |= dom=(set turf) ^+ this ?: =(~ dom) ~|(%acme-empty-certificate-order !!) ?: ?=(?(%earl %pawn) (clan:title our.bow)) this =. ..this (queue-next-order | dom) =. ..this cancel-current-order =/ msg=tape =- "requesting an https certificate for {(trip -)}" (join ', ' (turn ~(tap in dom) |=(a=turf (join '.' a)))) %. [%flog / %text msg] =< emit :: if registered, create order :: ?^ reg.act (validate-domain:effect 0) :: if initialized, defer :: ?.(=(act *acct) this init) --