{-# LANGUAGE CPP, OverloadedStrings #-}
{- |
Module      :  ./Common/Http.hs
Description :  wrapper for simple http
Copyright   :  (c) Christian Maeder 2013
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  non-portable (uses package HTTP)

-}

module Common.Http where

import Driver.Options

#ifdef NO_WGET
import Control.Exception (try)
import qualified Data.ByteString.Lazy.Char8 as LChar8
import qualified Data.ByteString.Char8 as Char8
import qualified Data.CaseInsensitive as CI (mk)
import Data.Char (isSpace)
import Network.Connection (TLSSettings(..))
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Network.HTTP.Types (statusCode)
#else
import Common.Utils
import System.Exit
#endif

loadFromUri :: HetcatsOpts -> String -> IO (Either String String)
#ifdef NO_WGET
loadFromUri opts uri = do
  manager <-
    if disableCertificateVerification opts
    then newManager noVerifyTlsManagerSettings
    else newManager tlsManagerSettings
  initialRequest <- parseRequest uri
  let additionalHeaders =
        map ((\ (header, value) ->
               (CI.mk $ Char8.pack header,
                Char8.pack $ dropWhile isSpace $ tail value)) .
             break (== ':')) $ httpRequestHeaders opts
  let request = initialRequest
        { requestHeaders = ("Accept", "*/*; q=0.1, text/plain")
                             : additionalHeaders }
  eResponse <- try $ httpLbs request manager
  case eResponse of
    Left err ->
      case err :: HttpException of
        HttpExceptionRequest _ exceptionContent ->
          return $ Left
            ("Failed to load " ++ show uri ++ ": " ++ show exceptionContent)
        InvalidUrlException invalidUrl reason ->
          return $ Left ("Failed to load " ++ show invalidUrl ++ ": " ++ reason)
    Right response ->
      let status = statusCode $ responseStatus response in
      return $ if 400 <= status
               then Left ("Failed to load " ++ show uri ++ ": HTTP status code "
                          ++ show status)
               else Right $ LChar8.unpack $ responseBody response

noVerifyTlsManagerSettings :: ManagerSettings
noVerifyTlsManagerSettings = mkManagerSettings noVerifyTlsSettings Nothing

noVerifyTlsSettings :: TLSSettings
noVerifyTlsSettings =
  TLSSettingsSimple { settingDisableCertificateValidation = True
                    , settingDisableSession = True
                    , settingUseServerName = False
                    }
#else
loadFromUri opts str = do
  let args = if disableCertificateVerification opts
             then ["--no-check-certificate"]
             else []
  (code, out, err) <- executeProcess "wget"
     (args ++ ["--header=Accept: */*; q=0.1, text/plain", "-O", "-", str]) ""
  return $ case code of
    ExitSuccess -> Right out
    _ -> Left err
#endif
