module Network.HTTP.Conduit.Lens
(
method
, secure
, host
, port
, path
, queryString
, requestBody
, requestHeaders
, proxy
, hostAddress
, rawBody
, decompress
, redirectCount
, checkStatus
, responseTimeout
, cookieJar
, getConnectionWrapper
, AsHttpException(..)
, _StatusCodeException
, _InvalidUrlException
, _TooManyRedirects
, _UnparseableRedirect
, _TooManyRetries
, _HttpParserException
, _HandshakeFailed
, _OverlongHeaders
, _ResponseTimeout
, _FailedConnectionException
, _ExpectedBlankAfter100Continue
, _InvalidStatusLine
, _InvalidHeader
, _InternalIOException
, _ProxyConnectException
, _NoResponseDataReceived
, _TlsException
, _TlsNotSupported
, _ResponseBodyTooShort
, _InvalidChunkHeaders
, _IncompleteHeaders
) where
import Control.Applicative
import Control.Exception (SomeException, IOException)
import Control.Exception.Lens (exception)
import Control.Lens
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as Lazy
import Data.Word (Word64)
import qualified Network.HTTP.Conduit as H
import qualified Network.HTTP.Client.Internal as H
import qualified Network.HTTP.Types as H
import Network.Socket (HostAddress)
method :: Lens' H.Request H.Method
method f req = f (H.method req) <&> \m' -> req { H.method = m' }
secure :: Lens' H.Request Bool
secure f req = f (H.secure req) <&> \s' -> req { H.secure = s' }
host :: Lens' H.Request ByteString
host f req = f (H.host req) <&> \h' -> req { H.host = h' }
port :: Lens' H.Request Int
port f req = f (H.port req) <&> \p' -> req { H.port = p' }
path :: Lens' H.Request ByteString
path f req = f (H.path req) <&> \p' -> req { H.path = p' }
queryString :: Lens' H.Request ByteString
queryString f req = f (H.queryString req) <&> \qs' -> req { H.queryString = qs' }
requestBody :: Lens' H.Request H.RequestBody
requestBody f req = f (H.requestBody req) <&> \rb' -> req { H.requestBody = rb' }
requestHeaders :: Lens' H.Request H.RequestHeaders
requestHeaders f req = f (H.requestHeaders req) <&> \rh' -> req { H.requestHeaders = rh' }
proxy :: Lens' H.Request (Maybe H.Proxy)
proxy f req = f (H.proxy req) <&> \mp' -> req { H.proxy = mp' }
hostAddress :: Lens' H.Request (Maybe HostAddress)
hostAddress f req = f (H.hostAddress req) <&> \ha' -> req { H.hostAddress = ha' }
rawBody :: Lens' H.Request Bool
rawBody f req = f (H.rawBody req) <&> \b' -> req { H.rawBody = b' }
decompress :: Lens' H.Request (ByteString -> Bool)
decompress f req = f (H.decompress req) <&> \btb' -> req { H.decompress = btb' }
redirectCount :: Lens' H.Request Int
redirectCount f req = f (H.redirectCount req) <&> \rc' -> req { H.redirectCount = rc' }
checkStatus :: Lens' H.Request (H.Status -> H.ResponseHeaders -> H.CookieJar -> Maybe SomeException)
checkStatus f req = f (H.checkStatus req) <&> \cs' -> req { H.checkStatus = cs' }
responseTimeout :: Lens' H.Request (Maybe Int)
responseTimeout f req = f (H.responseTimeout req) <&> \rt' -> req { H.responseTimeout = rt' }
cookieJar :: Lens' H.Request (Maybe H.CookieJar)
cookieJar f req = f (H.cookieJar req) <&> \mcj' -> req { H.cookieJar = mcj' }
getConnectionWrapper
:: Lens' H.Request
( Maybe Int
-> H.HttpException
-> IO (H.ConnRelease, H.Connection, H.ManagedConn)
-> IO (Maybe Int, (H.ConnRelease, H.Connection, H.ManagedConn))
)
getConnectionWrapper f req =
f (H.getConnectionWrapper req) <&> \wat' -> req { H.getConnectionWrapper = wat' }
class AsHttpException p f t where
_HttpException :: Overloaded' p f t H.HttpException
instance AsHttpException p f H.HttpException where
_HttpException = id
instance (Choice p, Applicative f) => AsHttpException p f SomeException where
_HttpException = exception
_StatusCodeException
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t (H.Status, H.ResponseHeaders, H.CookieJar)
_StatusCodeException = _HttpException . prism' (uncurry3 H.StatusCodeException) go where
go (H.StatusCodeException s rh cj) = Just (s, rh, cj)
go _ = Nothing
_InvalidUrlException
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t (String, String)
_InvalidUrlException = _HttpException . prism' (uncurry H.InvalidUrlException) go where
go (H.InvalidUrlException s s') = Just (s, s')
go _ = Nothing
_TooManyRedirects
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t [H.Response Lazy.ByteString]
_TooManyRedirects = _HttpException . prism' H.TooManyRedirects go where
go (H.TooManyRedirects rs) = Just rs
go _ = Nothing
_UnparseableRedirect
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t (H.Response Lazy.ByteString)
_UnparseableRedirect = _HttpException . prism' H.UnparseableRedirect go where
go (H.UnparseableRedirect r) = Just r
go _ = Nothing
_TooManyRetries
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t ()
_TooManyRetries = _HttpException . prism' (const H.TooManyRetries) go where
go H.TooManyRetries = Just ()
go _ = Nothing
_HttpParserException
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t String
_HttpParserException = _HttpException . prism' H.HttpParserException go where
go (H.HttpParserException s) = Just s
go _ = Nothing
_HandshakeFailed
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t ()
_HandshakeFailed = _HttpException . prism' (const H.HandshakeFailed) go where
go H.HandshakeFailed = Just ()
go _ = Nothing
_OverlongHeaders
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t ()
_OverlongHeaders = _HttpException . prism' (const H.OverlongHeaders) go where
go H.OverlongHeaders = Just ()
go _ = Nothing
_ResponseTimeout
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t ()
_ResponseTimeout = _HttpException . prism' (const H.ResponseTimeout) go where
go H.ResponseTimeout = Just ()
go _ = Nothing
_FailedConnectionException
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t (String, Int)
_FailedConnectionException = _HttpException . prism' (uncurry H.FailedConnectionException) go where
go (H.FailedConnectionException s i) = Just (s, i)
go _ = Nothing
_ExpectedBlankAfter100Continue
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t ()
_ExpectedBlankAfter100Continue =
_HttpException . prism' (const H.ExpectedBlankAfter100Continue) go where
go H.ExpectedBlankAfter100Continue = Just ()
go _ = Nothing
_InvalidStatusLine
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t ByteString
_InvalidStatusLine = _HttpException . prism' H.InvalidStatusLine go where
go (H.InvalidStatusLine b) = Just b
go _ = Nothing
_InvalidHeader
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t ByteString
_InvalidHeader = _HttpException . prism' H.InvalidHeader go where
go (H.InvalidHeader b) = Just b
go _ = Nothing
_InternalIOException
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t IOException
_InternalIOException = _HttpException . prism' H.InternalIOException go where
go (H.InternalIOException ioe) = Just ioe
go _ = Nothing
_ProxyConnectException
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t (ByteString, Int, Either ByteString H.HttpException)
_ProxyConnectException = _HttpException . prism' (uncurry3 H.ProxyConnectException) go where
go (H.ProxyConnectException b i ebhe) = Just (b, i, ebhe)
go _ = Nothing
_NoResponseDataReceived
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t ()
_NoResponseDataReceived = _HttpException . prism' (const H.NoResponseDataReceived) go where
go H.NoResponseDataReceived = Just ()
go _ = Nothing
_TlsException
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t SomeException
_TlsException = _HttpException . prism' H.TlsException go where
go (H.TlsException se) = Just se
go _ = Nothing
_TlsNotSupported
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t ()
_TlsNotSupported = _HttpException . prism' (const H.TlsNotSupported) go where
go H.TlsNotSupported = Just ()
go _ = Nothing
_ResponseBodyTooShort
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t (Word64, Word64)
_ResponseBodyTooShort = _HttpException . prism' (uncurry H.ResponseBodyTooShort) go where
go (H.ResponseBodyTooShort w w') = Just (w, w')
go _ = Nothing
_InvalidChunkHeaders
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t ()
_InvalidChunkHeaders = _HttpException . prism' (const H.InvalidChunkHeaders) go where
go H.InvalidChunkHeaders = Just ()
go _ = Nothing
_IncompleteHeaders
:: (AsHttpException p f t, Choice p, Applicative f)
=> Overloaded' p f t ()
_IncompleteHeaders = _HttpException . prism' (const H.IncompleteHeaders) go where
go H.IncompleteHeaders = Just ()
go _ = Nothing
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 f (a, b, c) = f a b c