urbit/ape/cloud.hoon

::  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 +>.$])
--