urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-15 12:43:31 +03:00
Code Issues Packages Projects Releases Wiki Activity
f6414086ef
shrub/ape/cloud.hoon
Anton Dyudin 8ee93321de qualified library names in userspace
2015-09-03 17:14:34 -04:00

650 lines
19 KiB
Plaintext
Raw Blame History

:: 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 ::disk=@u region=@t
::ip=(list ,@if)
==
++ image
$: plat=?(%do %gce) name=@t id=@t
==
++ create-req-do
$:
name=@t ::region=@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 ::region=@t
size=@t image=@t ssh-keys=(list cord)
backups=(unit ,?) ipv6=(unit ,?) private-networking=(unit ,?) user-data=(unit ,@t)
==
%- jobe
:~ name/s/name ::region/s/region
size/s/size image/s/image ::(jone 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)))
::region/s/region
snapshot/s/snapshot
::disk/`json`(jone disk)
::ip/a/(turn ip |=(a=@if s/(rsh 3 1 (scot %if a))))
==
++ 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 ::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
::
::++ prep ,_`.
::
++ 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)
~| recieve-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 :: id key:img object region/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 ::region.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
~| recieve-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 +>.$])
--
Reference in New Issue View Git Blame Copy Permalink