{-# 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 :: HeaderName -> Traversal' (Response body) ByteString
responseHeader HeaderName
n = ([Header] -> f [Header]) -> Response body -> f (Response body)
forall body. Lens' (Response body) [Header]
responseHeaders (([Header] -> f [Header]) -> Response body -> f (Response body))
-> ((ByteString -> f ByteString) -> [Header] -> f [Header])
-> (ByteString -> f ByteString)
-> Response body
-> f (Response body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> IndexedTraversal' HeaderName [Header] ByteString
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 = ([(Text, Text)] -> f [(Text, Text)]) -> Options -> f Options
Lens' Options [(Text, Text)]
params (([(Text, Text)] -> f [(Text, Text)]) -> Options -> f Options)
-> (([Text] -> f [Text]) -> [(Text, Text)] -> f [(Text, Text)])
-> ([Text] -> f [Text])
-> Options
-> f Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Lens' [(Text, Text)] [Text]
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 = ([Header] -> f [Header]) -> Options -> f Options
Lens' Options [Header]
headers (([Header] -> f [Header]) -> Options -> f Options)
-> (([ByteString] -> f [ByteString]) -> [Header] -> f [Header])
-> ([ByteString] -> f [ByteString])
-> Options
-> f Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> Lens' [Header] [ByteString]
forall k a. Eq k => k -> Lens' [(k, a)] [a]
assoc2 HeaderName
n

_CookieJar :: Iso' HTTP.CookieJar [HTTP.Cookie]
_CookieJar :: p [Cookie] (f [Cookie]) -> p CookieJar (f CookieJar)
_CookieJar = (CookieJar -> [Cookie])
-> ([Cookie] -> CookieJar)
-> Iso CookieJar CookieJar [Cookie] [Cookie]
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 = (Maybe CookieJar -> f (Maybe CookieJar)) -> Options -> f Options
Lens' Options (Maybe CookieJar)
cookies ((Maybe CookieJar -> f (Maybe CookieJar)) -> Options -> f Options)
-> ((Cookie -> f Cookie) -> Maybe CookieJar -> f (Maybe CookieJar))
-> (Cookie -> f Cookie)
-> Options
-> f Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CookieJar -> f CookieJar)
-> Maybe CookieJar -> f (Maybe CookieJar)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((CookieJar -> f CookieJar)
 -> Maybe CookieJar -> f (Maybe CookieJar))
-> ((Cookie -> f Cookie) -> CookieJar -> f CookieJar)
-> (Cookie -> f Cookie)
-> Maybe CookieJar
-> f (Maybe CookieJar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Cookie] -> f [Cookie]) -> CookieJar -> f CookieJar
Iso CookieJar CookieJar [Cookie] [Cookie]
_CookieJar (([Cookie] -> f [Cookie]) -> CookieJar -> f CookieJar)
-> ((Cookie -> f Cookie) -> [Cookie] -> f [Cookie])
-> (Cookie -> f Cookie)
-> CookieJar
-> f CookieJar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cookie -> f Cookie) -> [Cookie] -> f [Cookie]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Cookie -> f Cookie) -> [Cookie] -> f [Cookie])
-> ((Cookie -> f Cookie) -> Cookie -> f Cookie)
-> (Cookie -> f Cookie)
-> [Cookie]
-> f [Cookie]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cookie -> Bool) -> (Cookie -> f Cookie) -> Cookie -> f Cookie
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 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
name)

responseCookie :: ByteString -> Fold (HTTP.Response body) HTTP.Cookie
responseCookie :: ByteString -> Fold (Response body) Cookie
responseCookie ByteString
name =
  (CookieJar -> f CookieJar) -> Response body -> f (Response body)
forall body. Lens' (Response body) CookieJar
responseCookieJar ((CookieJar -> f CookieJar) -> Response body -> f (Response body))
-> ((Cookie -> f Cookie) -> CookieJar -> f CookieJar)
-> (Cookie -> f Cookie)
-> Response body
-> f (Response body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CookieJar -> [Cookie]) -> Fold CookieJar Cookie
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding CookieJar -> [Cookie]
HTTP.destroyCookieJar ((Cookie -> f Cookie) -> CookieJar -> f CookieJar)
-> ((Cookie -> f Cookie) -> Cookie -> f Cookie)
-> (Cookie -> f Cookie)
-> CookieJar
-> f CookieJar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cookie -> Bool) -> (Cookie -> f Cookie) -> Cookie -> f Cookie
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered
  ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==ByteString
name) (ByteString -> Bool) -> (Cookie -> ByteString) -> Cookie -> Bool
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 :: ByteString -> ByteString -> Fold (Response body) Link
responseLink ByteString
name ByteString
val =
  HeaderName -> Traversal' (Response body) ByteString
forall body. HeaderName -> Traversal' (Response body) ByteString
responseHeader HeaderName
"Link" ((ByteString -> f ByteString)
 -> Response body -> f (Response body))
-> ((Link -> f Link) -> ByteString -> f ByteString)
-> (Link -> f Link)
-> Response body
-> f (Response body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [Link]) -> Fold ByteString Link
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding ByteString -> [Link]
links ((Link -> f Link) -> ByteString -> f ByteString)
-> ((Link -> f Link) -> Link -> f Link)
-> (Link -> f Link)
-> ByteString
-> f ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Link -> Bool) -> (Link -> f Link) -> Link -> f Link
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (Getting Any Link (ByteString, ByteString) -> Link -> Bool
forall s a. Getting Any s a -> s -> Bool
has (([(ByteString, ByteString)]
 -> Const Any [(ByteString, ByteString)])
-> Link -> Const Any Link
Lens' Link [(ByteString, ByteString)]
linkParams (([(ByteString, ByteString)]
  -> Const Any [(ByteString, ByteString)])
 -> Link -> Const Any Link)
-> (((ByteString, ByteString)
     -> Const Any (ByteString, ByteString))
    -> [(ByteString, ByteString)]
    -> Const Any [(ByteString, ByteString)])
-> Getting Any Link (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, ByteString) -> Const Any (ByteString, ByteString))
-> [(ByteString, ByteString)]
-> Const Any [(ByteString, ByteString)]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded (((ByteString, ByteString) -> Const Any (ByteString, ByteString))
 -> [(ByteString, ByteString)]
 -> Const Any [(ByteString, ByteString)])
-> (((ByteString, ByteString)
     -> Const Any (ByteString, ByteString))
    -> (ByteString, ByteString) -> Const Any (ByteString, ByteString))
-> ((ByteString, ByteString) -> Const Any (ByteString, ByteString))
-> [(ByteString, ByteString)]
-> Const Any [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, ByteString) -> Bool)
-> ((ByteString, ByteString) -> Const Any (ByteString, ByteString))
-> (ByteString, ByteString)
-> Const Any (ByteString, ByteString)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((ByteString, ByteString) -> (ByteString, ByteString) -> Bool
forall a. Eq a => a -> a -> Bool
== (ByteString
name,ByteString
val))))