[hcoop/debian/mlton.git] / lib / mlton / basic / http.sml

(* Copyright (C) 2009 Matthew Fluet.
 * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
 *    Jagannathan, and Stephen Weeks.
 *
 * MLton is released under a BSD-style license.
 * See the file MLton-LICENSE for details.
 *)

structure Http: HTTP =
struct

structure Regexp =
   struct
      open Regexp

      val CHAR = ascii
      val UPALPHA = isChar Char.isUpper
      val LOALPHA = isChar Char.isLower
      val ALPHA = isChar Char.isAlpha
      val DIGIT = isChar Char.isDigit
      val CTL = isChar Char.isCntrl
      val CR = char #"\r"
      val LF = char #"\n"
      val SP = char #" "
      val HT = char #"\t"
      val CRLF = string "\r\n"
      (* #"\n" is not in the spec for CRLF, but Netscape generates it. *)        
      val CRLF = or [CRLF, char #"\n"]
      val LWS = seq [optional CRLF, oneOrMore (or [SP, HT])]
      val TEXT = isNotChar Char.isCntrl
      val HEX = isChar Char.isHexDigit
      val separatorChars = "()<>@,;:\\\"/ []?= {} \t"
      val separators = oneOf separatorChars
      val token =
         oneOrMore (isChar
                    (Char.memoize
                     (fn c =>
                      Char.isAscii c
                      andalso not (Char.isCntrl c)
                      andalso not (String.contains (separatorChars, c)))))
      val dquote = char Char.dquote
      val qdtext = isChar (fn c =>
                          not (Char.isCntrl c)
                          andalso not (c = Char.dquote))
      val quotedpair = seq [char #"\\", CHAR]
      val quotedstring =
         seq [dquote, star (or [qdtext, quotedpair]), dquote]
      val ctext =
         isChar (fn c =>
                not (Char.isCntrl c)
                andalso not (c = #"(")
                andalso not (c = #")"))
      (*         val comment =
       *            seq [char #"(",
       *                star (or [ctext, quoted-pair, comment]),
       *                char #")"]
       *)
      val major' = Save.new ()
      val minor' = Save.new ()
      val version =
         seq [string "HTTP/",
              save (oneOrMore DIGIT, major'),
              char #".",
              save (oneOrMore DIGIT, minor')]
      val fieldname' = Save.new ()
     val fieldname =
        (* fieldname should just be token, but the stupid Microsoft server
         * includes spaces in its "Content Location" field, so we need to accept
         * more. The easies thing is just to take anything but a ":".
         *)
        (* save (token, fieldname') *)
        save (star (notChar #":"), fieldname')
      val fieldcontent =
         (* fieldcontent should just be TEXT, but nytimes stores control
          * characters in cookies, and thus, need to allow more.
          *)
         (*TEXT *)
         isChar (fn c => c >= #" ")
      val fieldvalue' = Save.new ()
      val fieldvalue = star (or [fieldcontent, LWS])
      val messageheader =
         Promise.lazy
         (fn () =>
          compileDFA (seq [fieldname, char #":",
                           save (optional fieldvalue, fieldvalue'),
                           CRLF]))
      val method' = Save.new ()
      val method = save (token, method')
      val star' = Save.new ()
      val absoluteUrl' = Save.new ()
      val absPath' = Save.new ()
      val authority' = Save.new ()
      val query' = Save.new ()
      val requestUrl =
         let open Url.Regexp
         in or [save (char #"*", star'),
                save (absoluteUrl, absoluteUrl'),
                seq [save (absPath, absPath'),
                     optional (seq [char #"?", save (query, query')])],
                save (authority, authority')]
         end
      val requestLine =
         Promise.lazy
         (fn () =>
          compileDFA (seq [method, SP, requestUrl, SP, version, CRLF]))
      val contentLength =
         Promise.lazy (fn () => compileDFA (oneOrMore DIGIT))
      val status' = Save.new ()
      val status = save (seq [DIGIT, DIGIT, DIGIT], status')
      val reason =
         star (isChar (fn c =>
                     Char.isPrint c andalso c <> #"\r" andalso c <> #"\n"))
      val responseLine =
         Promise.lazy
         (fn () => compileDFA (seq [version, SP, status, SP, reason, CRLF]))
   end

structure Method =
   struct
      datatype t =
         Connect
       | Delete
       | Extension of string
       | Get
       | Head
       | Options
       | Post
       | Put
       | Trace

      val map =
         [(Connect, "CONNECT"),
          (Delete, "DELETE"),
          (Get, "GET"),
          (Head, "HEAD"),
          (Options, "OPTIONS"),
          (Post, "POST"),
          (Put, "PUT"),
          (Trace, "TRACE")]

      fun fromString s =
         case List.peek (map, fn (_, s') => s = s') of
            NONE => Extension s
          | SOME (h, _) => h

      fun toString h =
         case h of
            Extension s => s
          | _ => #2 (valOf (List.peek (map, fn (h', _) => h = h')))

      val layout = Layout.str o toString
   end

structure Version =
   struct
      datatype t = T of {major: int,
                         minor: int}

      fun toString (T {major, minor}) =
         concat ["HTTP/",
                Int.toString major,
                ".",
                Int.toString minor]

      val layout = Layout.str o toString

      val v10 = T {major = 1, minor = 0}
      val v11 = T {major = 1, minor = 1}

      fun extract m =
         T (let
              open Regexp
              fun int s = valOf (Int.fromString (Substring.toString
                                                 (Match.lookup (m, s))))
           in {minor = int minor',
               major = int major'}
           end)
   end

structure RequestUrl =
   struct
      structure Path = Url.Path
      datatype t =
         Star
       | Url of Url.t
       | Path of {path: Path.t,
                  query: string option}
       | Authority of string

      val toString =
         fn Star => "*"
          | Url url => Url.toString url
          | Path {path, query} =>
               concat [Path.toString path,
                      case query of
                         NONE => ""
                       | SOME q => concat ["?", if !Url.escapeQuery
                                                  then Url.escape q
                                               else q]]
          | Authority s => s

      val layout = Layout.str o toString
   end

exception ParseError

structure Header =
   struct
      datatype t =
         Accept of string
       | AcceptCharset of string
       | AcceptEncoding of string
       | AcceptLanguage of string
       | AcceptRanges of string
       | Age of string
       | Allow of string
       | Authorization of string
       | CacheControl of string
       | Connection of string
       | ContentEncoding of string
       | ContentLanguage of string
       | ContentLength of int
       | ContentLocation of string
       | ContentMD5 of string
       | ContentRange of string
       | ContentType of string
       | Cookie of string
       | Date of string
       | ETag of string
       | Expect of string
       | Expires of string
       | Extension of {name: string, value: string}
       | From of string
       | Host of string
       | IfMatch of string
       | LastModified of string
       | Location of string
       | Pragma of string
       | ProxyAuthenticate of string
       | ProxyConnection of string
       | Referer of string
       | RetryAfter of string
       | Server of string
       | SetCookie of string
       | Trailer of string
       | TransferEncoding of string
       | Upgrade of string
       | UserAgent of string
       | Vary of string
       | Via of string
       | WWWAuthenticate of string
       | Warning of string

      val toString =
         fn Accept s => concat ["Accept: ", s]
          | AcceptCharset s => concat ["Accept-Charset: ", s]
          | AcceptEncoding s => concat ["Accept-Encoding: ", s]
          | AcceptLanguage s => concat ["Accept-Language: ", s]
          | AcceptRanges s => concat ["Accept-Ranges: ", s]
          | Age s => concat ["Age: ", s]
          | Allow s => concat ["Allow: ", s]
          | Authorization s => concat ["Authorization: Basic ", Base64.encode s]
          | CacheControl s => concat ["Cache-Control: ", s]
          | Connection s => concat ["Connection: ", s]
          | ContentEncoding s => concat ["Content-Encoding: ", s]
          | ContentLanguage s => concat ["Content-Language: ", s]
          | ContentLength s => concat ["Content-Length: ", Int.toString s]
          | ContentLocation s => concat ["Content-Location: ", s]
          | ContentMD5 s => concat ["Content-MD5: ", s]
          | ContentRange s => concat ["Content-Range: ", s]
          | ContentType s => concat ["Content-Type: ", s]
          | Cookie s => concat ["Cookie: ", s]
          | Date s => concat ["Date: ", s]
          | ETag s => concat ["Etag: ", s]
          | Expect s => concat ["Expect: ", s]
          | Expires s => concat ["Expires: ", s]
          | Extension {name, value} => concat [name, ": ", value]
          | From s => concat ["From: ", s]
          | Host s => concat ["Host: ", s]
          | IfMatch s => concat ["If-Match: ", s]
          | LastModified s => concat ["Last-Modified: ", s]
          | Location s => concat ["Location: ", s]
          | Pragma s => concat ["Pragma: ", s]
          | ProxyAuthenticate s => concat ["Proxy-Authenticate: ", s]
          | ProxyConnection s => concat ["Proxy-Connection: ", s]
          | Referer s => concat ["Referer: ", s]
          | RetryAfter s => concat ["Retry-After: ", s]
          | Server s => concat ["Server: ", s]
          | SetCookie s => concat ["Set-Cookie: ", s]
          | Trailer s => concat ["Trailer: ", s]
          | TransferEncoding s => concat ["Transfer-Encoding: ", s]
          | Upgrade s => concat ["Upgrade: ", s]
          | UserAgent s => concat ["User-Agent: ", s]
          | Vary s => concat ["Vary: ", s]
          | Via s => concat ["Via: ", s]
          | WWWAuthenticate s => concat ["WWW-Authenticate: ", s]
          | Warning s => concat ["Warning: ", s]

      val layout = Layout.str o toString

      fun toStrings (hs: t list): string list =
         List.concatMap (hs, fn h => [toString h, "\r\n"])

      val cons: string -> string -> t option =
         String.memoizeList
         (fn s => fn s' => SOME (Extension {name = s, value = s'}),
          [("accept", SOME o Accept),
           ("accept-charset", SOME o AcceptCharset),
           ("accept-encoding", SOME o AcceptEncoding),
           ("accept-language", SOME o AcceptLanguage),
           ("accept-ranges", SOME o AcceptRanges),
           ("age", SOME o Age),
           ("allow", SOME o Allow),
           ("authorization",
            let
               open Regexp
               val enc = Save.new ()
               val reg = compileNFA (seq [string "Basic ", save (anys, enc)])
            in
               fn s =>
               let
               in Option.map
                  (Compiled.matchAll (reg, s), fn m =>
                   Authorization
                   (Base64.decode (Match.lookupString (m, enc))))
               end
            end),
           ("cache-control", SOME o CacheControl),
           ("connection", SOME o Connection),
           ("content-encoding", SOME o ContentEncoding),
           ("content-language", SOME o ContentLanguage),
           ("content-length",
            fn (s: string) =>
            let open Regexp
            in if Regexp.Compiled.matchesAll (contentLength (), s)
                  then Option.map (Int.fromString s, ContentLength)
               else NONE
            end),
           ("content-location", SOME o ContentLocation),
           ("content-md5", SOME o ContentMD5),
           ("content-range", SOME o ContentRange),
           ("content-type", SOME o ContentType),
           ("cookie", SOME o Cookie),
           ("date", SOME o Date),
           ("etag", SOME o ETag),
           ("expect", SOME o Expect),
           ("expires", SOME o Expires),
           ("from", SOME o From),
           ("host", SOME o Host),
           ("if-match", SOME o IfMatch),
           ("last-modified", SOME o LastModified),
           ("location", SOME o Location),
           ("pragma", SOME o Pragma),
           ("proxy-authenticate", SOME o ProxyAuthenticate),
           ("proxy-connection", SOME o ProxyConnection),
           ("referer", SOME o Referer),
           ("retry-after", SOME o RetryAfter),
           ("server", SOME o Server),
           ("set-cookie", SOME o SetCookie),
           ("trailer", SOME o Trailer),
           ("transfer-encoding", SOME o TransferEncoding),
           ("upgrade", SOME o Upgrade),
           ("user-agent", SOME o UserAgent),
           ("vary", SOME o Vary),
           ("via", SOME o Via),
           ("www-authenticate", SOME o WWWAuthenticate),
           ("warning", SOME o Warning)])

      fun fromString (s: string): t list Result.t =
         let
            val no = Result.No (concat ["invalid header: ", s])
            val n = String.size s
            fun loop (i: int, ac: t list) =
               if i = n
                  then Result.Yes (rev ac)
               else let open Regexp
                    in case Compiled.matchLong (messageheader (), s, i) of
                       NONE => no
                     | SOME m => 
                          let
                             val {lookup, ...} = Match.stringFuns m
                             val fieldname = String.toLower (lookup fieldname')
                             val fieldvalue =
                                String.dropl (lookup fieldvalue', Char.isSpace)
                          in case cons fieldname fieldvalue of
                             NONE => no
                           | SOME header =>
                                loop (i + Match.length m, header :: ac)
                          end
                    end
         in loop (0, [])
         end

      val fromString =
         Trace.trace ("Http.Header.fromString",
                      String.layout,
                      Result.layout (List.layout layout))
         fromString

      fun input (ins: In.t): t list Result.t =
         let
            fun loop (headers: string list): string list =
               case In.inputLine ins of
                  NONE => headers
                | SOME l => 
                     if l = "\r\n"
                        then headers
                     else loop (l :: headers)
         in
            fromString (concat (rev (loop [])))
         end
   end

structure Request =
   struct
      datatype t = T of {method: Method.t,
                         url: RequestUrl.t,
                         version: Version.t,
                         headers: Header.t list}

      val regexp = Regexp.requestLine

      fun toString (T {method, url, version, headers}) =
         concat ([Method.toString method,
                 " ",
                 RequestUrl.toString url,
                 " ",
                 Version.toString version,
                 "\r\n"]
                @ Header.toStrings headers
                @ ["\r\n"])

      val layout = Layout.str o toString

      fun output (r, out) = Out.output (out, toString r)

      fun requestLine (s: string) =
         let
            open Regexp
         in Option.map
            (Compiled.matchAll (requestLine (), s), fn m =>
             let
                val {peek, lookup, exists, ...} = Match.stringFuns m
                val method = Method.fromString (lookup method')
                open RequestUrl
                val url =
                   if exists star'
                      then Star
                   else if exists absoluteUrl'
                           then Url (Url.getMatch m)
                        else
                           (case peek authority' of
                               NONE =>
                                  Path {path = Url.Regexp.getAbsPath m,
                                       query = Url.Regexp.peekQuery m}
                             | SOME s => Authority s)
                val version = Version.extract m
             in {method = method,
                 url = url,
                 version = version}
             end)
         end

      val requestLine =
         Trace.trace ("Http.Request.requestLine",
                      String.layout,
                      Option.layout (fn {method, url, version} =>
                                     Layout.record
                                     [("method", Method.layout method),
                                      ("url", RequestUrl.layout url),
                                      ("version", Version.layout version)]))
         requestLine

      val requestIsValid = Option.isSome o requestLine

      fun input (ins: In.t): t Result.t =
         case In.inputLine ins of
            NONE => Result.No ""
          | SOME l =>
               case requestLine l of
                  NONE => Result.No l
                | SOME {method, url, version} =>
                     Result.map
                     (Header.input ins, fn hs =>
                      T {method = method,
                         url = url,
                         version = version,
                         headers = hs})

      val input =
         Trace.trace ("Http.Request.input", In.layout, Result.layout layout) input
   end

structure Rope =
   struct
      datatype t =
         Appends of t list
       | File of File.t
       | String of string

      val appends = Appends
      val file = File
      val string = String

      val empty = String ""

      fun sizePlus (r: t, ac: int): int =
         case r of
            Appends rs => List.fold (rs, ac, sizePlus)
          | File f => ac + Position.toInt (File.size f)
          | String s => ac + String.size s

      fun size (r: t): int = sizePlus (r, 0)

      fun toStrings (r: t, ac: string list): string list =
         case r of
            Appends rs => List.fold (rev rs, ac, toStrings)
          | File f => File.contents f :: ac
          | String s => s :: ac

      fun toString (r: t): string = concat (toStrings (r, []))

      fun output (r: t, out: Out.t): unit =
         let
            fun loop (r: t): unit =
               case r of
                  Appends rs => List.foreach (rs, loop)
                | File f => File.outputContents (f, out)
                | String s => Out.output (out, s)
         in
            loop r
         end
   end

structure Post =
   struct
      structure Encoding =
         struct
            datatype t = Url | Multipart
         end

      structure Value =
         struct
            datatype t =
               File of File.t
             | String of string

            val file = File
            val string = String

            fun toString (v: t): string =
               case v of
                  File f => File.contents f
                | String s => s

            fun toRope (v: t): Rope.t =
               case v of
                  File f => Rope.file f
                | String s => Rope.string s
         end

      datatype t =
         T of {encoding: Encoding.t,
               fields: {name: string,
                        value: Value.t} list}

      fun dquote s = concat ["\"", s, "\""]

      fun encode (T {encoding, fields}): {contentType: string} * Rope.t =
         case encoding of
            Encoding.Url =>
               ({contentType = "application/x-www-form-urlencoded"},
                List.fold
                (rev fields, Rope.empty, fn ({name, value}, r) =>
                 let
                    val value =
                       String.translate
                       (Value.toString value, fn c =>
                        if Char.isAlphaNum c
                           then Char.toString c
                        else
                           (case c of
                               #" " => "+"
                             | #"\n" => "%0D%0A"
                             | _ => Url.Char.escapeHex c))
                 in
                    Rope.appends [Rope.string (concat [name, "="]),
                                  Rope.string value,
                                  Rope.string "&",
                                  r]
                 end))
          | Encoding.Multipart =>
               let
                  val boundary =
                     String.tabulate
                     (56, fn i =>
                      if i < 28 then #"-" else Random.charFrom "0123456789")
               in
                  ({contentType = concat ["multipart/form-data; boundary=",
                                          boundary]},
                   List.foldr
                   (fields, Rope.string (concat ["--", boundary, "--"]),
                    fn ({name, value}, rope) =>
                    let
                       val extra =
                          case value of
                             Value.File f => concat ["; filename=", dquote f]
                           | Value.String _ => ""
                    in
                       Rope.appends
                       [Rope.string
                        (concat
                         ["--", boundary, "\r\n",
                          "Content-Disposition: form-data; name=", dquote name,
                          extra, "\r\n\r\n"]),
                        Value.toRope value, Rope.string "\r\n", rope]
                    end))
             end
   end

(* ------------------------------------------------- *)
(*                       fetch                       *)
(* ------------------------------------------------- *)

structure Path = Url.Path

fun fetch {head: bool,
           headers: Header.t list,
           post: Post.t option,
           proxy: {host: string, port: int} option,
           url: Url.t}: In.t =
   let
      open Url
   in
      case url of
         Url.T {authority = SOME {user, host, port},
                fragment, path, query,
                scheme = SOME Scheme.Http} =>
         let
            val headers = Header.Host host :: headers
            val (method, headers, postit) =
               case post of
                  NONE =>
                     (if head then Method.Head else Method.Get,
                         headers,
                         fn _ => ())
                | SOME post =>
                     let
                        datatype z = datatype Post.Encoding.t
                        val ({contentType}, rope) = Post.encode post
                        val headers =
                           headers
                           @ [Header.ContentType contentType,
                              Header.ContentLength (Rope.size rope)]
                     in
                        (Method.Post, headers,
                         fn out => (Rope.output (rope, out)
                                    ; Out.output (out, "\r\n")))
                     end
            val (scheme, authority) =
               if Option.isSome proxy
                  then (SOME Scheme.Http,
                        SOME {user = NONE,
                              host = host,
                              port = port})
               else (NONE, NONE)
            val url =
               Url.T {scheme = scheme,
                      authority = authority,
                      path = path,
                      query = query,
                      fragment = NONE}
            val headers =
               case user of
                  NONE => headers
                | SOME user => Header.Authorization user :: headers
            val request =
               Request.T {method = method,
                          url = RequestUrl.Url url,
                          version = Version.v10,
                          headers = headers}
            val (ins, out) =
               Net.connect (case proxy of
                               NONE => {host = host,
                                        port = (case port of
                                                   NONE => 80
                                                 | SOME p => p)}
                             | SOME hp => hp)
            val print = Out.outputc out
            val () = Request.output (request, out)
            val () = postit out
            val () = Out.close out
         in ins
         end
              | _ => Error.bug (concat ["Htt.fetch: ", Url.toString url])
   end

val fetch =
   Trace.trace ("Http.fetch", fn {url, ...} => Url.layout url, Layout.ignore)
   fetch

(* ------------------------------------------------- *)
(*                      Status                       *)
(* ------------------------------------------------- *)

structure Status =
   struct
      datatype t =
         Accepted
       | BadGateway
       | BadRequest
       | Conflict
       | Continue
       | Created
       | ExpectationFailed
       | Extension of string
       | Forbidden
       | Found
       | GatewayTimeout
       | Gone
       | HTTPVersionNotSupported
       | InternalServerError
       | LengthRequired
       | MethodNotAllowed
       | MovedPermanently
       | MultipleChoices
       | NoContent
       | NonAuthoritativeInformation
       | NotAcceptable
       | NotFound
       | NotImplemented
       | NotModified
       | OK
       | PartialContent
       | PaymentRequired
       | PreconditionFailed
       | ProxyAuthenticationRequired
       | RequestEntityTooLarge
       | RequestTimeout
       | RequestUriTooLarge
       | RequestedRangeNotSatisfiable
       | ResetContent
       | SeeOther
       | ServiceUnavailable
       | SwitchingProtocols
       | TemporaryRedirect
       | Unauthorized
       | UnsupportedMediaType
       | UseProxy

      val all =
         [(Continue, "100", "Continue"),
          (SwitchingProtocols, "101", "Switching Protocols"),
          (OK, "200", "OK"),
          (Created, "201", "Created"),
          (Accepted, "202", "Accepted"),
          (NonAuthoritativeInformation, "203", "Non-Authoritative Information"),
          (NoContent, "204", "No Content"),
          (ResetContent, "205", "Reset Content"),
          (PartialContent, "206", "Partial Content"),
          (MultipleChoices, "300", "Multiple Choices"),
          (MovedPermanently, "301", "Moved Permanently"),
          (Found, "302", "Found"),
          (SeeOther, "303", "See Other"),
          (NotModified, "304", "Not Modified"),
          (UseProxy, "305", "Use Proxy"),
          (TemporaryRedirect, "307", "Temporary Redirect"),
          (BadRequest, "400", "Bad Request"),
          (Unauthorized, "401", "Unauthorized"),
          (PaymentRequired, "402", "Payment Required"),
          (Forbidden, "403", "Forbidden"),
          (NotFound, "404", "Not Found"),
          (MethodNotAllowed, "405", "Method Not Allowed"),
          (NotAcceptable, "406", "Not Acceptable"),
          (ProxyAuthenticationRequired, "407", "Proxy Authentication Required"),
          (RequestTimeout, "408", "Request Time-out"),
          (Conflict, "409", "Conflict"),
          (Gone, "410", "Gone"),
          (LengthRequired, "411", "Length Required"),
          (PreconditionFailed, "412", "Precondition Failed"),
          (RequestEntityTooLarge, "413", "Request Entity Too Large"),
          (RequestUriTooLarge, "414", "Request-URI Too Large"),
          (UnsupportedMediaType, "415", "Unsupported Media Type"),
          (RequestedRangeNotSatisfiable, "416",
           "Requested range not satisfiable"),
          (ExpectationFailed, "417", "Expectation Failed"),
          (InternalServerError, "500", "Internal Server Error"),
          (NotImplemented, "501", "Not Implemented"),
          (BadGateway, "502", "Bad Gateway"),
          (ServiceUnavailable, "503", "Service Unavailable"),
          (GatewayTimeout, "504", "Gateway Time-out"),
          (HTTPVersionNotSupported, "505", "HTTP Version not supported")]

      val all =
         List.revMap (all, fn (status, code, reason) =>
                      {status = status,
                       code = code,
                       reason = reason})

      fun fromString s =
         case List.peek (all, fn {code, ...} => s = code) of
            NONE => Extension s
          | SOME {status, ...} => status

      local
         fun make (ext, sel) (s: t) =
            case s of
               Extension c => ext c
             | _ => sel (valOf (List.peek (all, fn {status, ...} => s = status)))
      in
         val code = make (fn c => c, #code)
         val reason = make (fn _ => "Extension Status Code - No Reason",
                            #reason)
      end
   end

(* ------------------------------------------------- *)
(*                     Response                      *)
(* ------------------------------------------------- *)

structure Response =
   struct
      datatype t = T of {version: Version.t,
                         status: Status.t,
                         headers: Header.t list}

      val regexp = Regexp.responseLine

      fun toString (T {version, status, headers}) =
         concat ([Version.toString version, " ",
                  Status.code status, " ",
                  Status.reason status, "\r\n"]
                 @ Header.toStrings headers
                 @ ["\r\n"])

      val layout = Layout.str o toString

      fun output (r, out) = Out.output (out, toString r)

      fun input (ins: In.t): t Result.t =
         case In.inputLine ins of
            NONE => Result.No ""
          | SOME l => 
               let 
                  open Regexp
               in
                  case Compiled.matchAll (responseLine (), l) of
                     NONE => Result.No l
                   | SOME m => 
                        let
                           val {lookup, ...} = Match.stringFuns m
                           val version = Version.extract m
                           val status = Status.fromString (lookup status')
                        in
                           Result.map (Header.input ins, fn hs =>
                                       T {version = version,
                                          status = status,
                                          headers = hs})
                        end
               end
   end

end