content: {-# 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
  