urbit/ape/cloud.hoon
2015-12-17 17:16:57 -08:00

689 lines
19 KiB
Plaintext

:: 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)
image/(ot name/so ~)
==
=. 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 +>.$])
--