(.module:
  [lux #*
   ["." host (#+ import:)]
   [abstract
    [monad (#+ do)]]
   [control
    ["." io (#+ IO)]
    ["." try (#+ Try)]
    ["." exception (#+ exception:)]
    [concurrency
     ["." promise (#+ Promise)]
     ["." stm]]]
   [data
    ["." binary (#+ Binary)]
    ["." text
     ["%" format (#+ format)]
     ["." encoding]]
    [number
     ["n" nat]]]
   [world
    [net (#+ URL)
     ["." uri]]]]
  ["." // #_
   ["#." artifact (#+ Artifact)
    ["#/." extension (#+ Extension)]]])

(type: #export Address
  URL)

(type: #export User
  Text)

(type: #export Password
  Text)

(type: #export Identity
  {#user User
   #password Password})

(signature: #export (Repository !)
  (: (-> Artifact Extension (! (Try Binary)))
     download)
  (: (-> Identity Artifact Extension Binary (! (Try Any)))
     upload))

(def: #export (async repository)
  (-> (Repository IO) (Repository Promise))
  (structure
   (def: (download artifact extension)
     (promise.future (\ repository download artifact extension)))

   (def: (upload identity artifact extension content)
     (promise.future (\ repository upload identity artifact extension content)))
   ))

(signature: #export (Simulation s)
  (: (-> Artifact Extension s
         (Try [s Binary]))
     on-download)
  (: (-> Identity Artifact Extension Binary s
         (Try s))
     on-upload))

(def: #export (mock simulation init)
  (All [s] (-> (Simulation s) s (Repository Promise)))
  (let [state (stm.var init)]
    (structure
     (def: (download artifact extension)
       (stm.commit
        (do {! stm.monad}
          [|state| (stm.read state)]
          (case (\ simulation on-download artifact extension |state|)
            (#try.Success [|state| output])
            (do !
              [_ (stm.write |state| state)]
              (wrap (#try.Success output)))
            
            (#try.Failure error)
            (wrap (#try.Failure error))))))

     (def: (upload identity artifact extension content)
       (stm.commit
        (do {! stm.monad}
          [|state| (stm.read state)]
          (case (\ simulation on-upload identity artifact extension content |state|)
            (#try.Success |state|)
            (do !
              [_ (stm.write |state| state)]
              (wrap (#try.Success [])))
            
            (#try.Failure error)
            (wrap (#try.Failure error))))))
     )))

(import: java/lang/String)

(import: java/lang/AutoCloseable
  ["#::."
   (close [] #io #try void)])

(import: java/io/OutputStream
  ["#::."
   (flush [] #io #try void)
   (write [[byte]] #io #try void)])

(import: java/net/URLConnection
  ["#::."
   (setDoOutput [boolean] #io #try void)
   (setRequestProperty [java/lang/String java/lang/String] #io #try void)
   (getOutputStream [] #io #try java/io/OutputStream)])

(import: java/net/HttpURLConnection
  ["#::."
   (setRequestMethod [java/lang/String] #io #try void)
   (getResponseCode [] #io #try int)])

(import: java/net/URL
  ["#::."
   (new [java/lang/String])
   (openConnection [] #io #try java/net/URLConnection)
   (openStream [] #io #try java/io/InputStream)])

(import: java/util/Base64$Encoder
  ["#::."
   (encodeToString [[byte]] java/lang/String)])

(import: java/util/Base64
  ["#::."
   (#static getEncoder [] java/util/Base64$Encoder)])

(import: java/io/InputStream)

(import: java/io/BufferedInputStream
  ["#::."
   (new [java/io/InputStream])
   (read [[byte] int int] #io #try int)])

(exception: #export (deployment-failure {code Int})
  (exception.report
   ["Code" (%.int code)]))

(def: (basic-auth user password)
  (-> User Password Text)
  (format "Basic " (java/util/Base64$Encoder::encodeToString (encoding.to-utf8 (format user ":" password))
                                                             (java/util/Base64::getEncoder))))

(def: (url address artifact extension)
  (-> Address Artifact Extension URL)
  (format address uri.separator (//artifact.uri artifact) extension))

(def: buffer-size
  (n.* 512 1,024))

(structure: #export (remote address)
  (All [s] (-> Address (Repository IO)))

  (def: (download artifact extension)
    (let [url (..url address artifact extension)]
      (do {! (try.with io.monad)}
        [input (|> (java/net/URL::new url)
                   java/net/URL::openStream
                   (\ ! map (|>> java/io/BufferedInputStream::new)))
         #let [buffer (binary.create ..buffer-size)]]
        (loop [output (\ binary.monoid identity)]
          (do !
            [bytes-read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer-size) input)]
            (case bytes-read
              -1 (do !
                   [_ (java/lang/AutoCloseable::close input)]
                   (wrap output))
              _ (if (n.= ..buffer-size bytes-read)
                  (recur (\ binary.monoid compose output buffer))
                  (do !
                    [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes-read) buffer))]
                    (recur (\ binary.monoid compose output chunk))))))))))

  (def: (upload [user password] artifact extension content)
    (do (try.with io.monad)
      [connection (|> (..url address artifact extension)
                      java/net/URL::new
                      java/net/URL::openConnection)
       #let [connection (:coerce java/net/HttpURLConnection connection)]
       _ (java/net/HttpURLConnection::setRequestMethod "PUT" connection)
       _ (java/net/URLConnection::setDoOutput true connection)
       _ (java/net/URLConnection::setRequestProperty "Authorization" (..basic-auth user password) connection)
       stream (java/net/URLConnection::getOutputStream connection)
       _ (java/io/OutputStream::write content stream)
       _ (java/io/OutputStream::flush stream)
       _ (java/lang/AutoCloseable::close stream)
       code (java/net/HttpURLConnection::getResponseCode connection)]
      (case code
        +200 (wrap [])
        _ (\ io.monad wrap (exception.throw ..deployment-failure [code])))))
  )