{-# LANGUAGE FlexibleContexts, OverloadedStrings, RankNTypes,
    TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

module Network.Wreq.Lens.TH
    (
      Types.Options
    , manager
    , proxy
    , auth
    , header
    , headers
    , param
    , params
    , redirects
    , cookie
    , cookies
    , checkResponse

    , HTTP.Cookie
    , cookieName
    , cookieValue
    , cookieExpiryTime
    , cookieDomain
    , cookiePath
    , cookieCreationTime
    , cookieLastAccessTime
    , cookiePersistent
    , cookieHostOnly
    , cookieSecureOnly
    , cookieHttpOnly

    , HTTP.Proxy
    , proxyHost
    , proxyPort

    , HTTP.Response
    , responseStatus
    , responseVersion
    , responseHeader
    , responseHeaders
    , responseLink
    , responseBody
    , responseCookie
    , responseCookieJar
    , responseClose'

    , HTTP.HistoriedResponse
    , hrFinalResponse
    , hrFinalRequest
    , hrRedirects

    , HTTP.Status
    , statusCode
    , statusMessage

    , Types.Link
    , linkURL
    , linkParams

    , Form.PartM
    , partName
    , partFilename
    , partContentType
    , partGetBody
    , partHeaders
    ) where

import Control.Lens hiding (makeLenses)
import Data.ByteString (ByteString)
import Data.Text (Text)
import Network.Wreq.Internal.Lens (assoc, assoc2)
import Network.Wreq.Internal.Link
import Network.Wreq.Lens.Machinery (fieldName, makeLenses, toCamelCase)
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.MultipartFormData as Form
import qualified Network.HTTP.Types.Header as HTTP
import qualified Network.HTTP.Types.Status as HTTP
import qualified Network.Wreq.Types as Types

makeLenses ''Types.Options
makeLensesWith (lensRules & lensField .~ fieldName toCamelCase) ''HTTP.Cookie
makeLenses ''HTTP.Proxy
makeLenses ''HTTP.Response
makeLenses ''HTTP.HistoriedResponse
makeLenses ''HTTP.Status
makeLenses ''Types.Link
makeLenses ''Form.PartM

responseHeader :: HTTP.HeaderName -> Traversal' (HTTP.Response body) ByteString
responseHeader :: forall body. HeaderName -> Traversal' (Response body) ByteString
responseHeader HeaderName
n = forall body. Lens' (Response body) [Header]
responseHeaders forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Eq k => k -> IndexedTraversal' k [(k, a)] a
assoc HeaderName
n

param :: Text -> Lens' Types.Options [Text]
param :: Text -> Lens' Options [Text]
param Text
n = Lens' Options [(Text, Text)]
params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Eq k => k -> Lens' [(k, a)] [a]
assoc2 Text
n

header :: HTTP.HeaderName -> Lens' Types.Options [ByteString]
header :: HeaderName -> Lens' Options [ByteString]
header HeaderName
n = Lens' Options [Header]
headers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Eq k => k -> Lens' [(k, a)] [a]
assoc2 HeaderName
n

_CookieJar :: Iso' HTTP.CookieJar [HTTP.Cookie]
_CookieJar :: Iso' CookieJar [Cookie]
_CookieJar = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso CookieJar -> [Cookie]
HTTP.destroyCookieJar [Cookie] -> CookieJar
HTTP.createCookieJar

-- N.B. This is an "illegal" traversal because we can change its cookie_name.
cookie :: ByteString -> Traversal' Types.Options HTTP.Cookie
cookie :: ByteString -> Traversal' Options Cookie
cookie ByteString
name = Lens' Options (Maybe CookieJar)
cookies forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso' CookieJar [Cookie]
_CookieJar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered
              (\Cookie
c -> Cookie -> ByteString
HTTP.cookie_name Cookie
c forall a. Eq a => a -> a -> Bool
== ByteString
name)

responseCookie :: ByteString -> Fold (HTTP.Response body) HTTP.Cookie
responseCookie :: forall body. ByteString -> Fold (Response body) Cookie
responseCookie ByteString
name =
  forall body. Lens' (Response body) CookieJar
responseCookieJar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding CookieJar -> [Cookie]
HTTP.destroyCookieJar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered
  ((forall a. Eq a => a -> a -> Bool
==ByteString
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cookie -> ByteString
HTTP.cookie_name)

responseLink :: ByteString -> ByteString -> Fold (HTTP.Response body) Types.Link
responseLink :: forall body. ByteString -> ByteString -> Fold (Response body) Link
responseLink ByteString
name ByteString
val =
  forall body. HeaderName -> Traversal' (Response body) ByteString
responseHeader HeaderName
"Link" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding ByteString -> [Link]
links forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (forall s a. Getting Any s a -> s -> Bool
has (Lens' Link [(ByteString, ByteString)]
linkParams forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (forall a. Eq a => a -> a -> Bool
== (ByteString
name,ByteString
val))))