content: {-# LANGUAGE FlexibleInstances #-}
  --
  -- Licensed to the Apache Software Foundation (ASF) under one
  -- or more contributor license agreements. See the NOTICE file
  -- distributed with this work for additional information
  -- regarding copyright ownership. The ASF licenses this file
  -- to you under the Apache License, Version 2.0 (the
  -- "License"); you may not use this file except in compliance
  -- with the License. You may obtain a copy of the License at
  --
  --   http://www.apache.org/licenses/LICENSE-2.0
  --
  -- Unless required by applicable law or agreed to in writing,
  -- software distributed under the License is distributed on an
  -- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
  -- KIND, either express or implied. See the License for the
  -- specific language governing permissions and limitations
  -- under the License.
  --
  
  module Thrift.Transport.HttpClient
      ( module Thrift.Transport
      , HttpClient (..)
      , openHttpClient
  ) where
  
  import Thrift.Transport
  import Thrift.Transport.IOBuffer
  import Network.URI
  import Network.HTTP hiding (port, host)
  
  import Data.Maybe (fromJust)
  import Data.Monoid (mempty)
  import Control.Exception (throw)
  import qualified Data.ByteString.Lazy as LBS
  
  
  -- | 'HttpClient', or THttpClient implements the Thrift Transport
  -- | Layer over http or https.
  data HttpClient =
      HttpClient {
        hstream :: HandleStream LBS.ByteString,
        uri :: URI,
        writeBuffer :: WriteBuffer,
        readBuffer :: ReadBuffer
      }
  
  uriAuth :: URI -> URIAuth
  uriAuth = fromJust . uriAuthority
  
  host :: URI -> String
  host = uriRegName . uriAuth
  
  port :: URI -> Int
  port uri_ =
      if portStr == mempty then
          httpPort
      else
          read portStr
      where
        portStr = dropWhile (== ':') $ uriPort $ uriAuth uri_
        httpPort = 80
  
  -- | Use 'openHttpClient' to create an HttpClient connected to @uri@
  openHttpClient :: URI -> IO HttpClient
  openHttpClient uri_ = do
    stream <- openTCPConnection (host uri_) (port uri_)
    wbuf <- newWriteBuffer
    rbuf <- newReadBuffer
    return $ HttpClient stream uri_ wbuf rbuf
  
  instance Transport HttpClient where
  
      tClose = close . hstream
  
      tPeek = peekBuf . readBuffer
  
      tRead = readBuf . readBuffer
  
      tWrite = writeBuf . writeBuffer
  
      tFlush hclient = do
        body <- flushBuf $ writeBuffer hclient
        let request = Request {
                        rqURI = uri hclient,
                        rqHeaders = [
                         mkHeader HdrContentType "application/x-thrift",
                         mkHeader HdrContentLength $  show $ LBS.length body],
                        rqMethod = POST,
                        rqBody = body
                      }
  
        res <- sendHTTP (hstream hclient) request
        case res of
          Right response ->
            fillBuf (readBuffer hclient) (rspBody response)
          Left _ ->
              throw $ TransportExn "THttpConnection: HTTP failure from server" TE_UNKNOWN
        return ()
  
      tIsOpen _ = return True
  