shrub/base/ape/cloud/core.hook

::  digital ocean fleet management
::
::::
  ::
/?  314
/-  *talk
/+  talk, sole, http

::
::
::::  sivtyv-barnel
  ::
             
!:
|%
++  instance
$:  name=@t  id=@ud  status=@t  created=@t  region=@t  snapshot=json  disk=@u  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=(list 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-img
  =>  jo
  %-  ot
  :~  id/ni  name/so  distribution/so  slug/(mu so)  public/bo
  regions/(ar so)  'created_at'^so  type/so  'min_disk_size'^ni
  ==
++  parse-ip
  =>  jo
  %-  ot  
  :-  v4/(ar (ot 'ip_address'^(su lip:ag) ~))
  ~
++  parse-region
  =>  jo
  (ot name/so ~)
++  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)
  ==
++  state-to-json
  |=  a=(list instance)
  :-  %a
  %+  turn  a
  |=  instance
  ^-  json
  %-  jobe
  :~  name/`json`s/name
      id/`json`(jone id)
      status/s/status
      created/s/created
      region/s/region
      snapshot/s/'xx replace'
      disk/`json`(jone disk)
      ip/a/(turn ip |=(a=@if s/(rsh 3 1 (scot %if a))))
  ==
--
!:
|_  [hid=hide vat=axle]
::
++  prep  ,_`.
:::
++  spam
  |=  jon=json
  %+  turn  (~(tap by sup.hid))
  |=  [sub=bone @ pax=path]
  ^-  move
  [sub %diff %json jon]
++  auth-queries  
    |=  code=cord
    :~  'grant_type'^'authorization_code'
        'code'^code
        :-  'client_id'
        'd8f46b95af38c1ab3d78ad34c2157a6959c23eb0eb5d8e393f650f08e6a75c6f'
        'redirect_uri'^'http://localhost:8443/home/pub/cloud/fab'
    ==
++  httpreq
    |=  $:    ost=bone  pour-path=wire
            domain=(list cord)  end-point=path
          req-type=$?(%get [%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
          [%get headers ~]
        [%post headers ~ (tact (pojo +.req-type))]
    :^  ost  %them  pour-path
    `(unit hiss)`[~ request]
::
++  peer
  |=  [[ost=bone you=ship] pax=path]
  ^-  [(list move) _+>.$]
  :_  +>.$
  [ost %diff %json (state-to-json insts.vat)]~
::
++  poke-cloud-auth
  |=  [[ost=bone you=ship] [cde=cord typ=cord]]
  ^-  [(list move) _+>.$]
  ~&  [cde typ]
  ?:  =(%do typ) 
      =.  authc.do.auth.vat
      [~ cde]
    :_  +>.$
    ~
  =.  access.gce.toke.vat
  cde
  :_  +>.$
  :-  (list-instances-gce ost)
  ~
::
++  poke-cloud-secret
  |=  [[ost=bone you=ship] secret=cord typ=cord]
  ^-  [(list move) _+>.$]
  ~&  [secret typ]
  ::=+  [newvat code path]=[vat(auth auth.vat) ...]
  ::=.  vat  newvat
  ?+    typ  ~|(missing-platform=typ !!)
      %do
    =.  client-secret.do.auth.vat
      [~ secret]
    :_  +>.$
    :_  ~
    %^  httpreq  ost  /auth-do
    :^    ~[%digitalocean %cloud]  `path`/v1/oauth/token
        [%post ~]
    :-  ~  `quay`['client_secret'^secret (auth-queries (need authc.do.auth.vat))]
      %gce
    =.  client-secret.gce.auth.vat
      [~ secret]
    :_  +>.$
    :_  ~
    %^  httpreq  ost  /auth-gce
    :^    ~[%google %cloud]  `path`/v1/oauth/token
        [%post ~]
    :-  (mo ['Content-Type' 'application/json' ~] ['Authorization' (cat 3 'Bearer ' access.do.toke.vat) ~] ~)
    `quay`['client_secret'^secret %'access_token'^(need authc.gce.auth.vat) ~] ::(auth-queries (need authc.gcp.auth.vat))]
  ==
::
++  receive-auth
  |=  [ost=bone 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 ost)
      (publish ost our.hid [%lin & 'successfully authenticated']~)
  ==
    %auth-gce
  ::=+  ac=(need ((ot ~):jo 
  ~&  [body resp]
  :_  +>.$
  ~
  ==
::
++  poke-json
  |=  [[ost=bone you=ship] act=json]
  ^-  [(list move) _+>.$]
  =+  do=(need ((ot action/so ~):jo act))
  :_  +>.$
  :_  ~
  ?+  do  !!
      %list
  ^-  move  (list-instances-do ost)
  ::
      %create-do
   ^-  move  (create-do ost act)
  ::
      %create-gce-disk
^-  move     (create-gce-disk ost act)
    
  ::
      %create-gce
    ^-  move  (create-gce ost act)
  ::
      ?(%start %stop %reboot %delete)  ::%'power_on'  %'power_off'  %reboot  %'power_cycle' 
    ^-  move
    =+  id=(need ((ot id/no ~):jo act))
    (instance-action ost id do)
  ==
::
++  instance-action
  |=  $:  os=bone  id=@t
      $=  action  $?  
      %start  %stop  %reboot  %delete
      ==  ==
      ::  restore, resize, rebuild, change_kernelm, retrieve droplet action
  ^-  move
  =+  ^=  req
  %-  httpreq  :*
    os  /reboot
    ~[%digitalocean %api]  /v2/droplets/[id]/actions
    [%post `json`(jobe type/s/action ~)]
    (mo ['Content-Type' 'application/json' ~] ['Authorization' (cat 3 'Bearer ' access.do.toke.vat) ~] ~)
    *quay
   ==
   req

++  list-instances-gce
  |=  os=bone
  =+  ^=  lis
      :*  os                  /list-gce
      ~[%googleapis %www]     /compute/v1/projects/urbcloud/zones/['us-central1-a']/'instances'
      %get                    ~
      ^-  quay
      [%'access_token' access.gce.toke.vat]~
      ==
  (httpreq lis)

++  list-instances-do
  |=  os=bone
  =+  ^=  lis
      :~  os                 /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
  |=  [ost=bone 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 instance)
      ~|  bad-json/-.dar
      %+  turn  dar
      |=  drp=json
      %-  need
      %.  drp  =+  jo
      %-  ot
      :~  name/so  id/ni  status/so  'created_at'^so  region/parse-region
          image/some  disk/ni  networks/parse-ip
      ==
  =.  insts.vat
  dropz 
  =+  buf=`@da`(add ~s10 lat.hid)
  :_  +>.$
  :_  (spam (state-to-json insts.vat))
  [ost %wait /refresh-do buf]

++  create-do
  |=  [os=bone act=json]
  =+  ^-  deets=create-req-do
      %-  need
      %.  act
      =>  jo
      %-  ot
      :~  name/so  region/so  size/so  image/so ::  id key:img object
      ssh/(ar so)  backups/(mu bo)
      'ipv6'^(mu bo)  'priv_networking'^(mu bo)  'user_data'^(mu so)
      ==
  =+  ^-  body=json
      %-  create-do-body  :*
        name.deets  region.deets  size.deets  image.deets  ssh.deets  backups.deets
        ipv6.deets  private-networking.deets  user-data.deets 
      ==
  %-  httpreq  :*
    os                     /create-do
    ~[%digitalocean %api]  /v2/droplets
    [%post body]
    %^  mo  ['Content-Type' 'application/json; charset=utf-8' ~]
      ['Authorization' (cat 3 'Bearer ' access.do.toke.vat) ~]
    ~
    ~
  ==
::++  batch-request
::|=  [os=bone name=@t number=@ud snap=@t]   
::(list httr)  ^-  httr
  
++  create-gce-disk
  |=  [os=bone act=json] :: num=(unit ,@u)
  ::  =.  name  ?~(num name ...
  =+  :-  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
  :*  os    /create-gce-disk
      ~['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
  |=  [os=bone pax=path]  ^-  move
  =+  safe=(slav %uv ?~(pax !! -.pax))
  =+  link=(need (epur ?~(pax !! safe)))
  =.  r.link  ['access_token'^access.gce.toke.vat r.link]
  :^  os  %them  `wire`/disk-status
  `(unit hiss)`[~ [link [%get ~ ~]]]

++  disk-status                       ::receive
  |=  [ost=bone resp=httr]
  ^-  [(list move) _+>.$]
  =+  hcode=p.resp
  ?:  =('200' hcode)
    ~|  'did not receive 200'  !!
  =+  :-(parsed=(rash q:(need r.resp) apex:poja) jo)
  =+  :-  status=(need ((ot status/so ~) parsed))
  lin=(need ((ot 'selfLink'^so ~) parsed))
  =+  link=(scot %uv lin)
  ~&  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-disk ost nam 'tbd')
    :-  ~  +>.$
  :_  +>.$
  [ost %wait `path`[%check-status link ~] `@da`(add ~s3 lat.hid)]~       ::  refesh every 10 sec

++  create-gce
  |=  [os=bone act=json]
  =+  ^-  deets=create-req-gce
      %-  need
      %.  act
      =>  jo
      %-  ot
      :~  project/so  zone/so  name/so  %'machine_type'^so
      ==
  =+  src=(cat 3 'compute/v1/projects/urbcloud/zones/us-central1-b/disks/' name.deets)
  =+  ^-  body=json
      %-  jobe
      :~  name/s/'name-provided'  '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
  :*  `bone`os  `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
  |=  [[ost=bone him=ship pour-path=path] ~]
  ?+    -.pour-path  !!
      %refresh-do
    :_  +>.$
    [(list-instances-do ost)]~
      %check-status
    :_  +>.$
    [(ask-disk-status ost +.pour-path)]~
  ==
++  thou
  |=  [[ost=bone him=ship pour-path=path] resp=httr]
  ^-  [(list move) _+>.$]
  ?+    -.pour-path  ~&  pour-path  !!
      %auth-do
    (receive-auth ost -.pour-path resp)
  ::
      %auth-gce
    (receive-auth ost -.pour-path resp)
  ::
      %list-do
    (receive-list-do ost resp)
      %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
      ==
      ~&  resp
      :_  +>.$  ~
  ::
      ?(%create-gce-disk %disk-status)
    (disk-status ost resp)
  ::
      %check-status
    :_  +>.$  ~[(ask-disk-status ost +.pour-path)]
  ::
      %pub
    :_  +>.$  ~
  ::
  ==
++  publish
  |=  [ost=bone you=ship act=(list speech)]
  ^-  move
  =+  ^=  spchz
      %+  turn  act
      |=  sp=speech
      =+  ^=  tail
      :-  ^-  audience
          :+  :-  `partner`[%& our.hid ?+((clan our.hid) !! %czar %court, %duke %porch)]
              ^-  (pair envelope delivery)
              [`envelope`[& ~] %pending]
            ~
          ~
      `statement`[lat.hid ~ sp]
      ^-  thought
      :-  `@`(sham eny.hid tail)
      tail
  =+  mez=[%talk-command [%publish `(list thought)`spchz]]
  [ost %send /pub [our.hid %talk] %poke mez]
--