--
-- Copyright 2018, akashche at redhat.com
--
-- Licensed 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.
--
-- |
-- HTTP utilities for server (WAI) and client
--

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}

module VtUtils.HTTP
    ( httpContentTypeJSON
    , httpRequestPath
    , httpRequestBodyText
    , httpRequestBodyJSON
    , httpRequestHeaders
    , httpRequestHeadersMap
    -- client
    , httpResponseBody
    , httpResponseBodyText
    , httpResponseBodyJSON
    , httpResponseHeaders
    , httpResponseHeadersMap
    ) where

import Prelude (Either(..), Int, IO, String, (.), ($), (>=), (<$>), fromIntegral, error, return)
import Control.Monad (when)
import Data.Aeson (FromJSON, eitherDecode)
import Data.CaseInsensitive (original)
import Data.HashMap.Strict (HashMap)
import Data.Monoid ((<>))
import Data.Text (Text, pack, unpack)
import Data.Text.Encoding (decodeUtf8)
import Data.Vector (Vector)
import Network.HTTP.Client (BodyReader, Response, brReadSome, responseBody, responseHeaders)
import Network.HTTP.Types (Header)
import Network.Wai (Request, lazyRequestBody, rawPathInfo, requestHeaders, strictRequestBody)
import qualified Data.ByteString.Lazy as ByteStringLazy
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Vector as Vector

import VtUtils.Text

uncase :: Header -> (Text, Text)
uncase (name, val) = ((decodeUtf8 . original) name, (decodeUtf8 val))

-- | @Content-Type@ header for @application/json@ type
--
httpContentTypeJSON :: Header
httpContentTypeJSON = ("Content-Type", "application/json")

-- | URL path string of the specified HTTP request
--
-- Arguments:
--
--    * @req :: Request@: HTTP request
--
-- Return value: URL path string
--
httpRequestPath :: Request -> Text
httpRequestPath = decodeUtf8 . rawPathInfo

-- | Reads a body of the specified HTTP request as a @Text@ string
--
-- Arguments:
--
--    * @req :: Request@: HTTP request
--
-- Return value: Request body as a @Text@ string
--
httpRequestBodyText :: Request -> IO Text
httpRequestBodyText req = (decodeUtf8 . ByteStringLazy.toStrict) <$> strictRequestBody req

-- | Reads a body of the specified HTTP request and parses it as a JSON value
--
-- Data type should be specified with a type annotation:
--
-- Example:
--
-- >
-- > dt <- httpRequestBodyJSON req :: IO Foo
-- >
--
-- Data must be an instance of [FromJSON](https://hackage.haskell.org/package/aeson-1.4.2.0/docs/Data-Aeson.html#t:FromJSON)
--
-- Arguments:
--
--    * @req :: Request@: HTTP request
--
-- Return value: Request body parsed as a JSON value
--
httpRequestBodyJSON :: forall a . FromJSON a => Request -> IO a
httpRequestBodyJSON req = do
    bs <- lazyRequestBody req
    case eitherDecode bs :: Either String a of
        Left err -> error . unpack $
               "JSON decoding error,"
            <> " message: [" <> pack err <> "]"
        Right res -> return res

-- | Headers of the specified HTTP request as a @Vector@ of @(name, value)@ pairs
--
-- Arguments:
--
--    * @req :: Request@: HTTP request
--
-- Return value: Request headers as a @Vector@ of @(name, value)@ pairs
--
httpRequestHeaders :: Request -> Vector (Text, Text)
httpRequestHeaders req = Vector.fromList (uncase <$> requestHeaders req)

-- | Headers of the specified HTTP request as a @name -> value@ map
--
-- Arguments:
--
--    * @req :: Request@: HTTP request
--
-- Return value: Request headers as a @name -> value@ map
--
httpRequestHeadersMap :: Request -> HashMap Text Text
httpRequestHeadersMap req = HashMap.fromList (uncase <$> requestHeaders req)

-- | Read a body of HTTP response as a lazy @ByteString@
--
-- Arguments:
--
--    * @label :: Text@: Label used for error reporting on overly-large responses
--    * @resp :: Response BodyReader@: HTTP response
--    * @threshold :: Int@ Max response body length in bytes
--
-- Return value: Response body as a lazy @ByteString@
--
httpResponseBody :: Text -> Response BodyReader -> Int -> IO ByteStringLazy.ByteString
httpResponseBody label resp threshold = do
    let reader = responseBody resp
    lbs <- brReadSome reader threshold
    let read = (ByteStringLazy.length lbs)
    when (read >= (fromIntegral threshold)) $ error . unpack $
           "HTTP response size threshold exceeded,"
        <> " threshold: [" <> (textShow threshold) <> "],"
        <> " read: [" <> (textShow read) <> "],"
        <> " label: [" <> label <> "]"
    return lbs

-- | Read a body of HTTP response as a @Text@ string
--
-- Arguments:
--
--    * @label :: Text@: Label used for error reporting on overly-large responses
--    * @resp :: Response BodyReader@: HTTP response
--    * @threshold :: Int@ Max response body length in bytes
--
-- Return value: Response body as a @Text@ string
--
httpResponseBodyText :: Text -> Response BodyReader -> Int -> IO Text
httpResponseBodyText label resp threshold = do
    lbs <- httpResponseBody label resp threshold
    let tx = decodeUtf8 (ByteStringLazy.toStrict lbs)
    return tx

-- | Read a body of HTTP response as a JSON value
--
-- Data type should be specified with a type annotation:
--
-- Example:
--
-- >
-- > dt <- httpResponseBodyJSON label resp 1024 :: IO Foo
-- >
--
-- Data must be an instance of [FromJSON](https://hackage.haskell.org/package/aeson-1.4.2.0/docs/Data-Aeson.html#t:FromJSON)
--
-- Arguments:
--
--    * @label :: Text@: Label used for error reporting on overly-large responses
--    * @resp :: Response BodyReader@: HTTP response
--    * @threshold :: Int@ Max response body length in bytes
--
-- Return value: Response body as a JSON value
--
httpResponseBodyJSON :: forall a . FromJSON a => Text -> Response BodyReader -> Int -> IO a
httpResponseBodyJSON label resp threshold = do
    bs <- httpResponseBody label resp threshold
    case eitherDecode bs :: Either String a of
        Left err -> error . unpack $
               "JSON decoding error,"
            <> " json: [" <> ((decodeUtf8 . ByteStringLazy.toStrict) (ByteStringLazy.take 1024 bs)) <> "],"
            <> " message: [" <> pack err <> "],"
            <> " label: [" <> label <> "]"
        Right res -> return res

-- | Headers of the specified HTTP response as a @Vector@ of @(name, value)@ pairs
--
-- Arguments:
--
--    * @req :: Response@: HTTP request
--
-- Return value: Response headers as a @Vector@ of @(name, value)@ pairs
--
httpResponseHeaders :: Response a -> Vector (Text, Text)
httpResponseHeaders resp = Vector.fromList (uncase <$> responseHeaders resp)

-- | Headers of the specified HTTP response as a @name -> value@ map
--
-- Arguments:
--
--    * @req :: Response@: HTTP request
--
-- Return value: Response headers as a @name -> value@ map
--
httpResponseHeadersMap :: Response a -> HashMap Text Text
httpResponseHeadersMap resp = HashMap.fromList (uncase <$> responseHeaders resp)