    -- Explicitly disabling due to external code {-# LANGUAGE NoImplicitPrelude #-}

    {-# LANGUAGE FlexibleContexts    #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {-# LANGUAGE RankNTypes          #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    -- Adapted from `hackage-security-http-client` to use our own

    -- `Pantry.HTTP` implementation

    module Hackage.Security.Client.Repository.HttpLib.HttpClient
      ( httpLib
      ) where

    import           Control.Exception
    import           Control.Monad ( void )
    import           Data.ByteString ( ByteString )
    import qualified Data.ByteString as BS
    import qualified Data.ByteString.Char8 as BS.C8
    import           Hackage.Security.Client hiding ( Header )
    import           Hackage.Security.Client.Repository.HttpLib
    import           Hackage.Security.Util.Checked
    import           Network.URI
    import qualified Pantry.HTTP as HTTP

    {-------------------------------------------------------------------------------
      Top-level API
    -------------------------------------------------------------------------------}

    -- | An 'HttpLib' value using the default global manager

    httpLib :: HttpLib
    httpLib :: HttpLib
    httpLib = HttpLib
      { httpGet :: forall a.
    Throws SomeRemoteError =>
    [HttpRequestHeader]
    -> URI -> ([HttpResponseHeader] -> BodyReader -> IO a) -> IO a
    httpGet      = [HttpRequestHeader]
    -> URI -> ([HttpResponseHeader] -> BodyReader -> IO a) -> IO a
    forall a.
    Throws SomeRemoteError =>
    [HttpRequestHeader]
    -> URI -> ([HttpResponseHeader] -> BodyReader -> IO a) -> IO a
    get
      , httpGetRange :: forall a.
    Throws SomeRemoteError =>
    [HttpRequestHeader]
    -> URI
    -> (Int, Int)
    -> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a)
    -> IO a
    httpGetRange = [HttpRequestHeader]
    -> URI
    -> (Int, Int)
    -> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a)
    -> IO a
    forall a.
    Throws SomeRemoteError =>
    [HttpRequestHeader]
    -> URI
    -> (Int, Int)
    -> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a)
    -> IO a
    getRange
      }

    {-------------------------------------------------------------------------------
      Individual methods
    -------------------------------------------------------------------------------}

    get ::
         Throws SomeRemoteError
      => [HttpRequestHeader] -> URI
      -> ([HttpResponseHeader] -> BodyReader -> IO a)
      -> IO a
    get :: forall a.
    Throws SomeRemoteError =>
    [HttpRequestHeader]
    -> URI -> ([HttpResponseHeader] -> BodyReader -> IO a) -> IO a
    get [HttpRequestHeader]
    reqHeaders URI
    uri [HttpResponseHeader] -> BodyReader -> IO a
    callback = (Throws HttpException => IO a) -> Throws SomeRemoteError => IO a
    forall a.
    (Throws HttpException => IO a) -> Throws SomeRemoteError => IO a
    wrapCustomEx ((Throws HttpException => IO a) -> Throws SomeRemoteError => IO a)
    -> (Throws HttpException => IO a) -> Throws SomeRemoteError => IO a
    forall a b. (a -> b) -> a -> b
    $ do
      -- TODO: setUri fails under certain circumstances; in particular, when

      -- the URI contains URL auth. Not sure if this is a concern.

      Request
    request' <- Request -> URI -> IO Request
    forall (m :: * -> *). MonadThrow m => Request -> URI -> m Request
    HTTP.setUri Request
    HTTP.defaultRequest URI
    uri
      let request :: Request
    request = [HttpRequestHeader] -> Request -> Request
    setRequestHeaders [HttpRequestHeader]
    reqHeaders Request
    request'
      IO a -> IO a
    forall a. Throws HttpException => IO a -> IO a
    checkHttpException (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ Request -> (Response BodyReader -> IO a) -> IO a
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    Request -> (Response BodyReader -> m a) -> m a
    HTTP.withResponse Request
    request ((Response BodyReader -> IO a) -> IO a)
    -> (Response BodyReader -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \Response BodyReader
    response -> do
        let br :: BodyReader
    br = (Throws HttpException => BodyReader)
    -> Throws SomeRemoteError => BodyReader
    forall a.
    (Throws HttpException => IO a) -> Throws SomeRemoteError => IO a
    wrapCustomEx ((Throws HttpException => BodyReader)
     -> Throws SomeRemoteError => BodyReader)
    -> (Throws HttpException => BodyReader)
    -> Throws SomeRemoteError => BodyReader
    forall a b. (a -> b) -> a -> b
    $ Response BodyReader -> BodyReader
    forall a. Response a -> a
    HTTP.getResponseBody Response BodyReader
    response
        [HttpResponseHeader] -> BodyReader -> IO a
    callback (Response BodyReader -> [HttpResponseHeader]
    forall a. Response a -> [HttpResponseHeader]
    getResponseHeaders Response BodyReader
    response) BodyReader
    br

    getRange ::
         Throws SomeRemoteError
      => [HttpRequestHeader]
      -> URI
      -> (Int, Int)
      -> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a)
      -> IO a
    getRange :: forall a.
    Throws SomeRemoteError =>
    [HttpRequestHeader]
    -> URI
    -> (Int, Int)
    -> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a)
    -> IO a
    getRange [HttpRequestHeader]
    reqHeaders URI
    uri (Int
    from, Int
    to) HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a
    callback = (Throws HttpException => IO a) -> Throws SomeRemoteError => IO a
    forall a.
    (Throws HttpException => IO a) -> Throws SomeRemoteError => IO a
    wrapCustomEx ((Throws HttpException => IO a) -> Throws SomeRemoteError => IO a)
    -> (Throws HttpException => IO a) -> Throws SomeRemoteError => IO a
    forall a b. (a -> b) -> a -> b
    $ do
      Request
    request' <- Request -> URI -> IO Request
    forall (m :: * -> *). MonadThrow m => Request -> URI -> m Request
    HTTP.setUri Request
    HTTP.defaultRequest URI
    uri
      let request :: Request
    request = Int -> Int -> Request -> Request
    setRange Int
    from Int
    to
                  (Request -> Request) -> Request -> Request
    forall a b. (a -> b) -> a -> b
    $ [HttpRequestHeader] -> Request -> Request
    setRequestHeaders [HttpRequestHeader]
    reqHeaders Request
    request'
      IO a -> IO a
    forall a. Throws HttpException => IO a -> IO a
    checkHttpException (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ Request -> (Response BodyReader -> IO a) -> IO a
    forall (m :: * -> *) a.
    MonadUnliftIO m =>
    Request -> (Response BodyReader -> m a) -> m a
    HTTP.withResponse Request
    request ((Response BodyReader -> IO a) -> IO a)
    -> (Response BodyReader -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \Response BodyReader
    response -> do
        let br :: BodyReader
    br = (Throws HttpException => BodyReader)
    -> Throws SomeRemoteError => BodyReader
    forall a.
    (Throws HttpException => IO a) -> Throws SomeRemoteError => IO a
    wrapCustomEx ((Throws HttpException => BodyReader)
     -> Throws SomeRemoteError => BodyReader)
    -> (Throws HttpException => BodyReader)
    -> Throws SomeRemoteError => BodyReader
    forall a b. (a -> b) -> a -> b
    $ Response BodyReader -> BodyReader
    forall a. Response a -> a
    HTTP.getResponseBody Response BodyReader
    response
        case () of
          () | Response BodyReader -> Status
    forall a. Response a -> Status
    HTTP.getResponseStatus Response BodyReader
    response Status -> Status -> Bool
    forall a. Eq a => a -> a -> Bool
    == Status
    HTTP.partialContent206 ->
            HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a
    callback HttpStatus
    HttpStatus206PartialContent (Response BodyReader -> [HttpResponseHeader]
    forall a. Response a -> [HttpResponseHeader]
    getResponseHeaders Response BodyReader
    response) BodyReader
    br
          () | Response BodyReader -> Status
    forall a. Response a -> Status
    HTTP.getResponseStatus Response BodyReader
    response Status -> Status -> Bool
    forall a. Eq a => a -> a -> Bool
    == Status
    HTTP.ok200 ->
            HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a
    callback HttpStatus
    HttpStatus200OK (Response BodyReader -> [HttpResponseHeader]
    forall a. Response a -> [HttpResponseHeader]
    getResponseHeaders Response BodyReader
    response) BodyReader
    br
          ()
    _otherwise ->
            HttpException -> IO a
    forall e a. (Exception e, Throws e) => e -> IO a
    throwChecked (HttpException -> IO a) -> HttpException -> IO a
    forall a b. (a -> b) -> a -> b
    $ Request -> HttpExceptionContent -> HttpException
    HTTP.HttpExceptionRequest Request
    request
                         (HttpExceptionContent -> HttpException)
    -> HttpExceptionContent -> HttpException
    forall a b. (a -> b) -> a -> b
    $ Response () -> ByteString -> HttpExceptionContent
    HTTP.StatusCodeException (Response BodyReader -> Response ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void Response BodyReader
    response) ByteString
    ""

    -- | Wrap custom exceptions

    --

    -- NOTE: The only other exception defined in @http-client@ is @TimeoutTriggered@

    -- but it is currently disabled <https://github.com/snoyberg/http-client/issues/116>

    wrapCustomEx ::
         (Throws HTTP.HttpException => IO a)
      -> (Throws SomeRemoteError => IO a)
    wrapCustomEx :: forall a.
    (Throws HttpException => IO a) -> Throws SomeRemoteError => IO a
    wrapCustomEx = (HttpException -> IO a) -> (Throws HttpException => IO a) -> IO a
    forall e a.
    Exception e =>
    (e -> IO a) -> (Throws e => IO a) -> IO a
    handleChecked (\(HttpException
    ex :: HTTP.HttpException) -> HttpException -> IO a
    forall {e} {a}. Exception e => e -> IO a
    go HttpException
    ex)
     where
      go :: e -> IO a
    go e
    ex = SomeRemoteError -> IO a
    forall e a. (Exception e, Throws e) => e -> IO a
    throwChecked (e -> SomeRemoteError
    forall e. Exception e => e -> SomeRemoteError
    SomeRemoteError e
    ex)

    checkHttpException :: Throws HTTP.HttpException => IO a -> IO a
    checkHttpException :: forall a. Throws HttpException => IO a -> IO a
    checkHttpException = (HttpException -> IO a) -> IO a -> IO a
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    handle ((HttpException -> IO a) -> IO a -> IO a)
    -> (HttpException -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ \(HttpException
    ex :: HTTP.HttpException) ->
                           HttpException -> IO a
    forall e a. (Exception e, Throws e) => e -> IO a
    throwChecked HttpException
    ex

    {-------------------------------------------------------------------------------
      http-client auxiliary
    -------------------------------------------------------------------------------}

    hAcceptRanges :: HTTP.HeaderName
    hAcceptRanges :: HeaderName
    hAcceptRanges = HeaderName
    "Accept-Ranges"

    hAcceptEncoding :: HTTP.HeaderName
    hAcceptEncoding :: HeaderName
    hAcceptEncoding = HeaderName
    "Accept-Encoding"

    setRange ::
         Int
      -> Int
      -> HTTP.Request
      -> HTTP.Request
    setRange :: Int -> Int -> Request -> Request
    setRange Int
    from Int
    to =
      HeaderName -> ByteString -> Request -> Request
    HTTP.addRequestHeader HeaderName
    HTTP.hRange ByteString
    rangeHeader
     where
      -- Content-Range header uses inclusive rather than exclusive bounds

      -- See <http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html>

      rangeHeader :: ByteString
    rangeHeader = [Char] -> ByteString
    BS.C8.pack ([Char] -> ByteString) -> [Char] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "bytes=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    from [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "-" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show (Int
    to Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)

    -- | Set request headers

    setRequestHeaders ::
         [HttpRequestHeader]
      -> HTTP.Request
      -> HTTP.Request
    setRequestHeaders :: [HttpRequestHeader] -> Request -> Request
    setRequestHeaders [HttpRequestHeader]
    opts =
      [Header] -> Request -> Request
    setRequestHeaders' ([(HeaderName, [ByteString])] -> [HttpRequestHeader] -> [Header]
    trOpt [(HeaderName, [ByteString])]
    disallowCompressionByDefault [HttpRequestHeader]
    opts)
     where
      setRequestHeaders' :: [HTTP.Header] -> HTTP.Request -> HTTP.Request
      setRequestHeaders' :: [Header] -> Request -> Request
    setRequestHeaders' =
        (Header -> (Request -> Request) -> Request -> Request)
    -> (Request -> Request) -> [Header] -> Request -> Request
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\(HeaderName
    name, ByteString
    val) Request -> Request
    f -> Request -> Request
    f (Request -> Request) -> (Request -> Request) -> Request -> Request
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HeaderName -> [ByteString] -> Request -> Request
    HTTP.setRequestHeader HeaderName
    name [ByteString
    val]) Request -> Request
    forall a. a -> a
    id

      trOpt ::
           [(HTTP.HeaderName, [ByteString])]
        -> [HttpRequestHeader]
        -> [HTTP.Header]
      trOpt :: [(HeaderName, [ByteString])] -> [HttpRequestHeader] -> [Header]
    trOpt [(HeaderName, [ByteString])]
    acc [] =
        ((HeaderName, [ByteString]) -> Header)
    -> [(HeaderName, [ByteString])] -> [Header]
    forall a b. (a -> b) -> [a] -> [b]
    map (HeaderName, [ByteString]) -> Header
    finalizeHeader [(HeaderName, [ByteString])]
    acc
      trOpt [(HeaderName, [ByteString])]
    acc (HttpRequestHeader
    HttpRequestMaxAge0:[HttpRequestHeader]
    os) =
        [(HeaderName, [ByteString])] -> [HttpRequestHeader] -> [Header]
    trOpt (HeaderName
    -> [ByteString]
    -> [(HeaderName, [ByteString])]
    -> [(HeaderName, [ByteString])]
    forall a b. Eq a => a -> [b] -> [(a, [b])] -> [(a, [b])]
    insert HeaderName
    HTTP.hCacheControl [ByteString
    "max-age=0"] [(HeaderName, [ByteString])]
    acc) [HttpRequestHeader]
    os
      trOpt [(HeaderName, [ByteString])]
    acc (HttpRequestHeader
    HttpRequestNoTransform:[HttpRequestHeader]
    os) =
        [(HeaderName, [ByteString])] -> [HttpRequestHeader] -> [Header]
    trOpt (HeaderName
    -> [ByteString]
    -> [(HeaderName, [ByteString])]
    -> [(HeaderName, [ByteString])]
    forall a b. Eq a => a -> [b] -> [(a, [b])] -> [(a, [b])]
    insert HeaderName
    HTTP.hCacheControl [ByteString
    "no-transform"] [(HeaderName, [ByteString])]
    acc) [HttpRequestHeader]
    os

      -- disable content compression (potential security issue)

      disallowCompressionByDefault :: [(HTTP.HeaderName, [ByteString])]
      disallowCompressionByDefault :: [(HeaderName, [ByteString])]
    disallowCompressionByDefault = [(HeaderName
    hAcceptEncoding, [])]

      -- Some headers are comma-separated, others need multiple headers for

      -- multiple options.

      --

      -- TODO: Right we we just comma-separate all of them.

      finalizeHeader ::
           (HTTP.HeaderName, [ByteString])
        -> HTTP.Header
      finalizeHeader :: (HeaderName, [ByteString]) -> Header
    finalizeHeader (HeaderName
    name, [ByteString]
    strs) = (HeaderName
    name, ByteString -> [ByteString] -> ByteString
    BS.intercalate ByteString
    ", " ([ByteString] -> [ByteString]
    forall a. [a] -> [a]
    reverse [ByteString]
    strs))

      insert :: Eq a => a -> [b] -> [(a, [b])] -> [(a, [b])]
      insert :: forall a b. Eq a => a -> [b] -> [(a, [b])] -> [(a, [b])]
    insert a
    _ [b]
    _ [] = []
      insert a
    x [b]
    y ((a
    k, [b]
    v):[(a, [b])]
    pairs)
        | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    k = (a
    k, [b]
    v [b] -> [b] -> [b]
    forall a. [a] -> [a] -> [a]
    ++ [b]
    y) (a, [b]) -> [(a, [b])] -> [(a, [b])]
    forall a. a -> [a] -> [a]
    : a -> [b] -> [(a, [b])] -> [(a, [b])]
    forall a b. Eq a => a -> [b] -> [(a, [b])] -> [(a, [b])]
    insert a
    x [b]
    y [(a, [b])]
    pairs
        | Bool
    otherwise = (a
    k, [b]
    v) (a, [b]) -> [(a, [b])] -> [(a, [b])]
    forall a. a -> [a] -> [a]
    : a -> [b] -> [(a, [b])] -> [(a, [b])]
    forall a b. Eq a => a -> [b] -> [(a, [b])] -> [(a, [b])]
    insert a
    x [b]
    y [(a, [b])]
    pairs

    -- | Extract the response headers

    getResponseHeaders :: HTTP.Response a -> [HttpResponseHeader]
    getResponseHeaders :: forall a. Response a -> [HttpResponseHeader]
    getResponseHeaders Response a
    response =
      [ HttpResponseHeader
    HttpResponseAcceptRangesBytes | (HeaderName
    hAcceptRanges, ByteString
    "bytes") Header -> [Header] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Header]
    headers ]
     where
      headers :: [Header]
    headers = Response a -> [Header]
    forall a. Response a -> [Header]
    HTTP.getResponseHeaders Response a
    response