Safe Haskell | None |
---|---|
Language | GHC2021 |
Polysemy.Http
Description
Synopsis
- data Http c (a :: Type -> Type) b
- request :: forall c (r :: EffectRow). Member (Http c) r => Request -> Sem r (Either HttpError (Response LByteString))
- response :: forall c (r :: EffectRow) a. Member (Http c) r => Request -> (Response c -> Sem r a) -> Sem r (Either HttpError a)
- interpretHttpNative :: forall (r :: EffectRow). Members '[Embed IO, Log, Resource] r => InterpreterFor (Http BodyReader) r
- interpretHttpPure :: forall (r :: EffectRow). Member (Embed IO) r => [Response LByteString] -> [ByteString] -> InterpretersFor '[Http LByteString, State [Response LByteString] :: (Type -> Type) -> Type -> Type, State [ByteString] :: (Type -> Type) -> Type -> Type] r
- newtype Path = Path {}
- data Method
- newtype Body = Body {
- unBody :: ByteString
- data Request = Request Method Host (Maybe Port) Tls Path [(HeaderName, HeaderValue)] CookieJar [(QueryKey, Maybe QueryValue)] Body
- newtype Host = Host {}
- newtype Port = Port {}
- newtype QueryKey = QueryKey {
- unQueryKey :: Text
- newtype QueryValue = QueryValue {
- unQueryValue :: Text
- newtype Tls = Tls {}
- pattern Success :: Status -> b -> [Header] -> Response b
- pattern Info :: Status -> b -> [Header] -> Response b
- data Response b = Response Status b [Header] CookieJar
- pattern Client :: Status -> b -> [Header] -> Response b
- pattern Redirect :: Status -> b -> [Header] -> Response b
- pattern Server :: Status -> b -> [Header] -> Response b
- module Polysemy.Http.Data.Header
- withPort :: Maybe Port -> Tls -> Method -> Host -> Path -> Body -> Request
- withTls :: Tls -> Method -> Host -> Path -> Body -> Request
- simple :: Method -> Host -> Path -> Body -> Request
- get :: Host -> Path -> Request
- post :: Host -> Path -> Body -> Request
- put :: Host -> Path -> Body -> Request
- delete :: Host -> Path -> Request
- fromUrl :: Method -> Body -> Text -> Either Text Request
- getUrl :: Text -> Either Text Request
- postUrl :: Body -> Text -> Either Text Request
- putUrl :: Body -> Text -> Either Text Request
- deleteUrl :: Text -> Either Text Request
- cookie :: Text -> Text -> Text -> Cookie
- addCookies :: [Cookie] -> Request -> Request
- addCookie :: Text -> Text -> Text -> Request -> Request
- data HttpError
- streamResponse :: forall c (r :: EffectRow) o h. Members '[Http c, Error HttpError :: (Type -> Type) -> Type -> Type, Resource] r => Request -> Maybe Int -> (forall x. StreamEvent o c h x -> Sem r x) -> Sem r o
- module Polysemy.Http.Data.StreamEvent
- data EntityDecode d (a :: Type -> Type) b
- decode :: forall d (r :: EffectRow). Member (EntityDecode d) r => ByteString -> Sem r (Either EntityError d)
- decodeLazy :: forall d (r :: EffectRow). Member (EntityDecode d) r => LByteString -> Sem r (Either EntityError d)
- decodeStrict :: forall d (r :: EffectRow). Member (EntityDecode d) r => ByteString -> Sem r (Either EntityError d)
- data EntityEncode d (a :: Type -> Type) b
- encode :: forall d (r :: EffectRow). Member (EntityEncode d) r => d -> Sem r ByteString
- encodeStrict :: forall d (r :: EffectRow). Member (EntityEncode d) r => d -> Sem r ByteString
- type family Entities (es :: [Type]) (r :: EffectRow) where ...
- data Decode (a :: k)
- data Encode (a :: k)
- type family Decoders (ds :: [Type]) (r :: EffectRow) where ...
- type family Encoders (es :: [Type]) (r :: EffectRow) where ...
- data EntityError = EntityError Text Text
- interpretEntityDecodeAeson :: forall d (r :: [(Type -> Type) -> Type -> Type]) a. FromJSON d => Sem (EntityDecode d ': r) a -> Sem r a
- interpretEntityDecodeAesonAs :: forall j d (r :: [(Type -> Type) -> Type -> Type]) a. FromJSON j => (j -> d) -> Sem (EntityDecode d ': r) a -> Sem r a
- interpretEntityDecodeAesonWith :: forall j (r :: EffectRow) d a. FromJSON j => (j -> Sem r (Either Text d)) -> Sem (EntityDecode d ': r) a -> Sem r a
- interpretEntityEncodeAeson :: forall d (r :: [(Type -> Type) -> Type -> Type]) a. ToJSON d => Sem (EntityEncode d ': r) a -> Sem r a
- interpretEntityEncodeAesonAs :: forall j d (r :: [(Type -> Type) -> Type -> Type]) a. ToJSON j => (d -> j) -> Sem (EntityEncode d ': r) a -> Sem r a
- data Manager (a :: Type -> Type) b
- interpretManager :: forall (r :: EffectRow). Member (Embed IO) r => InterpreterFor Manager r
- jsonRequest :: forall c (r :: EffectRow). Member (Http c) r => Request -> Sem r (Either HttpError (Response LByteString))
Documentation
A basic Polysemy effect abstracting HTTP requests:
import Polysemy (resourceToIO, runM) import Log (interpretLogStdout) import qualified Polysemy.Http as Http import Polysemy.Http (interpretHttpNative, interpretLogStdout) main :: IO () main = do result <- runM $ resourceToIO $ interpretLogStdout $ interpretHttpNative $ Http.request (Http.get "hackage.haskell.org" "package/polysemy-http") print result
data Http c (a :: Type -> Type) b Source #
The main effect for HTTP requests.
The parameter c
determines the representation of raw chunks.
request :: forall c (r :: EffectRow). Member (Http c) r => Request -> Sem r (Either HttpError (Response LByteString)) Source #
Synchronously run an HTTP request and return the response.
response :: forall c (r :: EffectRow) a. Member (Http c) r => Request -> (Response c -> Sem r a) -> Sem r (Either HttpError a) Source #
Bracket a higher-order action with a Response
that has been opened while its body
hasn't been fetched.
Interpreters
interpretHttpNative :: forall (r :: EffectRow). Members '[Embed IO, Log, Resource] r => InterpreterFor (Http BodyReader) r Source #
Interpret
using the native Network.HTTP.Client implementation.
Http
BodyReader
BodyReader
is an alias for
; it is how http-client represents chunks.
This uses the default interpreter for IO
ByteString
Manager
.
Arguments
:: forall (r :: EffectRow). Member (Embed IO) r | |
=> [Response LByteString] | When a request is made, one response is popped of the list and returned. If the list is exhausted, a 502 response is returned. |
-> [ByteString] | Chunks used for streaming responses. |
-> InterpretersFor '[Http LByteString, State [Response LByteString] :: (Type -> Type) -> Type -> Type, State [ByteString] :: (Type -> Type) -> Type -> Type] r |
In-Memory interpreter for Http
.
Request and Response
Rrequest path.
Instances
FromJSON Path Source # | |||||
Defined in Polysemy.Http.Data.Request | |||||
ToJSON Path Source # | |||||
IsString Path Source # | |||||
Defined in Polysemy.Http.Data.Request Methods fromString :: String -> Path # | |||||
Monoid Path Source # | |||||
Semigroup Path Source # | |||||
Generic Path Source # | |||||
Defined in Polysemy.Http.Data.Request Associated Types
| |||||
Show Path Source # | |||||
Eq Path Source # | |||||
type Rep Path Source # | |||||
Defined in Polysemy.Http.Data.Request |
All standard HTTP methods, mirroring those from Types
, plus a constructor for arbitrary strings.
Request body.
Constructors
Body | |
Fields
|
Instances
IsString Body Source # | |||||
Defined in Polysemy.Http.Data.Request Methods fromString :: String -> Body # | |||||
Generic Body Source # | |||||
Defined in Polysemy.Http.Data.Request Associated Types
| |||||
Show Body Source # | |||||
Eq Body Source # | |||||
type Rep Body Source # | |||||
Defined in Polysemy.Http.Data.Request type Rep Body = D1 ('MetaData "Body" "Polysemy.Http.Data.Request" "polysemy-http-0.13.1.0-HslaAdsBwfBFVTgN9RdJNp" 'True) (C1 ('MetaCons "Body" 'PrefixI 'True) (S1 ('MetaSel ('Just "unBody") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString))) |
HTTP request parameters, used by Http
.
Constructors
Request Method Host (Maybe Port) Tls Path [(HeaderName, HeaderValue)] CookieJar [(QueryKey, Maybe QueryValue)] Body |
Instances
Request host name.
Instances
FromJSON Host Source # | |||||
Defined in Polysemy.Http.Data.Request | |||||
ToJSON Host Source # | |||||
IsString Host Source # | |||||
Defined in Polysemy.Http.Data.Request Methods fromString :: String -> Host # | |||||
Generic Host Source # | |||||
Defined in Polysemy.Http.Data.Request Associated Types
| |||||
Show Host Source # | |||||
Eq Host Source # | |||||
type Rep Host Source # | |||||
Defined in Polysemy.Http.Data.Request |
Request port.
Instances
FromJSON Port Source # | |||||
Defined in Polysemy.Http.Data.Request | |||||
ToJSON Port Source # | |||||
Enum Port Source # | |||||
Generic Port Source # | |||||
Defined in Polysemy.Http.Data.Request Associated Types
| |||||
Num Port Source # | |||||
Read Port Source # | |||||
Integral Port Source # | |||||
Real Port Source # | |||||
Defined in Polysemy.Http.Data.Request Methods toRational :: Port -> Rational # | |||||
Show Port Source # | |||||
Eq Port Source # | |||||
Ord Port Source # | |||||
type Rep Port Source # | |||||
Defined in Polysemy.Http.Data.Request |
The key of a query parameter.
Constructors
QueryKey | |
Fields
|
Instances
FromJSON QueryKey Source # | |||||
Defined in Polysemy.Http.Data.Request | |||||
ToJSON QueryKey Source # | |||||
IsString QueryKey Source # | |||||
Defined in Polysemy.Http.Data.Request Methods fromString :: String -> QueryKey # | |||||
Generic QueryKey Source # | |||||
Defined in Polysemy.Http.Data.Request Associated Types
| |||||
Show QueryKey Source # | |||||
Eq QueryKey Source # | |||||
type Rep QueryKey Source # | |||||
Defined in Polysemy.Http.Data.Request |
newtype QueryValue Source #
The value of a query parameter.
Constructors
QueryValue | |
Fields
|
Instances
FromJSON QueryValue Source # | |||||
Defined in Polysemy.Http.Data.Request | |||||
ToJSON QueryValue Source # | |||||
Defined in Polysemy.Http.Data.Request Methods toJSON :: QueryValue -> Value # toEncoding :: QueryValue -> Encoding # toJSONList :: [QueryValue] -> Value # toEncodingList :: [QueryValue] -> Encoding # omitField :: QueryValue -> Bool # | |||||
IsString QueryValue Source # | |||||
Defined in Polysemy.Http.Data.Request Methods fromString :: String -> QueryValue # | |||||
Generic QueryValue Source # | |||||
Defined in Polysemy.Http.Data.Request Associated Types
| |||||
Show QueryValue Source # | |||||
Defined in Polysemy.Http.Data.Request Methods showsPrec :: Int -> QueryValue -> ShowS # show :: QueryValue -> String # showList :: [QueryValue] -> ShowS # | |||||
Eq QueryValue Source # | |||||
Defined in Polysemy.Http.Data.Request | |||||
type Rep QueryValue Source # | |||||
Defined in Polysemy.Http.Data.Request type Rep QueryValue = D1 ('MetaData "QueryValue" "Polysemy.Http.Data.Request" "polysemy-http-0.13.1.0-HslaAdsBwfBFVTgN9RdJNp" 'True) (C1 ('MetaCons "QueryValue" 'PrefixI 'True) (S1 ('MetaSel ('Just "unQueryValue") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text))) |
A flag that indicates whether a request should use TLS.
Instances
FromJSON Tls Source # | |||||
Defined in Polysemy.Http.Data.Request | |||||
ToJSON Tls Source # | |||||
Generic Tls Source # | |||||
Defined in Polysemy.Http.Data.Request Associated Types
| |||||
Show Tls Source # | |||||
Eq Tls Source # | |||||
type Rep Tls Source # | |||||
Defined in Polysemy.Http.Data.Request |
pattern Success :: Status -> b -> [Header] -> Response b Source #
Match on a response with a 2xx status.
pattern Info :: Status -> b -> [Header] -> Response b Source #
Match on a response with a 1xx status.
The response produced by Http
.
Instances
Generic (Response b) Source # | |||||
Defined in Polysemy.Http.Data.Response Associated Types
| |||||
Show (Response BodyReader) Source # | |||||
Defined in Polysemy.Http.Data.Response | |||||
Show b => Show (Response b) Source # | |||||
Eq b => Eq (Response b) Source # | |||||
type Rep (Response b) Source # | |||||
Defined in Polysemy.Http.Data.Response type Rep (Response b) = D1 ('MetaData "Response" "Polysemy.Http.Data.Response" "polysemy-http-0.13.1.0-HslaAdsBwfBFVTgN9RdJNp" 'False) (C1 ('MetaCons "Response" 'PrefixI 'True) ((S1 ('MetaSel ('Just "status") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Status) :*: S1 ('MetaSel ('Just "body") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 b)) :*: (S1 ('MetaSel ('Just "headers") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [Header]) :*: S1 ('MetaSel ('Just "cookies") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 CookieJar)))) |
pattern Client :: Status -> b -> [Header] -> Response b Source #
Match on a response with a 4xx status.
pattern Redirect :: Status -> b -> [Header] -> Response b Source #
Match on a response with a 3xx status.
pattern Server :: Status -> b -> [Header] -> Response b Source #
Match on a response with a 5xx status.
module Polysemy.Http.Data.Header
withPort :: Maybe Port -> Tls -> Method -> Host -> Path -> Body -> Request Source #
Create a request with empty headers, query and cookies.
withTls :: Tls -> Method -> Host -> Path -> Body -> Request Source #
Create a request with default port and empty headers, query and cookies.
simple :: Method -> Host -> Path -> Body -> Request Source #
Create a TLS request with default port and empty headers, query and cookies.
get :: Host -> Path -> Request Source #
Create a TLS GET request with default port and empty headers, query and cookies.
post :: Host -> Path -> Body -> Request Source #
Create a TLS POST request with default port and empty headers, query and cookies.
put :: Host -> Path -> Body -> Request Source #
Create a TLS PUT request with default port and empty headers, query and cookies.
delete :: Host -> Path -> Request Source #
Create a TLS DELETE request with default port and empty headers, query and cookies.
fromUrl :: Method -> Body -> Text -> Either Text Request Source #
Parse the URL and create a request or return a parse error.
addCookie :: Text -> Text -> Text -> Request -> Request Source #
Add a cookie to a request, using default values.
Indicates a critical error caused by an exception in the http-client backend.
Constructors
ChunkFailed Text | |
Internal Text |
Streaming
streamResponse :: forall c (r :: EffectRow) o h. Members '[Http c, Error HttpError :: (Type -> Type) -> Type -> Type, Resource] r => Request -> Maybe Int -> (forall x. StreamEvent o c h x -> Sem r x) -> Sem r o Source #
Initiate a request and stream the response, calling process
after connecting, for every chunk, after closing the
connection, and for the return value.
StreamEvent
is used to indicate the stage of the request cycle.
The optional Int
argument defines the minimal chunk size that is read for each callback. If it is Nothing
, the
stream reads what is available.
handle :: StreamEvent Double (IO ByteString) Int a -> Sem r a handle = \case StreamEvent.Acquire (Response status body headers) -> pure 1 StreamEvent.Chunk handle (StreamChunk c) -> pure () StreamEvent.Result (Response status body headers) handle -> pure 5.5 StreamEvent.Release handle -> pure ()
>>>
runInterpreters $ streamResponse (Http.get "host.com" "path/to/file") handle
5.5
Entity
data EntityDecode d (a :: Type -> Type) b Source #
Abstraction of json decoding, potentially usable for other content types like xml.
decode :: forall d (r :: EffectRow). Member (EntityDecode d) r => ByteString -> Sem r (Either EntityError d) Source #
Strictly decode a ByteString
to a value of type d
decodeLazy :: forall d (r :: EffectRow). Member (EntityDecode d) r => LByteString -> Sem r (Either EntityError d) Source #
Lazily decode a LByteString
to a value of type d
decodeStrict :: forall d (r :: EffectRow). Member (EntityDecode d) r => ByteString -> Sem r (Either EntityError d) Source #
Strictly decode a ByteString
to a value of type d
data EntityEncode d (a :: Type -> Type) b Source #
Abstraction of json encoding, potentially usable for other content types like xml.
encode :: forall d (r :: EffectRow). Member (EntityEncode d) r => d -> Sem r ByteString Source #
Strictly encode a value of type d
to a ByteString
encodeStrict :: forall d (r :: EffectRow). Member (EntityEncode d) r => d -> Sem r ByteString Source #
Strictly encode a value of type d
to a ByteString
type family Entities (es :: [Type]) (r :: EffectRow) where ... Source #
Convenience constraint for requiring multiple entity effects, to be used like Members
.
foo :: Entities [Encode Int, Decode Double] r => Sem r ()
type family Decoders (ds :: [Type]) (r :: EffectRow) where ... Source #
Convenience constraint for requiring multiple decoders.
foo :: Decoders [Int, Double] r => Sem r ()
type family Encoders (es :: [Type]) (r :: EffectRow) where ... Source #
Convenience constraint for requiring multiple encoders.
foo :: Encoders [Int, Double] r => Sem r ()
data EntityError Source #
Generic error type for decoders.
Constructors
EntityError Text Text |
Instances
Show EntityError Source # | |
Defined in Polysemy.Http.Effect.Entity Methods showsPrec :: Int -> EntityError -> ShowS # show :: EntityError -> String # showList :: [EntityError] -> ShowS # | |
Eq EntityError Source # | |
Defined in Polysemy.Http.Effect.Entity |
interpretEntityDecodeAeson :: forall d (r :: [(Type -> Type) -> Type -> Type]) a. FromJSON d => Sem (EntityDecode d ': r) a -> Sem r a Source #
Interpreter for EntityDecode
that uses Aeson.
interpretEntityDecodeAesonAs :: forall j d (r :: [(Type -> Type) -> Type -> Type]) a. FromJSON j => (j -> d) -> Sem (EntityDecode d ': r) a -> Sem r a Source #
Interpreter for EntityDecode
that uses Aeson and a different codec type.
The first parameter is the conversion function.
interpretEntityDecodeAesonWith :: forall j (r :: EffectRow) d a. FromJSON j => (j -> Sem r (Either Text d)) -> Sem (EntityDecode d ': r) a -> Sem r a Source #
Interpreter for EntityDecode
that uses Aeson and a different codec type.
The first parameter is the effectful conversion function.
interpretEntityEncodeAeson :: forall d (r :: [(Type -> Type) -> Type -> Type]) a. ToJSON d => Sem (EntityEncode d ': r) a -> Sem r a Source #
Interpreter for EntityEncode
that uses Aeson.
interpretEntityEncodeAesonAs :: forall j d (r :: [(Type -> Type) -> Type -> Type]) a. ToJSON j => (d -> j) -> Sem (EntityEncode d ': r) a -> Sem r a Source #
Interpreter for EntityEncode
that uses Aeson and a different codec type.
The first parameter is the conversion function.
Utilities
Connection Pool
data Manager (a :: Type -> Type) b Source #
This effect abstracts the creation of a Manager
in order to allow pool sharing in a flexible way.
interpretManager :: forall (r :: EffectRow). Member (Embed IO) r => InterpreterFor Manager r Source #
Trivial interpreter with a globally shared Manager
instance.