janet: implement headers and cookies

sadly, I no longer (promise to) parse cookies for you

2 files changed, 98 insertions, 23 deletions

diff --git a/jurl/init.janet b/jurl/init.janet
index 0a6c348..da81205 100644
--- a/jurl/init.janet
+++ b/jurl/init.janet
@@ -1,5 +1,6 @@
 (import jurl/native)
 (import ./mime)
+(import ./text)
 (import ./writer)
 
 # global init on import
@@ -13,15 +14,6 @@
                          :followlocation   true
                          :postredir        :redir-post/all
                          :useragent        "Jurl/1.0"})
-
-(defn gen-headers
-  [& maps]
-  (->> maps
-       (mapcat pairs)
-       (map (fn [[k v]] (string/format "%s: %s" k v)))
-       sort
-       freeze))
-
 # useful for queries and x-www-urlencoded
 (defn url-encoded
   [dict]
@@ -32,8 +24,6 @@
            (map (fn [[k v]] (string/format "%s=%s" k v))))
       (string/join "&")))
 
-(def keyword-lower (comp keyword string/ascii-lower))
-
 (defn request
   [{:auth    auth
     :body    body
@@ -81,14 +71,18 @@
     
                (error "body must either be a mime to do a multipart form submission, a buffer/string, callback function, or dictionary to url-encode")))
 
-  # TODO: cookies
+  (when cookies
+    (pt :cookie (-> (->> cookies
+                         pairs
+                         (map (fn [[k v]] (string/format "%s=%s;" k v))))
+                    (string/join " "))))
 
   (when headers (cond
-                  (dictionary? headers) (pt :httpheader (gen-headers headers))
+                  (dictionary? headers) (pt :httpheader (text/header-list headers))
                   (indexed? headers)    (pt :httpheader headers)
                   (error "headers must be a dictionary or list")))
 
-  (when method (match (keyword-lower method)
+  (when method (match (text/keyword-lower method)
                  :get     (pt :httpget true)
                  :post    (pt :post true)
                  :put     (pt :upload true)
@@ -102,21 +96,20 @@
   
   (def res-body @"")
   (def res-hdr  @"")
-  (pt :writefunction  |(buffer/push res-body $))
   (pt :headerfunction |(buffer/push res-hdr  $))
-
-  # TODO: stream
+  (pt :writefunction (if (function? stream)
+                       stream
+                       |(buffer/push res-body $)))
   
   (when options (eachp [k v] options
                   (pt k v)))
   
   (:perform handle)
 
-  # TODO: cookies to map
-  # TODO: headers to map
-  (freeze {:body res-body
-           :cookies nil
-           :headers res-hdr
+  # cookies are complicated for many reasons
+  # combine :cookielist and (:headers :set-cookie) to handle yourself
+  (freeze {:body (if (function? stream) :unavail res-body)
+           :headers (text/parse-headers res-hdr)
            :status (handle :response-code)})) 
 
 # request format
@@ -139,6 +132,5 @@
 # response format
 (comment {:body (or buffer
                     :unavail) # if stream = true
-          :cookies dictionary
           :headers dictionary
           :status 200})
diff --git a/jurl/text.janet b/jurl/text.janet
new file mode 100644
index 0000000..bbd0d9c
--- /dev/null
+++ b/jurl/text.janet
@@ -0,0 +1,83 @@
+# text helpers
+# parsing of text and generation of text
+(def keyword-lower (comp keyword string/ascii-lower))
+
+(def header-pegs
+  ~{:field-line (* ':field-name ":" :ows ':field-value :ows)
+    :field-name :token
+    :ws (set " \t")
+    :ows (any :ws)
+    :field-value (any :field-content)
+    :field-content (* :field-vchar
+                      (? (some ( * (+ :ws :field-vchar)
+                                   :field-vchar))))
+    :field-vchar (+ :vchar :obs-text)
+    :obs-text (range "\x80\xFF")
+    :token (some :tchar)
+    :tchar (+ :w #any VCHAR, except delimiters
+              (set "!#$%&'*+-.^_`|~"))
+    :vchar (+ :tchar
+              (set "\"(),/:;<=>?@[\\]{}"))
+    :crlf "\r\n"
+
+    # start-line CRLF *( field-line CRLF ) CRLF [ message-body ]
+    # curl removes [ message-body ] for us
+    # we still have to parse start-line
+    # start-line is either a request or a response
+    # we will be nice and parse response (what it is most of the time)
+    # however, requests are complicated, so we will skip until \r\n if it's not a response
+    # technically not 100% compliant since the spec uses "/" to imply that request-line should be tried first, but... I don't care
+    :start-line (+ :status-line :request-line)
+    :status-line (* :http-version " " :status-code " " (? :reason-phrase) :crlf)
+    :http-version (+ :http-version-1)
+    :http-version-1 (* :http-name "/" :d "." :d)
+    # I couldn't find the spec for this
+    :http-version-2 (* :http-name "/2")
+    :http-name "HTTP"
+    :status-code (repeat 3 :d)
+    :reason-phrase (some (+ :ws :vchar :obs-text))
+    :request-line (thru :crlf) 
+
+    :field-line-crlf (/ (* :field-line :crlf) ,tuple)
+    :main (* :start-line (any :field-line-crlf) :crlf)})
+(def header-peg (peg/compile header-pegs))
+
+(defn from-pairs-merge
+  [ps]
+  (def out @{})
+  (each [k v] ps
+    (put out k (let [o (out k)]
+                 (cond
+                    (bytes? o)   (sorted [o v])
+                    (indexed? o) (sorted [;o v])
+                    v))))
+  (freeze out))
+
+# I do not parse content, including the "," joining
+# the reason is that I don't want to handle every single header in the ledger
+# since they can all change the semantics
+# however, if I receive multiple headers of a given type, I join them in a list
+(defn parse-headers
+  [s]
+  (or (-?>> s
+            (peg/match header-peg)
+            (map (fn [[k v]] [(keyword-lower k) v]))
+            (sort-by first)
+            from-pairs-merge)
+      {}))
+
+(defn- format-header
+  [k v]
+  (string/format "%s: %s" k v))
+
+# if you give me a list, I will split it into multiple instances of that header
+(defn header-list
+  [& maps]
+  (->> maps
+       (mapcat pairs)
+       (map (fn [[k v]] (if (indexed? v)
+                          (map |(format-header k $) v)
+                          (format-header k v))))
+       flatten
+       sort
+       freeze))