content: {-# LANGUAGE
      CPP
    , FlexibleInstances
    , OverloadedStrings
    , UndecidableInstances
    #-}
  
  #include "overlapping-compat.h"
  
  module Rest.Client.Internal
    ( module Control.Monad
    , module Data.String
    , module Data.String.ToString
    , MonadIO (..)
    , L.ByteString
    , intercalate
    , URI.encode
  
    , module Rest.Client.Base
    , ShowUrl (..)
    , hAccept
    , hContentType
  
    , ApiRequest(..)
    , doRequest
    , parseResult
    , fromJSON
    , toJSON
    , fromXML
    , toXML
    , toLbs
  
    , makeReq
    , doReq
    ) where
  
  import Control.Arrow
  import Control.Monad
  import Control.Monad.Cont
  import Data.Aeson.Utils (FromJSON, ToJSON, eitherDecodeV, encode)
  #if !MIN_VERSION_http_client(0,5,0)
  import Data.Default (def)
  #endif
  import Data.List
  import Data.String
  import Data.String.ToString
  import Network.HTTP.Conduit hiding (method, responseBody, responseHeaders)
  import Network.HTTP.Types hiding (statusCode, statusMessage)
  import Rest.Types.Error
  import Rest.Types.ShowUrl
  import Text.XML.HXT.Arrow.Pickle
  import qualified Data.ByteString.Char8     as CH
  import qualified Data.ByteString.Lazy      as L
  import qualified Data.ByteString.Lazy.UTF8 as L
  import qualified Network.HTTP.Conduit      as HTTP
  import qualified Network.HTTP.Types        as HTTP
  import qualified Network.HTTP.Types.Header
  import qualified Network.URI.Encode        as URI
  import qualified Text.Xml.Pickle           as P
  
  import Rest.Client.Base
  
  {-# ANN module ("HLint: ignore Use import/export shortcut"::String) #-}
  
  data ApiRequest = ApiRequest
    { method         :: String
    , uri            :: String
    , params         :: [(String, String)]
    , requestHeaders :: RequestHeaders
    , requestBody    :: L.ByteString
    }
  
  convertResponse :: Response (Either (Reason e) a) -> ApiResponse e a
  convertResponse r =
    ApiResponse
     { statusCode      = HTTP.statusCode (responseStatus r)
     , statusMessage   = HTTP.statusMessage (responseStatus r)
     , httpVersion     = (httpMajor &&& httpMinor) (responseVersion r)
     , responseHeaders = HTTP.responseHeaders r
     , responseBody    = HTTP.responseBody r
     }
  
  #if MIN_VERSION_http_client(0,5,0)
  defaultTimeout :: ResponseTimeout
  defaultTimeout = responseTimeoutMicro (1000 * 1000 * 60 * 5)
  #else
  defaultTimeout :: Maybe Int
  defaultTimeout = Just (1000 * 1000 * 60 * 5)
  #endif
  
  splitHost :: String -> (String, String)
  splitHost = break (== '/')
  
  doRequest :: ApiStateC m => (L.ByteString -> Rest.Types.Error.Reason e) -> (L.ByteString -> a) -> ApiRequest -> m (ApiResponse e a)
  doRequest a b = fmap (parseResult a b) . doReq
  
  doReq :: ApiStateC m => ApiRequest -> m (Response L.ByteString)
  doReq (ApiRequest m ur ps rhds bd) =
    do mn  <- fmap manager askApiInfo
       hst <- fmap apiHost askApiInfo
       prt <- fmap apiPort askApiInfo
       hds <- fmap headers askApiInfo
       jar <- fmap cookies getApiState
       let (h, p) = splitHost hst
  #if MIN_VERSION_http_client(0,5,0)
           req = defaultRequest
  #else
           req = def
  #endif
                  { HTTP.method = CH.pack m
                  , host = CH.pack h
                  , port = prt
                  , path = CH.pack (p ++ "/" ++ ur)
                  , queryString = (renderQuery False . simpleQueryToQuery . Prelude.map (CH.pack *** CH.pack)) ps
                  , HTTP.requestHeaders = rhds ++ Prelude.map (fromString *** CH.pack) hds
                  , HTTP.requestBody = RequestBodyLBS bd
  #if !MIN_VERSION_http_client(0,5,0)
                  , checkStatus = \_ _ _ -> Nothing
  #endif
                  , redirectCount = 0
                  , responseTimeout = defaultTimeout
                  , cookieJar = Just jar
                  }
       res <- httpLbs req mn
       putApiState (ApiState (jar `mappend` responseCookieJar res))
       return res
  
  parseResult :: (L.ByteString -> Reason e) -> (L.ByteString -> a) -> Response L.ByteString -> ApiResponse e a
  parseResult e c res = convertResponse $
    case HTTP.statusCode (HTTP.responseStatus res) of
      200 -> fmap (Right . c) res
      _   -> fmap (Left . e) res
  
  fromJSON :: FromJSON a => L.ByteString -> a
  fromJSON v = (either err id . eitherDecodeV) v
    where
      err e = error (  "Error parsing JSON in api binding, this should not happen: got "
                    ++ L.toString v
                    ++ ", message: "
                    ++ show e
                    )
  
  toJSON :: ToJSON a => a -> L.ByteString
  toJSON = encode
  
  toLbs :: String -> L.ByteString
  toLbs = L.fromString
  
  class XmlStringToType a where
    fromXML :: L.ByteString -> a
    toXML :: a -> L.ByteString
  
  instance XmlStringToType String where
    fromXML = L.toString
    toXML = L.fromString
  
  instance OVERLAPPABLE_ XmlPickler a => XmlStringToType a where
    fromXML v = ( either err id
                . P.eitherFromXML
                . L.toString
                ) v
      where err = error ("Error parsing XML in api binding, this should not happen: " ++ L.toString v)
    toXML = L.fromString . P.toXML
  
  
  makeReq :: String -> String -> [[String]] -> [(String, String)] -> Network.HTTP.Types.Header.RequestHeaders -> L.ByteString -> ApiRequest
  makeReq meth v ls = ApiRequest meth (intercalate "/" (v : map URI.encode (concat ls)))
  