Safe Haskell | None |
---|---|
Language | Haskell2010 |
GitHub.Request
Description
This module provides data types and helper methods, which makes possible
to build alternative API request intepreters in addition to provided
IO
functions.
Simple example using operational
package. See samples/Operational/Operational.hs
type GithubMonad a = Program (GH.Request 'False) a -- | Intepret GithubMonad value into IO runMonad :: Manager -> GH.Auth -> GithubMonad a -> ExceptT GH.Error IO a runMonad mgr auth m = case view m of Return a -> return a req :>>= k -> do b <- ExceptT $ GH.executeRequestWithMgr mgr auth req runMonad mgr auth (k b) -- | Lift request into Monad githubRequest :: GH.Request 'False a -> GithubMonad a githubRequest = singleton
Synopsis
- github :: (AuthMethod am, GitHubRW req res) => am -> req -> res
- github' :: GitHubRO req res => req -> res
- class GitHubRW req res | req -> res
- class GitHubRO req res | req -> res
- type Request = GenRequest ('MtJSON :: MediaType Type)
- data GenRequest (mt :: MediaType Type) (rw :: RW) a where
- Query :: forall (mt :: MediaType Type) (rw :: RW) a. Paths -> QueryString -> GenRequest mt rw a
- PagedQuery :: forall a (t :: Type -> Type) b (mt :: MediaType Type) (rw :: RW). (a ~ t b, Foldable t, Semigroup a) => Paths -> QueryString -> FetchCount -> GenRequest mt rw a
- Command :: forall (mt :: MediaType Type) a. CommandMethod -> Paths -> ByteString -> GenRequest mt 'RW a
- data CommandMethod
- toMethod :: CommandMethod -> Method
- type Paths = [Text]
- type QueryString = [(ByteString, Maybe ByteString)]
- executeRequest :: forall am (mt :: MediaType Type) a (rw :: RW). (AuthMethod am, ParseResponse mt a) => am -> GenRequest mt rw a -> IO (Either Error a)
- executeRequestWithMgr :: forall am (mt :: MediaType Type) a (rw :: RW). (AuthMethod am, ParseResponse mt a) => Manager -> am -> GenRequest mt rw a -> IO (Either Error a)
- executeRequestWithMgrAndRes :: forall am (mt :: MediaType Type) a (rw :: RW). (AuthMethod am, ParseResponse mt a) => Manager -> am -> GenRequest mt rw a -> IO (Either Error (Response a))
- executeRequest' :: forall (mt :: MediaType Type) a. ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a)
- executeRequestWithMgr' :: forall (mt :: MediaType Type) a. ParseResponse mt a => Manager -> GenRequest mt 'RO a -> IO (Either Error a)
- executeRequestMaybe :: forall am (mt :: MediaType Type) a. (AuthMethod am, ParseResponse mt a) => Maybe am -> GenRequest mt 'RO a -> IO (Either Error a)
- unsafeDropAuthRequirements :: forall (mt :: MediaType Type) (rw' :: RW) a (rw :: RW). GenRequest mt rw' a -> GenRequest mt rw a
- class Accept (mt :: MediaType Type) where
- contentType :: Tagged mt ByteString
- modifyRequest :: Tagged mt (Request -> Request)
- class Accept mt => ParseResponse (mt :: MediaType Type) a where
- parseResponse :: MonadError Error m => Request -> Response ByteString -> Tagged mt (m a)
- makeHttpRequest :: forall am (mt :: MediaType Type) (rw :: RW) a m. (AuthMethod am, MonadThrow m, Accept mt) => Maybe am -> GenRequest mt rw a -> m Request
- parseStatus :: MonadError Error m => StatusMap a -> Status -> m a
- parsePageLinks :: Response a -> PageLinks
- type StatusMap a = [(Int, a)]
- getNextUrl :: Response a -> Maybe URI
- performPagedRequest :: forall a m (mt :: MediaType Type). (ParseResponse mt a, Semigroup a, MonadCatch m, MonadError Error m) => (Request -> m (Response ByteString)) -> (a -> Bool) -> Request -> Tagged mt (m (Response a))
- parseResponseJSON :: (FromJSON a, MonadError Error m) => Response ByteString -> m a
- class PreviewAccept p where
- previewContentType :: Tagged ('MtPreview p) ByteString
- previewModifyRequest :: Tagged ('MtPreview p) (Request -> Request)
- class PreviewAccept p => PreviewParseResponse p a where
- previewParseResponse :: MonadError Error m => Request -> Response ByteString -> Tagged ('MtPreview p) (m a)
- withOpenSSL :: IO a -> IO a
- tlsManagerSettings :: ManagerSettings
A convenient execution of requests
github :: (AuthMethod am, GitHubRW req res) => am -> req -> res Source #
A convenience function to turn functions returning
,
into functions returning Request
rw xIO (Either
.Error
x)
>>>
:t \auth -> github auth userInfoForR
\auth -> github auth userInfoForR :: AuthMethod am => am -> Name User -> IO (Either Error User)
>>>
:t github pullRequestsForR
\auth -> github auth pullRequestsForR :: AuthMethod am => am -> Name Owner -> Name Repo -> PullRequestMod -> FetchCount -> IO (Either Error (Data.Vector.Vector SimplePullRequest))
class GitHubRW req res | req -> res Source #
A type-class implementing github
.
Minimal complete definition
githubImpl
Instances
GitHubRW req res => GitHubRW (a -> req) (a -> res) Source # | |
Defined in GitHub.Request Methods githubImpl :: AuthMethod am => am -> (a -> req) -> a -> res | |
(ParseResponse mt req, res ~ Either Error req) => GitHubRW (GenRequest mt rw req) (IO res) Source # | |
Defined in GitHub.Request Methods githubImpl :: AuthMethod am => am -> GenRequest mt rw req -> IO res |
class GitHubRO req res | req -> res Source #
A type-class implementing github'
.
Minimal complete definition
githubImpl'
Instances
GitHubRO req res => GitHubRO (a -> req) (a -> res) Source # | |
Defined in GitHub.Request Methods githubImpl' :: (a -> req) -> a -> res | |
(ParseResponse mt req, res ~ Either Error req, rw ~ 'RO) => GitHubRO (GenRequest mt rw req) (IO res) Source # | |
Defined in GitHub.Request Methods githubImpl' :: GenRequest mt rw req -> IO res |
Types
data GenRequest (mt :: MediaType Type) (rw :: RW) a where Source #
Github request data type.
rw
describes whether authentication is required. It's required for non-GET
requests.mt
describes the media type, i.e. how the response should be interpreted.a
is the result type
Constructors
Query :: forall (mt :: MediaType Type) (rw :: RW) a. Paths -> QueryString -> GenRequest mt rw a | |
PagedQuery :: forall a (t :: Type -> Type) b (mt :: MediaType Type) (rw :: RW). (a ~ t b, Foldable t, Semigroup a) => Paths -> QueryString -> FetchCount -> GenRequest mt rw a | |
Command | Command |
Fields
|
Instances
data CommandMethod Source #
Http method of requests with body.
Instances
toMethod :: CommandMethod -> Method Source #
type QueryString = [(ByteString, Maybe ByteString)] Source #
Request query string
Request execution in IO
executeRequest :: forall am (mt :: MediaType Type) a (rw :: RW). (AuthMethod am, ParseResponse mt a) => am -> GenRequest mt rw a -> IO (Either Error a) Source #
executeRequestWithMgr :: forall am (mt :: MediaType Type) a (rw :: RW). (AuthMethod am, ParseResponse mt a) => Manager -> am -> GenRequest mt rw a -> IO (Either Error a) Source #
Like executeRequest
but with provided Manager
.
executeRequestWithMgrAndRes :: forall am (mt :: MediaType Type) a (rw :: RW). (AuthMethod am, ParseResponse mt a) => Manager -> am -> GenRequest mt rw a -> IO (Either Error (Response a)) Source #
Execute request and return the last received Response
.
Since: 0.24
executeRequest' :: forall (mt :: MediaType Type) a. ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a) Source #
Like executeRequest
but without authentication.
executeRequestWithMgr' :: forall (mt :: MediaType Type) a. ParseResponse mt a => Manager -> GenRequest mt 'RO a -> IO (Either Error a) Source #
Like executeRequestWithMgr
but without authentication.
executeRequestMaybe :: forall am (mt :: MediaType Type) a. (AuthMethod am, ParseResponse mt a) => Maybe am -> GenRequest mt 'RO a -> IO (Either Error a) Source #
Helper for picking between executeRequest
and executeRequest'
.
The use is discouraged.
unsafeDropAuthRequirements :: forall (mt :: MediaType Type) (rw' :: RW) a (rw :: RW). GenRequest mt rw' a -> GenRequest mt rw a Source #
Partial function to drop authentication need.
Helpers
class Accept (mt :: MediaType Type) where Source #
Minimal complete definition
Nothing
Methods
contentType :: Tagged mt ByteString Source #
Instances
Accept ('MtDiff :: MediaType Type) Source # | |
Defined in GitHub.Request | |
Accept ('MtJSON :: MediaType Type) Source # | |
Defined in GitHub.Request | |
Accept ('MtPatch :: MediaType Type) Source # | |
Defined in GitHub.Request | |
Accept ('MtRaw :: MediaType Type) Source # | |
Defined in GitHub.Request | |
Accept ('MtRedirect :: MediaType Type) Source # | |
Defined in GitHub.Request Methods contentType :: Tagged ('MtRedirect :: MediaType Type) ByteString Source # modifyRequest :: Tagged ('MtRedirect :: MediaType Type) (Request -> Request) Source # | |
Accept ('MtSha :: MediaType Type) Source # | |
Defined in GitHub.Request | |
Accept ('MtStar :: MediaType Type) Source # | |
Defined in GitHub.Request | |
Accept ('MtStatus :: MediaType Type) Source # | |
Defined in GitHub.Request | |
Accept ('MtUnit :: MediaType Type) Source # | Note: we don't ignore response status. We only accept any response body. |
Defined in GitHub.Request | |
PreviewAccept p => Accept ('MtPreview p) Source # | |
Defined in GitHub.Request Methods contentType :: Tagged ('MtPreview p) ByteString Source # modifyRequest :: Tagged ('MtPreview p) (Request -> Request) Source # |
class Accept mt => ParseResponse (mt :: MediaType Type) a where Source #
Methods
parseResponse :: MonadError Error m => Request -> Response ByteString -> Tagged mt (m a) Source #
Instances
a ~ ByteString => ParseResponse ('MtDiff :: MediaType Type) a Source # | |
Defined in GitHub.Request Methods parseResponse :: MonadError Error m => Request -> Response ByteString -> Tagged ('MtDiff :: MediaType Type) (m a) Source # | |
FromJSON a => ParseResponse ('MtJSON :: MediaType Type) a Source # | |
Defined in GitHub.Request Methods parseResponse :: MonadError Error m => Request -> Response ByteString -> Tagged ('MtJSON :: MediaType Type) (m a) Source # | |
a ~ ByteString => ParseResponse ('MtPatch :: MediaType Type) a Source # | |
Defined in GitHub.Request Methods parseResponse :: MonadError Error m => Request -> Response ByteString -> Tagged ('MtPatch :: MediaType Type) (m a) Source # | |
a ~ ByteString => ParseResponse ('MtRaw :: MediaType Type) a Source # | |
Defined in GitHub.Request Methods parseResponse :: MonadError Error m => Request -> Response ByteString -> Tagged ('MtRaw :: MediaType Type) (m a) Source # | |
b ~ URI => ParseResponse ('MtRedirect :: MediaType Type) b Source # | |
Defined in GitHub.Request Methods parseResponse :: MonadError Error m => Request -> Response ByteString -> Tagged ('MtRedirect :: MediaType Type) (m b) Source # | |
a ~ ByteString => ParseResponse ('MtSha :: MediaType Type) a Source # | |
Defined in GitHub.Request Methods parseResponse :: MonadError Error m => Request -> Response ByteString -> Tagged ('MtSha :: MediaType Type) (m a) Source # | |
FromJSON a => ParseResponse ('MtStar :: MediaType Type) a Source # | |
Defined in GitHub.Request Methods parseResponse :: MonadError Error m => Request -> Response ByteString -> Tagged ('MtStar :: MediaType Type) (m a) Source # | |
HasStatusMap a => ParseResponse ('MtStatus :: MediaType Type) a Source # | |
Defined in GitHub.Request Methods parseResponse :: MonadError Error m => Request -> Response ByteString -> Tagged ('MtStatus :: MediaType Type) (m a) Source # | |
a ~ () => ParseResponse ('MtUnit :: MediaType Type) a Source # | |
Defined in GitHub.Request Methods parseResponse :: MonadError Error m => Request -> Response ByteString -> Tagged ('MtUnit :: MediaType Type) (m a) Source # | |
PreviewParseResponse p a => ParseResponse ('MtPreview p) a Source # | |
Defined in GitHub.Request Methods parseResponse :: MonadError Error m => Request -> Response ByteString -> Tagged ('MtPreview p) (m a) Source # |
makeHttpRequest :: forall am (mt :: MediaType Type) (rw :: RW) a m. (AuthMethod am, MonadThrow m, Accept mt) => Maybe am -> GenRequest mt rw a -> m Request Source #
Create http-client
Request
.
- for
PagedQuery
, the initial request is created. - for
Status
, theRequest
for underlyingRequest
is created, status checking is modifying accordingly.
parseStatus :: MonadError Error m => StatusMap a -> Status -> m a Source #
parsePageLinks :: Response a -> PageLinks Source #
Parse the PageLinks
from an HTTP response, where the information is
encoded in the Link header.
getNextUrl :: Response a -> Maybe URI Source #
Query Link
header with rel=next
from the request headers.
Arguments
:: forall a m (mt :: MediaType Type). (ParseResponse mt a, Semigroup a, MonadCatch m, MonadError Error m) | |
=> (Request -> m (Response ByteString)) |
|
-> (a -> Bool) | predicate to continue iteration |
-> Request | initial request |
-> Tagged mt (m (Response a)) |
parseResponseJSON :: (FromJSON a, MonadError Error m) => Response ByteString -> m a Source #
Parse API response.
parseResponse ::FromJSON
a =>Response
ByteString
->Either
Error
a
Preview
class PreviewAccept p where Source #
Minimal complete definition
Methods
previewContentType :: Tagged ('MtPreview p) ByteString Source #
previewModifyRequest :: Tagged ('MtPreview p) (Request -> Request) Source #
class PreviewAccept p => PreviewParseResponse p a where Source #
Methods
previewParseResponse :: MonadError Error m => Request -> Response ByteString -> Tagged ('MtPreview p) (m a) Source #
SSL
This always exist, independently of openssl
configuration flag.
They change accordingly, to make use of the library simpler.
withOpenSSL :: IO a -> IO a Source #
tlsManagerSettings :: ManagerSettings #
Default TLS-enabled manager settings