module Magicbane.HTTPClient (
module Magicbane.HTTPClient
, module X
) where
import ClassyPrelude
import Control.Monad.Trans.Either
import Data.Has
import Data.Conduit
import qualified Data.Conduit.Combinators as C
import Data.String.Conversions
import Network.URI as X
import Network.HTTP.Types
import Network.HTTP.Conduit as HC
import Network.HTTP.Client.Conduit as HCC
import Network.HTTP.Client.Internal (setUri)
import Network.HTTP.Client as X hiding (Proxy, path)
import Network.HTTP.Client.TLS (newTlsManager)
import Magicbane.Util (writeForm)
newtype ModHttpClient = ModHttpClient Manager
instance (Has ModHttpClient α) ⇒ HasHttpManager α where
getHttpManager = (\(ModHttpClient m) → m) <$> getter
newHttpClient ∷ IO ModHttpClient
newHttpClient = ModHttpClient <$> newTlsManager
type MonadHTTP ψ μ = (HasHttpManager ψ, MonadReader ψ μ, MonadIO μ, MonadBaseControl IO μ)
runHTTP ∷ EitherT ε μ α → μ (Either ε α)
runHTTP = runEitherT
reqU ∷ (MonadHTTP ψ μ) ⇒ URI → EitherT Text μ Request
reqU uri = hoistEither $ bimap tshow id $ setUri defaultRequest uri
reqS ∷ (MonadHTTP ψ μ, ConvertibleStrings σ String) ⇒ σ → EitherT Text μ Request
reqS uri = hoistEither $ bimap tshow id $ parseUrlThrow $ cs uri
anyStatus ∷ (MonadHTTP ψ μ) ⇒ Request → EitherT Text μ Request
anyStatus req = return $ setRequestIgnoreStatus req
postForm ∷ (MonadHTTP ψ μ) ⇒ [(Text, Text)] → Request → EitherT Text μ Request
postForm form req =
return req { method = "POST"
, requestHeaders = [ (hContentType, "application/x-www-form-urlencoded; charset=utf-8") ]
, requestBody = RequestBodyBS $ writeForm form }
performWithFn ∷ (MonadHTTP ψ μ, MonadCatch μ) ⇒ (ConduitM ι ByteString μ () → μ ρ) → Request → EitherT Text μ (Response ρ)
performWithFn fn req = do
res ← lift $ tryAny $ HCC.withResponse req $ \res → do
body ← fn $ responseBody res
return res { responseBody = body }
hoistEither $ bimap tshow id res
performWithVoid ∷ (MonadHTTP ψ μ, MonadCatch μ) ⇒ Request → EitherT Text μ (Response ())
performWithVoid = performWithFn (const $ return ())
performWithBytes ∷ (MonadHTTP ψ μ, MonadCatch μ) ⇒ Request → EitherT Text μ (Response LByteString)
performWithBytes = performWithFn ($$ C.sinkLazy)