/+  naive, ethereum, server, sr=sortug
=>
|%
+$  challenges  (set secret)
+$  secret  @uv
+$  authorization
  $:  who=@p
      =secret
      adr=tape
      sig=tape
  ==
:: +$  user-sessions  (map coki=@ [proven=@p src=@p])
+$  user-sessions  (map coki=@ ship=@p)
+$  sessions
  $:  =challenges
      users=user-sessions
  ==
--
|_  [=sessions =bowl:gall]
+$  sess  ^sessions
::  state field to keep track of users logged with metamask
  ::  this goes on the router
  ++  serve-metamask-challenge  
    |=  eyre-id=@ta
    ::  special-case MetaMask auth handling
    =/  new-challenge  (sham [now eny]:bowl)
    %+  weld  (self-poke [%meta new-challenge])
    %+  give-simple-payload:app:server
      eyre-id
    ^-  simple-payload:http
    :-  :-  200
        ~[['Content-Type' 'application/json']]
    `(as-octs:mimes:html (en:json:html (enjs-challenge new-challenge)))
  ::  Modified from ~rabsef-bicrym's %mask by ~hanfel-dovned.
  ++  process-metamask-auth
    |=  [order-id=@t octs=(unit octs)]
    ^-  (list card:agent:gall)
    =/  challenges  challenges.sessions
    |^
    ?~  octs  ~|(%empty-auth-request !!)
    :: ?.  =('auth' (cut 3 [0 4] q.u.octs))
    ::   *(list card:agent:gall)
    =/  jon  (de:json:html q.u.octs)
    ?~  jon  ~|(%empty-auth-json !!)
    =/  body=json  u.jon
    =/  axn  (dejs-action body)
    =/  is-valid  (validate who.axn secret.axn adr.axn sig.axn)
    ~&  >>  signature-valid=[is-valid who.axn secret.axn adr.axn sig.axn]
    ?.  is-valid  ~|(%bad-metamask-signature !!)
    
    =/  coki-hash  session-hash
    =/  coki  (session-cookie-string coki-hash who.axn)
    %+  weld
    (self-poke [%auth who.axn coki-hash secret.axn])
    %+  give-simple-payload:app:server
      order-id
    ^-  simple-payload:http
    :-  :-  303
      :~
        ['set-cookie' coki]
        ['location' '/zodiac']
      ==
    =/  obj=json  %-  pairs:enjs:format  :~([%login-ok [%b .y]])
    `(as-octs:mimes:html (en:json:html obj))
    
    ++  validate
      |=  [who=@p challenge=secret address=tape hancock=tape]
      ^-  ?
      =/  addy  (from-tape address)
      =/  cock  (from-tape hancock)
      =/  owner  (get-owner who)  ?~  owner  
        ~&  "no owner"  
        %.n
      ?.  =(addy u.owner)  
        ~&  "wrong owner"  
        %.n
      ?.  (~(has in challenges) challenge)  
        ~&  "bad challenge"  
        %.n
      =/  note=@uvI
        =+  octs=(as-octs:mimes:html (scot %uv challenge))
        %-  keccak-256:keccak:crypto
        %-  as-octs:mimes:html
        ;:  (cury cat 3)
          '\19Ethereum Signed Message:\0a'
          (crip (a-co:co p.octs))
          q.octs
        ==
      ?.  &(=(20 (met 3 addy)) =(65 (met 3 cock)))  
        ~&  "addy != cock"  
        %.n
      =/  r  (cut 3 [33 32] cock)
      =/  s  (cut 3 [1 32] cock)
      =/  v=@
        =+  v=(cut 3 [0 1] cock)
        ?+  v  99
          %0   0
          %1   1
          %27  0
          %28  1
        ==
      ?.  |(=(0 v) =(1 v))  
        ~&  "wrong v"
        %.n
      =/  xy
        (ecdsa-raw-recover:secp256k1:secp:crypto note v r s)
      =/  pub  :((cury cat 3) y.xy x.xy 0x4)
      =/  add  (address-from-pub:key:ethereum pub)
      =(addy add)
    ::
    ++  from-tape
      |=(h=tape ^-(@ux (scan h ;~(pfix (jest '0x') hex))))
    ::
    ++  get-owner
      |=  who=@p
      ^-  (unit @ux)
      =-  ?~  pin=`(unit point:naive)`-
            ~
          ?.  |(?=(%l1 dominion.u.pin) ?=(%l2 dominion.u.pin))
            ~
          `address.owner.own.u.pin
      .^  (unit point:naive)
        %gx
        %+  en-beam
          [our.bowl %azimuth [%da now.bowl]]
        /point/(scot %p who)/noun
      ==
    ++  dejs-action
      |=  jon=json
      ^-  authorization
      =,  dejs:format
      %.  jon
      %-  ot
      :: :~  [%who (se %p)]
      :~  [%who ni]
          [%secret (se %uv)]
          [%address sa]
          [%signature sa]
      ==
    --
  ++  enjs-challenge
    =,  enjs:format
    |=  chal=@
    ^-  json
    %-  pairs
    :~  [%challenge [%s (scot %uv chal)]]
    ==
  ++  self-poke
    |=  noun=*
    ^-  (list card:agent:gall)
    :~  [%pass /gib %agent [our.bowl dap.bowl] %poke %noun !>(noun)]
    ==

  ::  these are the poke handlers
  ++  handle-meta
    |=  new-challenge=@  ^-  ^sessions
    :: =?    users.sessions
    ::     !(~(has by users.sessions) src.bowl)
    ::   (~(put by users.sessions) [src.bowl src.bowl])
    :: =?    challenges.sessions
    ::     =(src.bowl (~(got by users.sessions) src.bowl))
      =.  challenges.sessions
      (~(put in challenges.sessions) new-challenge)

    sessions
  ++  handle-auth
    |=  [who=@p coki=@ =secret]  ^-  ^sessions
    :: ~&  >  "%ustj: Successful authentication of {<src>} as {<who>}."
    =.  users.sessions        (~(put by users.sessions) coki who)
    =.  challenges.sessions   (~(del in challenges.sessions) secret)
    sessions
  
  ++  session-timeout
    |%
    ++  auth   ~d30
    ++  guest  ~d7
    --
  ++  session-hash
    (~(raw og (shas %coki eny.bowl)) 128)
  ++  session-cookie-string  |=  [session=@ proven=@p]
    ^-  @t
    =/  max-age=tape  %-  a-co:co
      =/  its-a-me  .=(src.bowl our.bowl)
      =,  session-timeout
      (div (msec:milly ?:(its-a-me auth guest)) 1.000)
    %-  crip
      "urbneo-{(scow %p proven)}={(scow:parsing:sr %uv session)}; Path=/; Max-Age={max-age}"
      :: "urbneo={(scow:parsing:sr %uv session)}; Path=/; Max-Age={max-age}"
  ++  validate-coki  |=  coki=@t  ^-  (unit @p)
    ~&  >>  validating-coki=coki
    =/  cookies  (rush coki cock:de-purl:html)
    ~&  cookies=cookies
    ?~  cookies  ~
    =/  cokis=(list [@t @t])  u.cookies
    |-
      ?~  cokis  ~
      =/  hd  i.cokis
      :: ?:  (contains:string:sr (trip hd) "urbneo")
        ~&  key=-.hd
        =/  hash  (slaw:parsing:sr %uv +.hd)
        ?~  hash  $(cokis t.cokis)
        ~&  hash=`@uv`u.hash
        =/  sess  (~(get by users.sessions) u.hash)
        ~&  sess=sess
        ?~  sess  $(cokis t.cokis)
        `u.sess
  ++  parse-coki  |=  coki=@t
    =/  cookies  (rush coki cock:de-purl:html)
    ?~  cookies  users.sessions
    =/  cokis=(list [@t @t])  u.cookies
    |-
      ?~  cokis  users.sessions
      =/  hd  i.cokis
      :: ?:  (contains:string:sr (trip hd) "urbneo")
      ~&  key=-.hd
      =/  hash  (slaw:parsing:sr %uv +.hd)
      ?~  hash  $(cokis t.cokis)
      =/  sess  (~(get by users.sessions) u.hash)
      ?~  sess  $(cokis t.cokis)
      (~(del by users.sessions) u.hash)

  ++  logout  |=  [order-id=@t coki=@t]
    (self-poke [%logout order-id coki])
  ++  handle-logout  |=  [order-id=@t coki=@t]
    ~&  handling-logout=coki
    =/  new-users  (parse-coki coki)
    :_  sessions(users new-users)
    %+  give-simple-payload:app:server
      order-id
    (redirect:gen:server '/zodiac/login')
  --