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
08c5fb4719
shrub/base/ape/cloud/core.hook
Henry Ault 7f16f641bd weird talk bug
2015-06-02 18:36:23 -07:00

527 lines
14 KiB
Plaintext
Raw Blame History

:: digital ocean fleet management
::
::::
::
/? 314
/- *talk
/+ talk, sole, http
::
::
:::: sivtyv-barnel
::
!:
|%
++ instance
$: plat=?(%do %gce) name=@t id=@t status=@t created=@da snapshot=name=@t ::disk=@u region=@t
ip=(list ,@if)
==
++ 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)
==
++ 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)]
==
--
!:
|% :::
++ 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)))
--
++ 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)
?- a
%start
'power_on'
%stop
'shutdown'
%reboot
'power_cycle'
==
++ state-to-json
|= a=(list instance)
:- %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))))
==
--
!:
|_ [bowl vat=axle]
::
::++ prep ,_`.
::
++ peer
|= pax=path
^- [(list move) _+>.$]
:_ +>.$
=+ lis=(~(tap by insts.vat))
[ost %diff %json (state-to-json (turn lis |=(a=[@t instance] +.a)))]~
::
++ spam
|= jon=json
%+ turn (~(tap by sup))
|= [sub=bone @ pax=path]
^- move
[sub %diff %json jon]
++ httpreq
|= $: pour-path=wire
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]
::
++ auth-queries
|= code=cord
:~ 'grant_type'^'authorization_code'
'code'^code
:- 'client_id'
'd8f46b95af38c1ab3d78ad34c2157a6959c23eb0eb5d8e393f650f08e6a75c6f'
'redirect_uri'^'http://localhost:8443/home/pub/cloud/fab'
==
::
++ poke-cloud-auth
|= [cde=cord typ=cord]
^- [(list move) _+>.$]
?: =(%do typ)
=. authc.do.auth.vat
[~ cde]
:_ +>.$ ~
=. access.gce.toke.vat
cde
:_ +>.$
:- list-instances-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 /auth-do
:^ ~[%digitalocean %cloud] `path`/v1/oauth/token
[%post ~]
:- ~ `quay`['client_secret'^secret (auth-queries (need authc.do.auth.vat))]
==
::
++ receive-auth
|= [pour-path=cord resp=httr]
^- [(list move) _+>.$]
~| resp
=+ body=(rash q:(need r.resp) apex:poja)
~| recieve-auth/resp(r body)
?+ pour-path !!
%auth-do
=+ [ac re]=(need ((ot 'access_token'^so 'refresh_token'^so ~):jo body))
=: access.do.toke.vat ac
refresh.do.toke.vat re
==
:_ +>.$
:~ list-instances-do
(publish [%lin & 'successfully authenticated']~)
==
==
::
++ poke-json
|= act=json
^- [(list move) _+>.$]
=+ do=(need ((ot action/so ~):jo act))
:_ +>.$
:_ ~
?+ do !!
%list
list-instances-do
::
%create-do
(create-do act)
::
%create-gce
(create-gce-disk act)
::
?(%start %stop %reboot %delete)
=+ id=(need ((ot id/so ~):jo act))
(instance-action id do)
==
::
++ instance-action
|= $: id=@t
$= action $?
%start %stop %reboot %delete
== ==
=+ 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) ~)])
^- move
~& 'do i get here?'
=+ ^= req
%- httpreq :*
/action-test
~[%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
?- action
%start
!!
%stop
!!
%reboot
!!
%delete
!!
==
==
::
++ 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) ~]
~
~
==
::
++ create-gce-disk
|= act=json :: num=(unit ,@u)
=+ :- name=(need ((ot name/so ~):jo act))
snapshot=(need ((ot 'instance_image'^so ~):jo act))
=+ :- name=(need ((ot name/so ~):jo act))
snap=(need ((ot snap/so ~):jo act))
=+ ^- body=json
(jobe name/s/name %'sourceSnapshot'^s/'compute/v1/projects/urbcloud/global/snapshots/snapshot-1' ~) ::^so/snap ~)
%- httpreq
:* /create-gce-disk/snapshot/name
~['googleapis' 'www'] /compute/v1/projects/urbcloud/zones/us-central1-b/disks
[%post body]
%^ mo ['Content-Type' 'application/json' ~]
['Authorization' (cat 3 'Bearer ' access.gce.toke.vat) ~]
~
~
==
::
++ ask-disk-status
|= pax=path ^- move
~& 'ask disk status'
=+ :- safe=(slav %uv ?~(pax !! -.pax))
snap=?.(?=([* ^] pax) !! i.t.pax)
=+ link=(need (epur ?~(pax !! safe)))
=. r.link ['access_token'^access.gce.toke.vat r.link]
:^ ost %them `wire`/disk-status/snap
`(unit hiss)`[~ [link [%get ~ ~]]]
::
++ disk-status ::receive
|= [ins-img=@t resp=httr]
^- [(list move) _+>.$]
~& 'disk status called'
=+ hcode=p.resp
?: =('200' hcode)
~| 'did not receive 200' !!
=+ :-(parsed=(rash q:(need r.resp) apex:poja) jo)
~& parsed
=+ :- status=(need ((ot status/so ~) parsed))
lin=(need ((ot 'selfLink'^so ~) parsed))
=+ link=(scot %uv lin)
?: =('DONE' status)
~& resp
~& 'boot disk now running, now starting instance'
=+ target=(need ((ot 'targetLink'^so ~):jo parsed))
=+ nam=-:(flop q.q:(need (epur target)))
~& nam
:_ +>.$ ~[(create-gce nam ins-img)]
:_ +>.$
[ost %wait `path`[%check-status link ins-img ~] `@da`(add ~s3 now)]~ :: refesh every 10 sec
::
++ create-gce
|= [name=@t snap=@t]
~& create-gce-received/snap
=+ src=(cat 3 'compute/v1/projects/urbcloud/zones/us-central1-b/disks/' name)
=+ ^- body=json
%- jobe
:~ name/s/name 'machineType'^s/'zones/us-central1-b/machineTypes/n1-standard-1'
:- %disks :- %a :_ ~
(jobe boot/b/%.y type/s/'persistent' source/s/src ~)
:- 'networkInterfaces' :- %a :_ ~
(joba 'network' `json`[%s 'global/networks/default'])
==
%- httpreq
:* `path`/create-gce
`(list cord)`~['googleapis' 'www'] `path`/compute/v1/projects/urbcloud/zones/us-central1-b/'instances'
[%post `json`body]
%^ mo ['Content-Type' 'application/json' ~]
['Authorization' (cat 3 'Bearer ' access.gce.toke.vat) ~]
~
`quay`[%key access.gce.toke.vat]~
==
::
++ wake
|= [pour-path=path ~]
?+ -.pour-path !!
%refresh-do
:_ +>.$
[list-instances-do]~
%refresh-gce
:_ +>.$
[list-instances-gce]~
%check-status
:_ +>.$
[(ask-disk-status +.pour-path)]~
==
::
++ list-instances-gce
=+ ^= lis
:*
/list-gce
~[%googleapis %www] /compute/v1/projects/urbcloud/zones/['us-central1-a']/'instances'
%get ~
^- quay
[%'access_token' access.gce.toke.vat]~
==
(httpreq lis)
::
++ receive-list-gce
|= resp=httr
^- [(list move) _+>.$]
=+ parsed=(rash q:(need r.resp) apex:poja) :: body httr to 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
==
=+ ^= new
%+ skip ins
|=(a=[@t instance] (~(has by insts.vat) id.a))
=. insts.vat
(~(gas by insts.vat) new)
=+ buf=`@da`(add ~s10 now)
:_ +>.$
=+ lis=(~(tap by insts.vat))
:_ (spam (state-to-json (turn lis |=(a=[@t instance] +.a))))
[ost %wait /refresh-gce buf]
::
++ list-instances-do
=+ ^= lis
:~ /list-do
~[%digitalocean %api] /v2/droplets
%get
(mo ['Content-Type' 'application/json' ~] ['Authorization' (cat 3 'Bearer ' access.do.toke.vat) ~] ~)
==
(httpreq lis)
::
++ receive-list-do
|= 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
=. insts.vat
%- ~(gas by insts.vat)
^- 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
==
=+ buf=`@da`(add ~s10 now)
:_ +>.$
=+ lis=(~(tap by insts.vat) *(list ,[@t instance]))
:_ (spam (state-to-json (turn lis |=(a=[@t instance] +.a))))
[ost %wait /refresh-do buf]
++ thou
|= [pour-path=path resp=httr]
^- [(list move) _+>.$]
?+ -.pour-path ~& pour-path !!
%auth-do
(receive-auth -.pour-path resp)
::
%auth-gce
(receive-auth -.pour-path resp)
::
%list-do
(receive-list-do resp)
%list-gce
(receive-list-gce resp)
::
$?
%delete %reboot %'power_cycle' %shutdown %'power_off'
%'power_on' %'password_reset' %'enable_ipv6' %'enable_private_networking'
%snapshot %upgrade :: add retrieve droplet action
%create-do %create-gce %action-test
==
~& resp
:_ +>.$ ~
::
?(%create-gce-disk %disk-status)
=+ snap=?~(t.pour-path !! i.t.pour-path)
~& snap/snap
(disk-status snap resp)
::
%check-status
:_ +>.$ ~[(ask-disk-status +.pour-path)]
::
%pub
:_ +>.$ ~
::
==
++ 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]
--
Reference in New Issue View Git Blame Copy Permalink