module Mongrel2.Response
       ( Response
       , buildResponse
       , mkResponse
       ) where

import Blaze.ByteString.Builder (Builder, toByteString, fromByteString)
import Blaze.Text.Int (integral)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 ()
import Data.List (intersperse)
import Data.Monoid
import Mongrel2.Types (ClientID, UUID)
import Network.HTTP.Types (Status(..), ResponseHeaders)
import qualified Data.ByteString as S
import qualified Data.CaseInsensitive as CI

-- | Raw response type.
type Response = ByteString

-- | Build a single space.
buildSpace :: Builder
buildSpace = fromByteString " "

-- | Build a UUID.
buildUUID :: UUID -> Builder
buildUUID = fromByteString

-- | Build a netstring from a builder.
buildNetstring :: Builder -> Builder
buildNetstring b =
  -- TODO: Is it possible to find the length without "forcing" the Builder?
  mconcat [ integral $ S.length s
          , fromByteString ":"
          , fromByteString s
          ]
  where
    s = toByteString b

-- | Build client ID list.
buildClientIDList :: [ClientID] -> Builder
buildClientIDList cids =
  mconcat $ intersperse buildSpace $ map integral cids

-- | Build a response from a server UUID, a list of
-- client IDs and a response body builder.
mkResponse :: UUID -> [ClientID] -> Builder -> Response
mkResponse uuid clientIDs bodyBuilder =
  toByteString $ mconcat [ buildUUID uuid
                         , buildSpace
                         , buildNetstring $ buildClientIDList clientIDs
                         , fromByteString ", "
                         , bodyBuilder ]

-- | Build a HTTP response.
buildResponse :: Status -> ResponseHeaders -> ByteString -> Builder
buildResponse status responseHeaders body =
  mconcat [ fromByteString "HTTP/1.1 "
          , integral $ statusCode status
          , fromByteString " "
          , fromByteString $ statusMessage status
          , crlf
          , mconcat $ map buildResponseHeader responseHeaders
          , crlf
          , fromByteString body
          ]
  where

    buildResponseHeader (name,value) =
      mconcat [ fromByteString $ CI.original name
              , fromByteString ": "
              , fromByteString value
              , crlf
              ]

    crlf = fromByteString "\r\n"