:: digital ocean fleet management :: :::: :: /? 314 /- talk :: :: :::: sivtyv-barnel :: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: data structures :: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: !: [talk .] |% ++ instance $: plat+?($do $gce) name+@t id+@t status+@t created+@da snapshot+name+@t == ++ image $: plat+?($do $gce) name+@t id+@t == ++ create-req-do $: name+@t size+@t image+@t ssh+(list cord) backups+(unit ?) ipv6+(unit ?) private-networking+(unit ?) user-data+(unit @t) == ++ create-req-gce {project+@t zone+@t name+@t machine-type+@t} ++ axle $: auth+{do+keys gce+keys} toke+{do+tokens gce+tokens} insts+(map @t instance) images+(map {{@t @t} image}) == ++ keys {authc+(unit @t) client-secret+(unit @t)} ++ tokens {access+@t refresh+@t} ++ move {bone card} ++ card $% {$diff $json json} {$wait wire @da} {$send wire {ship term} $poke $talk-command command} {$them wire (unit hiss)} == ++ droplet-action $% {$start $~} {$stop $~} {$reboot $~} {$delete $~} {$snapshot p+@t} == ++ cloud-command $% {$action id+@t name+@t act+droplet-action} {$create-do p+json} {$create-gce p+json} == -- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: miscellaneous functions :: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: !: |% ++ auth-queries |= code+cord :~ 'grant_type'^'authorization_code' 'code'^code :- 'client_id' 'd8f46b95af38c1ab3d78ad34c2157a6959c23eb0eb5d8e393f650f08e6a75c6f' 'redirect_uri'^'http://localhost:8443/home/pub/cloud/fab' == :: ++ parse-iso8601 =< (cook to-time (parsf ;"{parse-day}T{parse-seconds}{parse-zone}")) |% ++ to-time |= {{y+@u m+@u d+@u} t+{h+@u m+@u s+@u ms+@u} {syn+? zh+@u zm+@u}} ^- @da %- year ^- date =: h.t ?:(syn (sub h.t zh) (add h.t zh)) m.t ?:(syn (sub m.t zm) (add m.t zm)) == [[& y] m d h.t m.t s.t (div (mul ms.t 0x1.0000) 1.000) ~] ++ parse-day (parsf ;"{dem}\-{dem}\-{dem}") ++ parse-seconds (parsf ;"{dem}:{dem}:{dem}{(optional ;~(pfix dot dem))}") ++ optional |*(fel+rule ;~(pose fel (easy 0))) ++ parse-zone ;~ pose (cold [& 0 0] (jest 'Z')) (parsf ;"{parse-zone-sign}{dem}:{dem}") == ++ parse-zone-sign ;~(plug ;~(pose (cold & lus) (cold | hep))) -- ++ parse-cloud-command =+ jo %- of :~ [%create-gce some] [%create-do some] ::[%create-gce some] :- %action (ot id/so name/so act/parse-droplet-action ~) == ++ parse-droplet-action => jo %- of :~ [%start ul] [%stop ul] [%reboot ul] [%delete ul] [%snapshot so] == ++ key-do (mo [%start 'power_on'] [%stop 'shutdown'] [%reboot 'power_cycle'] ~) :: ++ adapter-do |= a+cord (~(got by key-do) a) :: ++ parse-ip-do => jo %- ot :_ ~ v4/(ar (ot 'ip_address'^(su lip:ag) ~)) :: ++ parse-ip-gce => jo %+ cu |=(a+(list (list @if)) `(list @if)`(zing a)) (ar (ot 'accessConfigs'^(ar (ot 'natIP'^(su lip:ag) ~)) ~)) :: ++ tail-url |= a+cord -:(flop q.q:(need (epur a))) :: ++ parse-region => jo (ot name/so ~) :: ++ parse-id-text |= jon=json ?.(?=({?($n $s) *} jon) ~ (some p.jon)) :: ++ create-do-body |= $: name+@t size+@t image+@t ssh-keys+(list cord) backups+(unit ?) ipv6+(unit ?) private-networking+(unit ?) user-data+(unit @t) == %- jobe :~ name/s/name size/s/size image/s/image backups/?~(backups ~ b/u.backups) ipv6/?~(ipv6 ~ b/u.ipv6) 'user_data'^?~(user-data ~ s/u.user-data) 'private_networking'^?~(private-networking ~ b/u.private-networking) == :: ++ convert-do |= a+?($start $stop $reboot $snapshot) ?- a $start 'power_on' $stop 'shutdown' $reboot 'power_cycle' $snapshot 'snapshot' == :: ++ instance-to-json |= a+(list instance) ^- json %+ joba 'instances' :- %a %+ turn a |= instance ^- json %- jobe :~ name/`json`s/name id/s/id status/s/status created/s/(crip (dust (yore created))) snapshot/s/snapshot == ++ map-to-list |= a+(map {{@t @t} image}) ^- liz=(list image) %+ turn (~(tap by a) *(list {{@t @t} image})) |=(a+{{@t @t} image} `image`+.a) :: ++ image-to-json |= a+(list image) %+ joba 'images' :- %a %+ turn a |= image ^- json %- jobe :~ name/s/name id/s/id == -- :::::::::::::::: :: main door :: :::::::::::::::: !: |_ {bowl vat+axle} :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: miscellaneous arms that have to be in main door for scope reasons :: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: ++ thou |= {pour-path+path resp+?(httr *)} ^- {(list move) _+>.$} ~& unhandled-pour-path/resp :_ +>.$ ~ :: ++ httpreq |= $: pour-path+wire :: must be in main door because of scope domain+(list cord) end-point+path req-type+$?($get $delt {$post json}) headers+math queries+quay == ^- move =+ ^- parsed-url+purl :+ ^= host-port :: ++hart :+ security=%.y port=~ host=[%.y [path=[%com domain]]] endpoint=[extensions=~ point=end-point] :: ++pork, q-strings=queries :: ++quay =+ ^- request+hiss :: cast to hiss :- parsed-url ?@ req-type [req-type headers ~] [%post headers ~ (tact (pojo +.req-type))] :^ ost %them pour-path `(unit hiss)`[~ request] :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: manage supscriptions and publish to talk :: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ++ peer |= pax+path ^- {(list move) _+>.$} :_ +>.$ =+ lis=(~(tap by insts.vat)) [ost %diff %json (instance-to-json (turn lis |=(a=[@t instance] +.a)))]~ :: ++ spam |= jon+json %+ turn (~(tap by sup)) |= {sub+bone @ pax+path} ^- move [sub %diff %json jon] :: ++ publish |= {act+(list speech)} ^- move =+ ^= spchz %+ turn act |= sp+speech =+ ^= tail :- ^- audience :+ :- `partner`[%& our ?+((clan our) !! %czar %court, %duke %porch)] ^- (pair envelope delivery) [`envelope`[& ~] %pending] ~ ~ `statement`[now ~ sp] ^- thought :- `@`(sham eny tail) tail =+ mez=[%talk-command [%publish `(list thought)`spchz]] [ost %send /pub [our %talk] %poke mez] ++ thou-pub |=(~ :_(+>.$ ~)) :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: authentication :: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ++ poke-cloud-auth |= {cde+cord typ+cord} ^- {(list move) _+>.$} ?: =(%do typ) =. authc.do.auth.vat [~ cde] :_ +>.$ ~ =. access.gce.toke.vat cde :_ +>.$ :_ list-gce (publish [%lin & 'successfully authenticated to gce']~) :: ++ poke-cloud-secret |= {secret+cord typ+cord} ^- {(list move) _+>.$} ?+ typ ~|(missing-platform=typ !!) %do =. client-secret.do.auth.vat [~ secret] :_ +>.$ :_ ~ %+ httpreq /do/auth :^ ~[%digitalocean %cloud] `path`/v1/oauth/token [%post ~] :- ~ `quay`['client_secret'^secret (auth-queries (need authc.do.auth.vat))] == :: ++ thou-do-auth |= {$~ resp+httr} ^- {(list move) _+>.$} ~| resp =+ body=(rash q:(need r.resp) apex:poja) ~| receive-auth/resp(r body) =+ [ac re]=(need ((ot 'access_token'^so 'refresh_token'^so ~):jo body)) =: access.do.toke.vat ac refresh.do.toke.vat re == :_ +>.$ :- (publish [%lin & 'successfully authenticated']~) list-do :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: create digital ocean droplets :: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ++ create-do |= act+json =+ ^- deets=create-req-do %- need %. act => jo %- ot :~ name/so size/so image/so ssh/(ar so) backups/(mu bo) 'ipv6'^(mu bo) 'priv_networking'^(mu bo) 'user_data'^(mu so) == =+ ^- body=json %- create-do-body :* name.deets size.deets image.deets ssh.deets backups.deets ipv6.deets private-networking.deets user-data.deets == %- httpreq :* /create-do ~[%digitalocean %api] /v2/droplets [%post body] %^ mo ['Content-Type' 'application/json; charset=utf-8' ~] ['Authorization' (cat 3 'Bearer ' access.do.toke.vat) ~] ~ ~ == :: ++ thou-create-do |=([path resp=httr] ~&(resp :_(+>.$ ~))) :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: create google instances :: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ++ reserve-ip |= name+json =+ nam=(need ((ot name/so ~):jo name)) %- httpreq :* /reserve-ip/[nam] ~['googleapis' 'www'] /compute/v1/projects/urbcloud/regions/us-central1/addresses [%post (joba name/s/nam)] %^ mo ['Content-Type' 'application/json' ~] ['Authorization' (cat 3 'Bearer ' access.gce.toke.vat) ~] ~ *quay == :: ++ thou-reserve-ip |= {pax+path resp+httr} ~& resp ~| r.resp =+ parsed=(rash q:(need r.resp) apex:poja) =+ ur=(need ((ot 'targetLink'^so ~):jo parsed)) ~& initial-response/parsed =+ name=-:(flop q.q:(need (epur ur))) =+ buf=`@da`(add ~s10 now) :_(+>.$ [ost %wait `path`/check-ip-status/[name] buf]~) :: ++ wake-check-ip-status |= {name+path $~} ~& this-is-the-name/name =+ nam=?~(name !! -.name) :_ +>.$ :_ ~ %- httpreq :* `path`/check-ip-status/[nam] ~['googleapis' 'www'] `path`/compute/v1/projects/urbcloud/regions/us-central1/addresses/[nam] %get %^ mo ['Content-Type' 'application/json' ~] ['Authorization' (cat 3 'Bearer ' access.gce.toke.vat) ~] ~ *quay == ++ thou-check-ip-status |= {name+path resp+httr} ~& api-resp/resp =+ parsed=(rash q:(need r.resp) apex:poja) !! ::?. =('RESERVED' (need ((ot status/so ~):jo parsed))) :: ++ create-gce |= jon+json ++ ^- {name+@t image+@t number+@ud} (need ((ot name/so 'instance_img'^so number/ni ~):jo jon)) |- ^- (list move) ?~ number ~ :_ $(number (dec number)) =+ nam=(cat 3 name (scot %ud number)) =+ ^- body=json %- jobe :~ name/s/nam 'machineType'^s/'zones/us-central1-a/machineTypes/n1-standard-1' :- %disks :- %a :_ ~ %- jobe :+ 'initializeParams'^`json`(joba 'sourceImage'^s/image) boot/b/%.y ~ :- 'networkInterfaces' :- %a :_ ~ (joba 'network' `json`[%s 'global/networks/default']) == ^- move %- httpreq :* `path`/create-gce `(list cord)`~['googleapis' 'www'] `path`/compute/v1/projects/urbcloud/zones/us-central1-a/'instances' [%post `json`body] %^ mo ['Content-Type' 'application/json' ~] ['Authorization' (cat 3 'Bearer ' access.gce.toke.vat) ~] ~ `quay`[%key access.gce.toke.vat]~ == :: ++ thou-create-gce |=({path resp+httr} ~&(resp :_(+>.$ ~))) :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: perform actions on instances (both kinds) :: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ++ poke-json :: receive action from client |= jon+json ^- {(list move) _+>.$} =+ action=`cloud-command`(need (parse-cloud-command jon)) :_ +>.$ ?- -.action $create-gce [(reserve-ip p.action)]~ $create-do [(create-do p.action)]~ ::$create-gce [(create-gce p.action)] $action [(instance-action [id name act]:action)]~ == ++ instance-action |= {id+@t name+@t action+droplet-action} =+ d=(~(got by insts.vat) id) ~| 'can\'t find id' =+ typ=?~(d !! -.d) ?- typ $do =+ ^= meth ?: ?=(%delete -.action) %delt :- %post %+ jobe type/s/(convert-do -.action) ?.(?=($snapshot -.action) ~ [name/s/p.action ~]) ^- move =+ ^= req %- httpreq :* /do/[-.action] ~[%digitalocean %api] ?:(?=(%delt meth) /v2/droplets/[id] /v2/droplets/[id]/actions) meth %^ mo ['Content-Type' 'application/json' ~] ['Authorization' (cat 3 'Bearer ' access.do.toke.vat) ~] ~ *quay == req :: $gce =+ ^= head-query :- %^ mo ['Content-Type' 'application/json' ~] ['Authorization' (cat 3 'Bearer ' access.gce.toke.vat) ~] ~ *quay ?- -.action ?($start $stop $reboot $'snapshot') =+ end=/compute/v1/projects/urbcloud/zones/us-central1-a/instances/[name] %- httpreq :* /gce-act/[-.action] ~['googleapis' 'www'] (welp end [?:(?=(%reboot -.action) 'reset' -.action) ~]) [%post ~] head-query == :: $delete =+ end=/compute/v1/projects/urbcloud/zones/us-central1-a/instances/[name] %- httpreq :* /gce-act/[-.action] ~['googleapis' 'www'] end %delt head-query == == == ++ thou-do-act |= {pax+path resp+httr} ~& [resp act/pax] :_ +>.$ ~ :: ++ thou-gce-act |= {pax+path resp+httr} ~& [resp act/pax] :_ +>.$ ~ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: retrieve google instances and images :: ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ++ list-gce ^- (list move) :+ (list-something-gce /zones/['us-central1-a']/instances) (list-something-gce /global/snapshots) ~ :: ++ list-something-gce |= endpoint+path =+ ^= lis :* /list-gce/[-.endpoint] ~[%googleapis %www] (welp /compute/v1/projects/urbcloud endpoint) %get ~ ^- quay [%'access_token' access.gce.toke.vat]~ == ~! lis ~! +<:httpreq (httpreq lis) :: ++ thou-list-gce-zones :: instances |= {pax+path resp+httr} ^- [(list move) _+>.$] =+ parsed=(rash q:(need r.resp) apex:poja) :: body httr to json ~| 'no list received or bad json' =+ items=(need ((ot items/(ar some) ~):jo parsed)) =+ ^- ins+(list {@t instance}) ~| 'bad-json'^items %+ turn items |= in+json =< [id .] ^- instance :- %gce %- need %. in =+ jo %- ot :~ name/so id/so status/so 'creationTimestamp'^(su parse-iso8601) ::zone/so 'machineType'^(cu tail-url so) :: 'networkInterfaces'^parse-ip-gce == =. insts.vat %- mo %+ weld ins %+ skip (~(tap by insts.vat)) :: keep non-gce |= a+{@t instance} ?=($gce +<.a) =+ buf=`@da`(add ~s10 now) =+ liz=(~(tap by insts.vat)) =+ tail=(turn liz |=(a+{@t instance} +.a)) :_ +>.$ :: :- [ost %wait /refresh-gce buf] (spam (instance-to-json tail)) :: ++ thou-list-gce-global :: imgs |= {pax+path resp+httr} ^- [(list move) _+>.$] =+ parsed=(rash q:(need r.resp) apex:poja) =+ imgz=(need ((ot items/(ar some) ~):jo parsed)) =. images.vat %- mo %+ weld %+ skip (~(tap by images.vat) *(list ,[[@t @t] image])) |=(a+{{@t @t} image} ?=($gce ->.a)) %+ turn imgz |= a+json =< [[name %gce] .] ^- image :- %gce %- need %. a =+ jo %- ot [name/so id/so ~] :_ +>.$ [(spam `json`(image-to-json `(list image)`(map-to-list images.vat)))] :: ++ wake-refresh-gce |=([path ~] [list-gce +>.$]) ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: list digital ocean droplets and images :: ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ++ list-do :+((list-something-do %droplets) (list-something-do %images) ~) ++ list-something-do |= som+@tas =+ ^= lis :~ /list-do/[som] ~[%digitalocean %api] /v2/[som] %get (mo ['Content-Type' 'application/json' ~] ['Authorization' (cat 3 'Bearer ' access.do.toke.vat) ~] ~) == (httpreq lis) :: ++ thou-list-do-droplets |= {pax+path resp+httr} ^- [(list move) _+>.$] =+ parsed=(rash q:(need r.resp) apex:poja) :: parse httr to json ~| receive-list/parsed =+ dar=(need ((ot droplets/(ar some) ~):jo parsed)) :: reparse ar of insts =+ ^- dropz+(list {@t instance}) ~| bad-json/-.dar %+ turn dar |= drp+json ^- {@t instance} =- ~! - - =< [id .] ^- instance :- %do %- need %. drp =+ jo %- ot :~ name/so id/parse-id-text status/so 'created_at'^(su parse-iso8601) ::region/parse-region image/(ot name/so ~) ::disk/ni networks/parse-ip-do == =. insts.vat %- mo %+ weld dropz %+ skip (~(tap by insts.vat) *(list ,[@t instance])) |=(a+{@t instance} ?=($do +>.$)) =+ buf=`@da`(add ~s10 now) :_ +>.$ :- [ost %wait /refresh-do buf] %- spam %- instance-to-json %+ turn (~(tap by insts.vat) *(list ,[@t instance])) |=(a=[@t instance] +.a) :: ++ thou-list-do-images |= {pax+path resp+httr} =+ parsed=(rash q:(need r.resp) apex:poja) ~| crashed-do-images/parsed =+ imgz=(need ((ot images/(ar (ot [name/so distribution/so id/no ~])) ~):jo parsed)) =+ ^- images+(list {{@t @t} image}) %+ turn imgz |= {name+@t dist+@t id+@t} =+ nom=(cat 3 name dist) [[%do nom] `image`[%do nom id]] =. images.vat %- mo %+ weld images %+ skip (~(tap by images.vat) *(list ,[[@t @t] image])) |=(a+{{@t @t} image} ?=($do ->.a)) :_ +>.$ ~[(spam `json`(image-to-json `(list image)`(map-to-list images.vat)))] :: ++ wake-refresh-do |=({path $~} [list-do +>.$]) --