{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, FlexibleInstances, GADTs,
    OverloadedStrings, RankNTypes, RecordWildCards, DefaultSignatures #-}

-- |
-- Module      : Network.Wreq.Internal.Types
-- Copyright   : (c) 2014 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- HTTP client types.

module Network.Wreq.Internal.Types
    (
    -- * Client configuration
      Options(..)
    , Mgr
    , Auth(..)
    , AWSAuthVersion(..)
    , ResponseChecker
    -- * Request payloads
    , Payload(..)
    , Postable(..)
    , Putable(..)
    -- ** URL-encoded forms
    , FormParam(..)
    , FormValue(..)
    -- * Headers
    , ContentType
    , Link(..)
    -- * Errors
    , JSONError(..)
    -- * Request types
    , Req(..)
    , reqURL
    -- * Sessions
    , Session(..)
    , Run
    , RunHistory
    , Body(..)
    -- * Caches
    , CacheEntry(..)
    ) where

import Control.Exception (Exception)
import Data.IORef (IORef)
import Data.Monoid ((<>), mconcat)
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.Typeable (Typeable)
import Network.HTTP.Client (CookieJar, Manager, ManagerSettings, Request,
                            RequestBody)
import Network.HTTP.Client.Internal (Response, Proxy)
import Network.HTTP.Types (Header)
import Prelude hiding (head)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy as L
import qualified Network.HTTP.Client as HTTP

-- | A MIME content type, e.g. @\"application/octet-stream\"@.
type ContentType = S.ByteString

type Mgr = Either ManagerSettings Manager

-- | Options for configuring a client.
data Options = Options {
    Options -> Mgr
manager :: Mgr
  -- ^ Either configuration for a 'Manager', or an actual 'Manager'.
  --
  -- If only 'ManagerSettings' are provided, then by default a new
  -- 'Manager' will be created for each request.
  --
  -- /Note/: when issuing HTTP requests using 'Options'-based
  -- functions from the the "Network.Wreq.Session" module
  -- ('Network.Wreq.Session.getWith', 'Network.Wreq.Session.putWith',
  -- etc.), this field will be ignored.
  --
  -- An example of using a specific manager:
  --
  -- @
  --import "Network.HTTP.Client" ('Network.HTTP.Client.withManager')
  --
  --'Network.HTTP.Client.withManager' $ \\mgr -> do
  --  let opts = 'Network.Wreq.defaults' { 'manager' = Right mgr }
  --  'Network.Wreq.getWith' opts \"http:\/\/httpbin.org\/get\"
  -- @
  --
  -- An example of changing settings (this will use a separate
  -- 'Manager' for every request, so make sense only if you're issuing
  -- a tiny handful of requets):
  --
  -- @
  --import "Network.HTTP.Client" ('Network.HTTP.Client.defaultManagerSettings')
  --
  --let settings = 'Network.HTTP.Client.defaultManagerSettings' { managerConnCount = 5 }
  --    opts = 'Network.Wreq.defaults' { 'manager' = Left settings }
  --'Network.Wreq.getWith' opts \"http:\/\/httpbin.org\/get\"
  -- @
  , Options -> Maybe Proxy
proxy :: Maybe Proxy
  -- ^ Host name and port for a proxy to use, if any.
  , Options -> Maybe Auth
auth :: Maybe Auth
  -- ^ Authentication information.
  --
  -- Example (note the use of TLS):
  --
  -- @
  --let opts = 'Network.Wreq.defaults' { 'auth' = 'Network.Wreq.basicAuth' \"user\" \"pass\" }
  --'Network.Wreq.getWith' opts \"https:\/\/httpbin.org\/basic-auth\/user\/pass\"
  -- @
  , Options -> [Header]
headers :: [Header]
  -- ^ Additional headers to send with each request.
  --
  -- @
  --let opts = 'Network.Wreq.defaults' { 'headers' = [(\"Accept\", \"*\/*\")] }
  --'Network.Wreq.getWith' opts \"http:\/\/httpbin.org\/get\"
  -- @
  , Options -> [(Text, Text)]
params :: [(Text, Text)]
  -- ^ Key-value pairs to assemble into a query string to add to the
  -- end of a URL.
  --
  -- For example, given:
  --
  -- @
  --let opts = 'Network.Wreq.defaults' { params = [(\"sort\", \"ascending\"), (\"key\", \"name\")] }
  --'Network.Wreq.getWith' opts \"http:\/\/httpbin.org\/get\"
  -- @
  --
  -- This will generate a URL of the form:
  --
  -- >http://httpbin.org/get?sort=ascending&key=name
  , Options -> Int
redirects :: Int
  -- ^ The maximum number of HTTP redirects to follow before giving up
  -- and throwing an exception.
  --
  -- In this example, a 'Network.HTTP.Client.HttpException' will be
  -- thrown with a 'Network.HTTP.Client.TooManyRedirects' constructor,
  -- because the maximum number of redirects allowed will be exceeded:
  --
  -- @
  --let opts = 'Network.Wreq.defaults' { 'redirects' = 3 }
  --'Network.Wreq.getWith' opts \"http:\/\/httpbin.org\/redirect/5\"
  -- @
  , Options -> Maybe CookieJar
cookies :: Maybe CookieJar
  -- ^ Cookies to set when issuing requests.
  --
  -- /Note/: when issuing HTTP requests using 'Options'-based
  -- functions from the the "Network.Wreq.Session" module
  -- ('Network.Wreq.Session.getWith', 'Network.Wreq.Session.putWith',
  -- etc.), this field will be used only for the /first/ HTTP request
  -- to be issued during a 'Network.Wreq.Session.Session'. Any changes
  -- changes made for subsequent requests will be ignored.
  , Options -> Maybe ResponseChecker
checkResponse :: Maybe ResponseChecker
  -- ^ Function that checks the status code and potentially returns an
  -- exception.
  --
  -- This defaults to 'Nothing', which will just use the default of
  -- 'Network.HTTP.Client.Request' which throws a 'StatusException' if
  -- the status is not 2XX.
  } deriving (Typeable)

-- | A function that checks the result of a HTTP request and
-- potentially returns an exception.
type ResponseChecker = Request -> Response HTTP.BodyReader -> IO ()

-- | Supported authentication types.
--
-- Do not use HTTP authentication unless you are using TLS encryption.
-- These authentication tokens can easily be captured and reused by an
-- attacker if transmitted in the clear.
data Auth = BasicAuth S.ByteString S.ByteString
            -- ^ Basic authentication. This consists of a plain
            -- username and password.
          | OAuth2Bearer S.ByteString
            -- ^ An OAuth2 bearer token. This is treated by many
            -- services as the equivalent of a username and password.
          | OAuth2Token S.ByteString
            -- ^ A not-quite-standard OAuth2 bearer token (that seems
            -- to be used only by GitHub). This is treated by whoever
            -- accepts it as the equivalent of a username and
            -- password.
          | AWSAuth AWSAuthVersion S.ByteString S.ByteString (Maybe S.ByteString)
            -- ^ Amazon Web Services request signing
            -- AWSAuthVersion key secret (optional: session-token)
          | AWSFullAuth AWSAuthVersion S.ByteString S.ByteString  (Maybe S.ByteString) (Maybe (S.ByteString, S.ByteString))
            -- ^ Amazon Web Services request signing
            -- AWSAuthVersion key secret Maybe (service, region)
          | OAuth1 S.ByteString S.ByteString S.ByteString S.ByteString
            -- ^ OAuth1 request signing
            -- OAuth1 consumerToken consumerSecret token secret
          deriving (Auth -> Auth -> Bool
(Auth -> Auth -> Bool) -> (Auth -> Auth -> Bool) -> Eq Auth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Auth -> Auth -> Bool
$c/= :: Auth -> Auth -> Bool
== :: Auth -> Auth -> Bool
$c== :: Auth -> Auth -> Bool
Eq, Int -> Auth -> ShowS
[Auth] -> ShowS
Auth -> String
(Int -> Auth -> ShowS)
-> (Auth -> String) -> ([Auth] -> ShowS) -> Show Auth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Auth] -> ShowS
$cshowList :: [Auth] -> ShowS
show :: Auth -> String
$cshow :: Auth -> String
showsPrec :: Int -> Auth -> ShowS
$cshowsPrec :: Int -> Auth -> ShowS
Show, Typeable)

data AWSAuthVersion = AWSv4
                      -- ^ AWS request signing version 4
                    deriving (AWSAuthVersion -> AWSAuthVersion -> Bool
(AWSAuthVersion -> AWSAuthVersion -> Bool)
-> (AWSAuthVersion -> AWSAuthVersion -> Bool) -> Eq AWSAuthVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AWSAuthVersion -> AWSAuthVersion -> Bool
$c/= :: AWSAuthVersion -> AWSAuthVersion -> Bool
== :: AWSAuthVersion -> AWSAuthVersion -> Bool
$c== :: AWSAuthVersion -> AWSAuthVersion -> Bool
Eq, Int -> AWSAuthVersion -> ShowS
[AWSAuthVersion] -> ShowS
AWSAuthVersion -> String
(Int -> AWSAuthVersion -> ShowS)
-> (AWSAuthVersion -> String)
-> ([AWSAuthVersion] -> ShowS)
-> Show AWSAuthVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AWSAuthVersion] -> ShowS
$cshowList :: [AWSAuthVersion] -> ShowS
show :: AWSAuthVersion -> String
$cshow :: AWSAuthVersion -> String
showsPrec :: Int -> AWSAuthVersion -> ShowS
$cshowsPrec :: Int -> AWSAuthVersion -> ShowS
Show)

instance Show Options where
  show :: Options -> String
show (Options{Int
[(Text, Text)]
[Header]
Maybe CookieJar
Maybe Proxy
Maybe Auth
Maybe ResponseChecker
Mgr
checkResponse :: Maybe ResponseChecker
cookies :: Maybe CookieJar
redirects :: Int
params :: [(Text, Text)]
headers :: [Header]
auth :: Maybe Auth
proxy :: Maybe Proxy
manager :: Mgr
checkResponse :: Options -> Maybe ResponseChecker
cookies :: Options -> Maybe CookieJar
redirects :: Options -> Int
params :: Options -> [(Text, Text)]
headers :: Options -> [Header]
auth :: Options -> Maybe Auth
proxy :: Options -> Maybe Proxy
manager :: Options -> Mgr
..}) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
      String
"Options { "
    , String
"manager = ", case Mgr
manager of
                      Left ManagerSettings
_  -> String
"Left _"
                      Right Manager
_ -> String
"Right _"
    , String
", proxy = ", Maybe Proxy -> String
forall a. Show a => a -> String
show Maybe Proxy
proxy
    , String
", auth = ", Maybe Auth -> String
forall a. Show a => a -> String
show Maybe Auth
auth
    , String
", headers = ", [Header] -> String
forall a. Show a => a -> String
show [Header]
headers
    , String
", params = ", [(Text, Text)] -> String
forall a. Show a => a -> String
show [(Text, Text)]
params
    , String
", redirects = ", Int -> String
forall a. Show a => a -> String
show Int
redirects
    , String
", cookies = ", Maybe CookieJar -> String
forall a. Show a => a -> String
show Maybe CookieJar
cookies
    , String
" }"
    ]

-- | A type that can be converted into a POST request payload.
class Postable a where
    postPayload :: a -> Request -> IO Request
    default postPayload :: Putable a => a -> Request -> IO Request
    postPayload = a -> Request -> IO Request
forall a. Putable a => a -> Request -> IO Request
putPayload
    -- ^ Represent a value in the request body (and perhaps the
    -- headers) of a POST request.

-- | A type that can be converted into a PUT request payload.
class Putable a where
    putPayload :: a -> Request -> IO Request
    -- ^ Represent a value in the request body (and perhaps the
    -- headers) of a PUT request.

-- | A product type for representing more complex payload types.
data Payload where
    Raw  :: ContentType -> RequestBody -> Payload
  deriving (Typeable)

-- | A type that can be rendered as the value portion of a key\/value
-- pair for use in an @application\/x-www-form-urlencoded@ POST
-- body. Intended for use with the 'FormParam' type.
--
-- The instances for 'String', strict 'Data.Text.Text', and lazy
-- 'Data.Text.Lazy.Text' are all encoded using UTF-8 before being
-- URL-encoded.
--
-- The instance for 'Maybe' gives an empty string on 'Nothing',
-- and otherwise uses the contained type's instance.
class FormValue a where
    renderFormValue :: a -> S.ByteString
    -- ^ Render the given value.

-- | A key\/value pair for an @application\/x-www-form-urlencoded@
-- POST request body.
data FormParam where
    (:=) :: (FormValue v) => S.ByteString -> v -> FormParam

instance Show FormParam where
    show :: FormParam -> String
show (ByteString
a := v
b) = ByteString -> String
forall a. Show a => a -> String
show ByteString
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" := " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (v -> ByteString
forall a. FormValue a => a -> ByteString
renderFormValue v
b)

infixr 3 :=

-- | The error type used by 'Network.Wreq.asJSON' and
-- 'Network.Wreq.asValue' if a failure occurs when parsing a response
-- body as JSON.
data JSONError = JSONError String
               deriving (Int -> JSONError -> ShowS
[JSONError] -> ShowS
JSONError -> String
(Int -> JSONError -> ShowS)
-> (JSONError -> String)
-> ([JSONError] -> ShowS)
-> Show JSONError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONError] -> ShowS
$cshowList :: [JSONError] -> ShowS
show :: JSONError -> String
$cshow :: JSONError -> String
showsPrec :: Int -> JSONError -> ShowS
$cshowsPrec :: Int -> JSONError -> ShowS
Show, Typeable)

instance Exception JSONError

-- | An element of a @Link@ header.
data Link = Link {
      Link -> ByteString
linkURL :: S.ByteString
    , Link -> [(ByteString, ByteString)]
linkParams :: [(S.ByteString, S.ByteString)]
    } deriving (Link -> Link -> Bool
(Link -> Link -> Bool) -> (Link -> Link -> Bool) -> Eq Link
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Link -> Link -> Bool
$c/= :: Link -> Link -> Bool
== :: Link -> Link -> Bool
$c== :: Link -> Link -> Bool
Eq, Int -> Link -> ShowS
[Link] -> ShowS
Link -> String
(Int -> Link -> ShowS)
-> (Link -> String) -> ([Link] -> ShowS) -> Show Link
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Link] -> ShowS
$cshowList :: [Link] -> ShowS
show :: Link -> String
$cshow :: Link -> String
showsPrec :: Int -> Link -> ShowS
$cshowsPrec :: Int -> Link -> ShowS
Show, Typeable)

-- | A request that is ready to be submitted.
data Req = Req Mgr Request

-- | Return the URL associated with the given 'Req'.
--
-- This includes the port number if not standard, and the query string
-- if one exists.
reqURL :: Req -> S.ByteString
reqURL :: Req -> ByteString
reqURL (Req Mgr
_ Request
req) = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [
    if Bool
https then ByteString
"https" else ByteString
"http"
  , ByteString
"://"
  , Request -> ByteString
HTTP.host Request
req
  , case (Request -> Int
HTTP.port Request
req, Bool
https) of
      (Int
80, Bool
False) -> ByteString
""
      (Int
443, Bool
True) -> ByteString
""
      (Int
p, Bool
_)      -> String -> ByteString
S.pack (Int -> String
forall a. Show a => a -> String
show Int
p)
  , Request -> ByteString
HTTP.path Request
req
  , case Request -> ByteString
HTTP.queryString Request
req of
      ByteString
qs | ByteString -> Bool
S.null ByteString
qs -> ByteString
""
         | Bool
otherwise -> ByteString
"?" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
qs
  ]
  where https :: Bool
https = Request -> Bool
HTTP.secure Request
req

-- | A function that runs a request and returns the associated
-- response.
type Run body = Req -> IO (Response body)

type RunHistory body = Req -> IO (HTTP.HistoriedResponse body)

-- | A session that spans multiple requests.  This is responsible for
-- cookie management and TCP connection reuse.
data Session = Session {
      Session -> Maybe (IORef CookieJar)
seshCookies :: Maybe (IORef CookieJar)
    , Session -> Manager
seshManager :: Manager
    , Session -> Session -> Run Body -> Run Body
seshRun :: Session -> Run Body -> Run Body
    , Session -> Session -> RunHistory Body -> RunHistory Body
seshRunHistory :: Session -> RunHistory Body -> RunHistory Body
    }

instance Show Session where
    show :: Session -> String
show Session
_ = String
"Session"

data CacheEntry body = CacheEntry {
    CacheEntry body -> UTCTime
entryCreated  :: UTCTime
  , CacheEntry body -> Maybe UTCTime
entryExpires  :: Maybe UTCTime
  , CacheEntry body -> Response body
entryResponse :: Response body
  } deriving (a -> CacheEntry b -> CacheEntry a
(a -> b) -> CacheEntry a -> CacheEntry b
(forall a b. (a -> b) -> CacheEntry a -> CacheEntry b)
-> (forall a b. a -> CacheEntry b -> CacheEntry a)
-> Functor CacheEntry
forall a b. a -> CacheEntry b -> CacheEntry a
forall a b. (a -> b) -> CacheEntry a -> CacheEntry b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CacheEntry b -> CacheEntry a
$c<$ :: forall a b. a -> CacheEntry b -> CacheEntry a
fmap :: (a -> b) -> CacheEntry a -> CacheEntry b
$cfmap :: forall a b. (a -> b) -> CacheEntry a -> CacheEntry b
Functor)

data Body = NoBody
          | StringBody L.ByteString
          | ReaderBody HTTP.BodyReader

instance Show (CacheEntry body) where
    show :: CacheEntry body -> String
show CacheEntry body
_ = String
"CacheEntry"