{-# LANGUAGE
    CPP
  , BangPatterns
  , FlexibleContexts
  , GeneralizedNewtypeDeriving
  , DoAndIfThenElse
  , OverloadedStrings
  , QuasiQuotes
  , RecordWildCards
  , UnicodeSyntax
  , ViewPatterns
  #-}
-- |This is the Resource Monad; monadic actions to define a behavior
-- of resource. The 'Rsrc' Monad is a kind of 'IO' Monad thus it
-- implements 'MonadIO' class, and it is a state machine as well.
-- 
-- Request Processing Flow:
--
--   1. A client issues an HTTP request.
--
--   2. If the URI of it matches to any resource, the corresponding
--      'Rsrc' Monad starts running on a newly spawned thread.
--
--   3. The 'Rsrc' Monad looks at request headers, find (or not find)
--      an entity, receive the request body (if any), send response
--      headers, and then send a response body. This process will be
--      discussed later.
--
--   4. The 'Rsrc' Monad and its thread stops running. The client may
--      or may not be sending us the next request at this point.
--
-- 'Rsrc' Monad takes the following states. The initial state is
-- /Examining Request/ and the final state is /Done/.
--
--   [/Examining Request/] In this state, a 'Rsrc' looks at the
--   request header fields and thinks about the corresponding entity
--   for it. If there is a suitable entity, the 'Rsrc' tells the
--   system an entity tag and its last modification time
--   ('foundEntity'). If it found no entity, it tells the system so
--   ('foundNoEntity'). In case it is impossible to decide the
--   existence of entity, which is a typical case for POST requests,
--   'Rsrc' does nothing in this state.
--
--   [/Receiving Body/] A 'Rsrc' asks the system to receive a request
--   body from the client. Before actually reading from the socket,
--   the system sends \"100 Continue\" to the client if need be. When
--   a 'Rsrc' transits to the next state without receiving all or part
--   of a request body, the system automatically discards it.
--
--   [/Deciding Header/] A 'Rsrc' makes a decision of response status
--   code and header fields. When it transits to the next state, the
--   system validates and completes the header fields and then sends
--   them to the client.
--
--   [/Sending Body/] In this state, a 'Rsrc' asks the system to write
--   some response body to the socket. When it transits to the next
--   state without writing any response body, the system automatically
--   completes it depending on the status code. (To be exact, such
--   completion only occurs when the 'Rsrc' transits to this state
--   without even declaring the \"Content-Type\" header field. See:
--   'setContentType')
--
--   [/Done/] Everything is over. A 'Rsrc' can do nothing for the HTTP
--   interaction anymore.
--
-- Note that the state transition is one-way: for instance, it is an
-- error to try to read a request body after writing some
-- response. This limitation is for efficiency. We don't want to read
-- the entire request before starting 'Rsrc', nor we don't want to
-- postpone writing the entire response till the end of 'Rsrc'
-- computation.
module Network.HTTP.Lucu.Resource
    (
    -- * Types
      Resource(..)
    , Rsrc
    , FormData(..)

    -- * Getting request header
    -- |These functions can be called regardless of the current state,
    -- and they don't change the state of 'Rsrc'.
    , getConfig
    , getRemoteAddr
    , getRemoteAddr'
    , getRemoteHost
#if defined(HAVE_SSL)
    , getRemoteCertificate
#endif
    , getRequest
    , getMethod
    , getRequestURI
    , getRequestVersion
    , getResourcePath
    , getPathInfo
    , getQueryForm
    , getHeader
    , getAccept
    , getAcceptEncoding
    , isEncodingAcceptable
    , getContentType
    , getAuthorization

    -- * Finding an entity
    -- |These functions can be called only in the /Examining Request/
    -- state. They make the 'Rsrc' transit to the /Receiving Body/
    -- state.
    , foundEntity
    , foundETag
    , foundTimeStamp
    , foundNoEntity
    , foundNoEntity'

    -- * Receiving a request body
    -- |These functions make the 'Rsrc' transit to the /Receiving
    -- Body/ state.
    , getChunk
    , getChunks
    , getForm

    -- * Declaring response status and header fields
    -- |These functions can be called at any time before transiting to
    -- the /Sending Body/ state, but they themselves never causes any
    -- state transitions.
    , setStatus
    , redirect
    , setContentType
    , setContentEncoding
    , setWWWAuthenticate

    -- ** Less frequently used functions
    , setLocation
    , setHeader
    , deleteHeader

    -- * Sending a response body

    -- |These functions make the 'Rsrc' transit to the /Sending Body/
    -- state.
    , putChunk
    , putChunks
    , putBuilder
    )
    where
import Blaze.ByteString.Builder (Builder)
import qualified Blaze.ByteString.Builder as BB
import qualified Blaze.ByteString.Builder.Internal as BB
import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Unicode
import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
import Data.Attempt
import qualified Data.Attoparsec.Char8 as P
import Data.ByteString (ByteString)
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
import Data.Collections
import Data.Convertible.Base
import Data.Convertible.Instances.Text ()
import Data.Convertible.Utils
import Data.Default
import Data.List (intersperse, sort)
import Data.Maybe
import Data.Monoid
import Data.Monoid.Unicode
import Data.Tagged
import Data.Text (Text)
import Data.Time
import Data.Time.Format.HTTP
import Network.HTTP.Lucu.Abortion
import Network.HTTP.Lucu.Authentication
import Network.HTTP.Lucu.Config
import Network.HTTP.Lucu.ContentCoding
import Network.HTTP.Lucu.ETag
import qualified Network.HTTP.Lucu.Headers as H
import Network.HTTP.Lucu.HttpVersion
import Network.HTTP.Lucu.Interaction
import Network.HTTP.Lucu.MultipartForm
import Network.HTTP.Lucu.Parser
import Network.HTTP.Lucu.Request
import Network.HTTP.Lucu.Resource.Internal
import Network.HTTP.Lucu.Response
import Network.HTTP.Lucu.Response.StatusCode
import Network.HTTP.Lucu.MIMEType
import Network.HTTP.Lucu.Utils
import Network.Socket hiding (accept)
import Network.URI hiding (path)
import Prelude hiding (any, drop, lookup, reverse)
import Prelude.Unicode

-- |Get the string representation of the address of remote host. If
-- you want a 'SockAddr' instead of 'HostName', use 'getRemoteAddr'.
getRemoteAddr'  Rsrc HostName
getRemoteAddr' = liftIO  toNM = getRemoteAddr
    where
      toNM  SockAddr  IO HostName
      toNM = (fromJust  fst <$>)  getNameInfo [NI_NUMERICHOST] True False

-- |Resolve an address to the remote host.
getRemoteHost  Rsrc (Maybe HostName)
getRemoteHost = liftIO  getHN = getRemoteAddr
    where
      getHN  SockAddr  IO (Maybe HostName)
      getHN = (fst <$>)  getNameInfo [] True False

-- |Get the 'Method' value of the request.
getMethod  Rsrc Method
getMethod = reqMethod <$> getRequest

-- |Get the URI of the request.
getRequestURI  Rsrc URI
getRequestURI = reqURI <$> getRequest

-- |Get the HTTP version of the request.
getRequestVersion  Rsrc HttpVersion
getRequestVersion = reqVersion <$> getRequest

-- |This is an analogy of CGI PATH_INFO. 'getPathInfo' always returns
-- @[]@ if the corresponding 'Resource' is not greedy. See
-- 'getResourcePath'.
--
-- Note that the returned path components are URI-decoded.
getPathInfo  Rsrc [Strict.ByteString]
getPathInfo = do rsrcPath  getResourcePath
                 reqPath   uriPathSegments <$> getRequestURI
                 return $ drop (length rsrcPath) reqPath

-- |Assume the query part of request URI as
-- application\/x-www-form-urlencoded, and parse it into pairs of
-- @(name, formData)@. This function doesn't read the request
-- body.
getQueryForm  Rsrc [(Strict.ByteString, FormData)]
getQueryForm = parse' <$> getRequestURI
    where
      parse' = map toPairWithFormData 
               parseWWWFormURLEncoded 
               convertUnsafe 
               drop 1 
               uriQuery

toPairWithFormData  (ByteString, ByteString)  (Strict.ByteString, FormData)
toPairWithFormData (name, value)
    = let fd = FormData {
                 fdFileName = Nothing
               , fdMIMEType = [mimeType| text/plain |]
               , fdContent  = Lazy.fromChunks [value]
               }
      in (name, fd)

-- |@'getHeader' name@ returns the value of the request header field
-- @name@. Comparison of header name is case-insensitive. Note that
-- this function is not intended to be used so frequently: there
-- should be functions like 'getContentType' for every common headers.
getHeader  CIAscii  Rsrc (Maybe Ascii)
getHeader name
    = H.getHeader name <$> getRequest

-- |Return the list of 'MIMEType' enumerated on the value of request
-- header \"Accept\", or @[]@ if absent.
getAccept  Rsrc [MIMEType]
getAccept
    = do acceptM  getHeader "Accept"
         case acceptM of
           Nothing
                return []
           Just accept
                case P.parseOnly (finishOff def) (cs accept) of
                    Right xs  return xs
                    Left  _   abort $ mkAbortion' BadRequest
                                     $ "Unparsable Accept: "  cs accept

-- |Return the list of @(contentCoding, qvalue)@ enumerated on the
-- value of request header \"Accept-Encoding\". The list is sorted in
-- descending order by qvalue.
getAcceptEncoding  Rsrc [(CIAscii, Maybe Double)]
getAcceptEncoding
    = do accEncM  getHeader "Accept-Encoding"
         case accEncM of
           Nothing
               -- HTTP/1.0 には Accept-Encoding が無い場合の規定が無い
               -- ので安全の爲 identity が指定された事にする。HTTP/1.1
               -- の場合は何でも受け入れて良い事になってゐるので "*" が
               -- 指定された事にする。
                do ver  getRequestVersion
                    case ver of
                      HttpVersion 1 0  return [("identity", Nothing)]
                      HttpVersion 1 1  return [("*"       , Nothing)]
                      _                abort $ mkAbortion' InternalServerError
                                                "getAcceptEncoding: unknown HTTP version"
           Just ae
                if ae  "" then
                      -- identity のみが許される。
                      return [("identity", Nothing)]
                 else
                     case P.parseOnly (finishOff def) (cs ae) of
                       Right xs  return $ map toTuple $ reverse $ sort xs
                       Left  _   abort $ mkAbortion' BadRequest
                                        $ "Unparsable Accept-Encoding: "  cs ae
    where
      toTuple (AcceptEncoding {..})
          = (aeEncoding, aeQValue)

-- |Return 'True' iff a given content-coding is acceptable by the
-- client.
isEncodingAcceptable  CIAscii  Rsrc Bool
isEncodingAcceptable encoding = any doesMatch <$> getAcceptEncoding
    where
      doesMatch  (CIAscii, Maybe Double)  Bool
      doesMatch (e, q) = (e  "*"  e  encoding)  q  Just 0

-- |Return the value of request header \"Content-Type\" as 'MIMEType'.
getContentType  Rsrc (Maybe MIMEType)
getContentType
    = do cTypeM  getHeader "Content-Type"
         case cTypeM of
           Nothing
                return Nothing
           Just cType
                case P.parseOnly (finishOff def) (cs cType) of
                    Right t  return $ Just t
                    Left  _  abort $ mkAbortion' BadRequest
                                    $ "Unparsable Content-Type: "  cs cType

-- |Return the value of request header \"Authorization\" as
-- 'AuthCredential'.
getAuthorization  Rsrc (Maybe AuthCredential)
getAuthorization
    = do authM  getHeader "Authorization"
         case authM of
           Nothing
                return Nothing
           Just auth
                case P.parseOnly (finishOff def) (cs auth) of
                    Right ac  return $ Just ac
                    Left  _   return Nothing

-- |Tell the system that the 'Rsrc' found an entity for the request
-- URI. If this is a GET or HEAD request, a found entity means a datum
-- to be replied. If this is a PUT or DELETE request, it means a datum
-- which was stored for the URI until now. For POST requests it raises
-- an error.
--
-- 'foundEntity' performs \"If-Match\" test or \"If-None-Match\" test
-- whenever possible, and if those tests fail, it immediately aborts
-- with status \"412 Precondition Failed\" or \"304 Not Modified\"
-- depending on the situation.
--
-- If the request method is either GET or HEAD, 'foundEntity'
-- automatically puts \"ETag\" and \"Last-Modified\" headers into the
-- response.
foundEntity  ETag  UTCTime  Rsrc ()
foundEntity tag timeStamp
    = do driftTo ExaminingRequest

         method  getMethod
         when (method  GET  method  HEAD)
             $ setHeader "Last-Modified"
             $ formatUTCTime timeStamp
         when (method  POST)
             $ abort
             $ mkAbortion' InternalServerError
               "foundEntity: this is a POST request."
         foundETag tag

         driftTo ReceivingBody

-- |Tell the system that the 'Rsrc' found an entity for the request
-- URI. The only difference from 'foundEntity' is that 'foundETag'
-- doesn't (nor can't) put \"Last-Modified\" header into the response.
--
-- Using this function is discouraged. You should use 'foundEntity'
-- whenever possible.
foundETag  ETag  Rsrc ()
foundETag tag
    = do driftTo ExaminingRequest
      
         method  getMethod
         when (method  GET  method  HEAD)
             $ setHeader "ETag"
             $ cs tag
         when (method  POST)
             $ abort
             $ mkAbortion' InternalServerError
               "Illegal computation of foundETag for POST request."

         -- If-Match があればそれを見る。
         ifMatch  getHeader "If-Match"
         case ifMatch of
           Nothing
                return ()
           Just value
                if value  "*" then
                      return ()
                  else
                      case P.parseOnly (finishOff def) (cs value) of
                        Right []
                             abort $ mkAbortion' BadRequest
                                    $ "Empty If-Match"
                        Right tags
                            -- tags の中に一致するものが無ければ
                            -- PreconditionFailed で終了。
                             when ((¬) (any ( tag) tags))
                                  $ abort
                                  $ mkAbortion' PreconditionFailed
                                  $ "The entity tag doesn't match: "  cs value
                        Left _
                             abort $ mkAbortion' BadRequest
                                    $ "Unparsable If-Match: "  cs value

         let statusForNoneMatch
                 = if method  GET  method  HEAD then
                       fromStatusCode NotModified
                   else
                       fromStatusCode PreconditionFailed

         -- If-None-Match があればそれを見る。
         ifNoneMatch  getHeader "If-None-Match"
         case ifNoneMatch of
           Nothing
                return ()
           Just value
                if value  "*" then
                      abort $ mkAbortion' statusForNoneMatch
                            $ "The entity tag matches: *"
                  else
                      case P.parseOnly (finishOff def) (cs value) of
                        Right []
                             abort $ mkAbortion' BadRequest
                                    $ "Empty If-None-Match"
                        Right tags
                             when (any ( tag) tags)
                                  $ abort
                                  $ mkAbortion' statusForNoneMatch
                                  $ "The entity tag matches: "  cs value
                        Left _
                             abort $ mkAbortion' BadRequest
                                    $ "Unparsable If-None-Match: "  cs value

         driftTo ReceivingBody

-- |Tell the system that the 'Rsrc' found an entity for the
-- request URI. The only difference from 'foundEntity' is that
-- 'foundTimeStamp' performs \"If-Modified-Since\" test or
-- \"If-Unmodified-Since\" test instead of \"If-Match\" test or
-- \"If-None-Match\" test. Be aware that any tests based on a last
-- modification time are unsafe because it is possible to mess up such
-- tests by modifying the entity twice in a second.
--
-- Using this function is discouraged. You should use 'foundEntity'
-- whenever possible.
foundTimeStamp  UTCTime  Rsrc ()
foundTimeStamp timeStamp
    = do driftTo ExaminingRequest

         method  getMethod
         when (method  GET  method  HEAD)
             $ setHeader "Last-Modified"
             $ formatUTCTime timeStamp
         when (method  POST)
             $ abort
             $ mkAbortion' InternalServerError
               "Illegal call of foundTimeStamp for POST request."

         let statusForIfModSince
                 = if method  GET  method  HEAD then
                       fromStatusCode NotModified
                   else
                       fromStatusCode PreconditionFailed

         ifModSince  getHeader "If-Modified-Since"
         case ifModSince of
           Just str  case untag' <$> (fromAttempt $ ca str) of
                         Just lastTime
                              when (timeStamp  lastTime)
                               $ abort
                               $ mkAbortion' statusForIfModSince
                               $ "The entity has not been modified since "  cs str
                         Nothing
                              abort $ mkAbortion' BadRequest
                                     $ "Malformed If-Modified-Since: "  cs str
           Nothing   return ()

         ifUnmodSince  getHeader "If-Unmodified-Since"
         case ifUnmodSince of
           Just str  case untag' <$> (fromAttempt $ ca str) of
                         Just lastTime
                              when (timeStamp > lastTime)
                               $ abort
                               $ mkAbortion' PreconditionFailed
                               $ "The entity has not been modified since "  cs str
                         Nothing
                              abort $ mkAbortion' BadRequest
                                     $ "Malformed If-Unmodified-Since: "  cs str
           Nothing   return ()

         driftTo ReceivingBody
    where
      untag'  Tagged HTTP α  α
      {-# INLINE untag' #-}
      untag' = untag

-- |@'foundNoEntity' mStr@ tells the system that the 'Rsrc' found no
-- entity for the request URI. @mStr@ is an optional error message to
-- be replied to the client.
--
-- If the request method is PUT, 'foundNoEntity' performs \"If-Match\"
-- test and when that fails it aborts with status \"412 Precondition
-- Failed\". If the request method is GET, HEAD, POST or DELETE,
-- 'foundNoEntity' always aborts with status \"404 Not Found\".
foundNoEntity  Maybe Text  Rsrc ()
foundNoEntity msgM
    = do driftTo ExaminingRequest

         method  getMethod
         when (method  PUT)
             $ abort
             $ mkAbortion NotFound [] msgM

         -- エンティティが存在しないと云ふ事は、"*" も含めたどのやうな
         -- If-Match: 條件も滿たさない。
         ifMatch  getHeader "If-Match"
         when (ifMatch  Nothing)
             $ abort
             $ mkAbortion PreconditionFailed [] msgM

         driftTo ReceivingBody

-- |'foundNoEntity'' is the same as @'foundNoEntity' 'Nothing'@.
foundNoEntity'  Rsrc ()
{-# INLINE foundNoEntity' #-}
foundNoEntity' = foundNoEntity Nothing

-- |@'getChunks' limit@ attemts to read the entire request body up to
-- @limit@ bytes, and then make the 'Rsrc' transit to the /Deciding
-- Header/ state. When the actual size of the body is larger than
-- @limit@ bytes, 'getChunks' immediately aborts with status \"413
-- Request Entity Too Large\". When the request has no body, it
-- returns an empty string.
--
-- When the @limit@ is 'Nothing', 'getChunks' uses the default
-- limitation value ('cnfMaxEntityLength') instead.
--
-- 'getChunks' returns a lazy 'Lazy.ByteString' but it's not really
-- lazy: reading from the socket just happens at the computation of
-- 'getChunks', not at the evaluation of the 'Lazy.ByteString'.
getChunks  Maybe Int  Rsrc Lazy.ByteString
getChunks (Just n)
    | n < 0     = fail ("getChunks: limit must not be negative: "  show n)
    | n  0     = return ()
    | otherwise = getChunks' n
getChunks Nothing
    = getConfig = getChunks  Just  cnfMaxEntityLength

getChunks'  Int  Rsrc Lazy.ByteString
getChunks' limit = go limit ()
    where
      go  Int  Builder  Rsrc Lazy.ByteString
      go  0  _ = do chunk  getChunk 1
                    if Strict.null chunk then
                        return ()
                    else
                        abort $ mkAbortion' RequestEntityTooLarge
                              $ "Request body must be smaller than "
                               cs (show limit)
                               " bytes."
      go !n !b = do c  getChunk $ min n BB.defaultBufferSize
                    if Strict.null c then
                        -- Got EOF
                        return $ BB.toLazyByteString b
                    else
                        do let n'  = n - Strict.length c
                               xs' = b  BB.fromByteString c
                           go n' xs'

-- |@'getForm' limit@ attempts to read the request body with
-- 'getChunks' and parse it as @application\/x-www-form-urlencoded@ or
-- @multipart\/form-data@. If the request header \"Content-Type\" is
-- neither of them, 'getForm' aborts with status \"415 Unsupported
-- Media Type\". If the request has no \"Content-Type\", it aborts
-- with \"400 Bad Request\".
--
-- Note that there are currently a few limitations on parsing
-- @multipart/form-data@. See: 'parseMultipartFormData'
getForm  Maybe Int  Rsrc [(Strict.ByteString, FormData)]
getForm limit
    = do cTypeM  getContentType
         case cTypeM of
           Nothing
                abort $ mkAbortion' BadRequest "Missing Content-Type"
           Just (MIMEType "application" "x-www-form-urlencoded" _)
                readWWWFormURLEncoded
           Just (MIMEType "multipart" "form-data" params)
                readMultipartFormData params
           Just cType
                abort $ mkAbortion' UnsupportedMediaType
                       $ cs
                       $ ("Unsupported media type: "  Ascii)
                        cs cType
    where
      readWWWFormURLEncoded
          = (map toPairWithFormData  parseWWWFormURLEncoded)
            <$>
            (bsToAscii = getChunks limit)

      bsToAscii bs
          = case convertAttemptVia (()  ByteString) bs of
              Success a  return a
              Failure e  abort $ mkAbortion' BadRequest $ cs (show e)

      readMultipartFormData m
          = case lookup "boundary" m of
              Nothing
                   abort $ mkAbortion' BadRequest "Missing boundary of multipart/form-data"
              Just boundary
                   do src  getChunks limit
                       b    case ca boundary of
                                Success b  return b
                                Failure _  abort $ mkAbortion' BadRequest
                                                  $ "Malformed boundary: "  boundary
                       case parseMultipartFormData b src of
                         Right xs  return $ map (first cs) xs
                         Left err  abort $ mkAbortion' BadRequest $ cs err

-- |@'redirect' code uri@ declares the response status as @code@ and
-- \"Location\" header field as @uri@. The @code@ must satisfy
-- 'isRedirection' or it raises an error.
redirect  StatusCode sc  sc  URI  Rsrc ()
redirect (fromStatusCode  sc) uri
    = do when (sc  cs NotModified  (¬) (isRedirection sc))
             $ abort
             $ mkAbortion' InternalServerError
             $ cs
             $ ("Attempted to redirect with status "  Ascii)
              cs sc
         setStatus sc
         setLocation uri

-- |@'setContentType' mType@ declares the response header
-- \"Content-Type\" as @mType@. Declaring \"Content-Type\" is
-- mandatory for sending a response body.
setContentType  MIMEType  Rsrc ()
setContentType = setHeader "Content-Type"  cs

-- |@'setLocation' uri@ declares the response header \"Location\" as
-- @uri@. You usually don't need to call this function directly.
setLocation  URI  Rsrc ()
setLocation uri
    = case ca uriStr of
        Success a  setHeader "Location" a
        Failure e  abort $ mkAbortion' InternalServerError
                          $ cs (show e)
    where
      uriStr = uriToString id uri ""

-- |@'setContentEncoding' codings@ declares the response header
-- \"Content-Encoding\" as @codings@.
setContentEncoding  [CIAscii]  Rsrc ()
setContentEncoding codings
    = do ver  getRequestVersion
         tr   case ver of
                  HttpVersion 1 0  return (toAB  unnormalizeCoding)
                  HttpVersion 1 1  return toAB
                  _                abort $ mkAbortion' InternalServerError
                                            "setContentEncoding: Unknown HTTP version"
         setHeader "Content-Encoding"
             $ cs
             $ mconcat
             $ intersperse (cs (", "  Ascii))
             $ map tr codings
    where
      toAB  ConvertSuccess α AsciiBuilder  α  AsciiBuilder
      toAB = cs

-- |@'setWWWAuthenticate' challenge@ declares the response header
-- \"WWW-Authenticate\" as @challenge@.
setWWWAuthenticate  AuthChallenge  Rsrc ()
setWWWAuthenticate = setHeader "WWW-Authenticate"  cs

-- |Write a chunk in 'Strict.ByteString' to the response body. You
-- must first declare the response header \"Content-Type\" before
-- applying this function. See 'setContentType'.
putChunk  Strict.ByteString  Rsrc ()
putChunk = putBuilder  BB.fromByteString

-- |Write a chunk in lazy 'Lazy.ByteString' to the response body. It
-- can be safely applied to an infinitely long 'Lazy.ByteString'.
--
-- Note that you must first declare the response header
-- \"Content-Type\" before applying this function. See
-- 'setContentType'.
putChunks  Lazy.ByteString  Rsrc ()
putChunks = putBuilder  BB.fromLazyByteString