s3-lib

s3-lib.hoon

=,  scr:crypto
|_  [reg=@t secret=@t key=@t now=@da]
+$  purl  purl:eyre
++  auth-dbg
  |=  =request:http
  =/  canonical  (canonical request)
  =/  digest  (hash (crip canonical))
  =/  contract  (contract request digest)
  :*  canonical=canonical 
      digest=digest 
      contract=contract 
      signer=(en:base16:mimes:html 32 signer)
      sign=(sign contract)
  ==
++  auth
  |=  =request:http
  ^-  request:http
  =.  header-list.request
    (cred request)
  request
++  cred
  |=  =request:http
  ^-  header-list:http
  =/  hydra  (malt header-list.request)
  %~  tap  by
  %+  ~(put by hydra)
    'Authorization'
  %-  crip
  %+  weld
    "AWS4-HMAC-SHA256 "
  ^.  tape
  %-  zing  
  %+  join
    ", "
  ^.  (list tape)
  :~  ;:  weld
          "Credential="
          (trip key)
          "/"
          scope
      ==
      %+  weld
          "SignedHeaders="
          %-  facet
            +:(crest header-list.request)
      %+  weld
          "Signature="
          %-  trip
            %-  sign
          %+  contract
            request
          %-  hash
            %-  crip
          (canonical request)
  ==
++  sign
  |=  deal=@t
  %+  en:base16:mimes:html  32 
  (hmc signer deal)
++  signer
  %+  hmc
    %+  hmc
      %+  hmc
        %+  hmc
          (crip (weld "AWS4" (trip secret)))
        (crip cal)
      reg
    's3'
  'aws4_request'
++  contract
  |=  [=request:http digest=@t]
  ^-  @t
  =/  hydra=(map @t @t)  (malt header-list.request)
  %-  crip
  %+  weld
    %+  roll
      ^.  (list tape)
      :~  "AWS4-HMAC-SHA256"
          %-  trip
              %+  ~(gut by hydra)
            'X-Amz-Date'
            (crip clock)
          scope
      ==
    link
  (trip digest)
++  scope
  ^-  tape
  %+  join  '/'
    ^.  (list @t)
    :~  (crip cal)
        reg
        's3'
        'aws4_request'
    ==  
++  canonical
  |=  =request:http
  =/  url=purl  (need (de-purl:html url.request))
  =/  crown     (crest header-list.request)
  %+  roll
    ^.  (list tape)
    :~  `tape`[method.request ~]
        (trail url)
        (quiz url)
        -.crown
        (facet +.crown)
        (trip (pile body.request))
    ==
  link
++  link
  |=  [item=tape pole=tape]
  ^-  tape
  (weld pole (snoc item '\0a'))
++  trail
  |=  url=purl
  ^-  tape
  =/  parts=(list tape)  (turn q.q.url trip)
  =/  road=tape  `tape`(zing (join "/" `(list tape)`(turn parts en-urlt:html)))
  (weld ~['/'] road)
++  quiz
  |=  url=purl
  =/  quay  r.url
  ^-  tape
  ?~  quay  ""
  =/  squr  %+  sort  quay
  |=  [a=[@t @t] b=[@t @t]]
  (gth -.a -.b)
  =/  tqur  %+  turn  squr
  |=  item=[@t @t]
  :(weld (en-urlt:html (trip -.item)) "=" (en-urlt:html (trip +.item)))
  %+  roll  `(list tape)`(join "&" tqur)
  |=  [item=tape pole=tape]
  (weld pole item)
++  crest
  |=  heads=header-list:http
  =/  hydra=(map @t @t)  (malt heads)
  %+  ~(rib by hydra)  *tape
    |=  [[k=@t v=@t] acc=tape]
    =/  key=tape    (cass (trip k))
    =/  value=tape  (trimall v)
    =/  combo=tape  (weld (snoc key ':') value)
    :-  (link combo acc) 
      [(crip key) (crip value)]
++  facet
  |=  heads=(map @t @t)
  ^-  tape
  =/  hydra=(list @t)  `(list @t)`~(tap in ~(key by heads))
  (join ';' hydra)
++  pile
  |=  body=(unit octs)
  ^-  @t
  %-  hash
  ?~  body  ''  
    +:(need body)
++  hash
  |=  content=@t
  ^-  @t
  %+  en:base16:mimes:html  32 
  %^  rev  3
      32
  (shax content)
++  trimall
  |=  value=@t
  |^  ^-  tape
  %+  rash  value
  %+  ifix  [(star ws) (star ws)]
  %-  star
  ;~  less
    ;~(plug (plus ws) ;~(less next (easy ~)))
    ;~(pose (cold ' ' (plus ws)) next)
  ==
  ++  ws  (mask " \0a\0d\09")
  --
++  cal
  (swag [0 8] clock)
++  clock
  (esoo now)
::  ISO8601
::
++  esoo
  |=  d=@d
  ^-  tape
  =/  t  (yore d)
  ;:  welp
      (scag 1 (scow %ud y.t))
      (swag [2 3] (scow %ud y.t))
      (double m.t)
      (double d.t.t)
      "T"
      (double h.t.t)
      (double m.t.t)
      (double s.t.t)
      "000Z"
  ==
:: ud to leading zero tape
++  double
  |=  a=@ud
  ^-  tape
  =/  x  (scow %ud a)
  ?:  (lth a 10)
    (welp "0" x)
  x
--