-----------------------------------------------------------------------------
-- |
-- License     :  BSD-3-Clause
-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
--
-- The events API as described on <https://developer.github.com/v3/activity/events/>.
module GitHub.Endpoints.Activity.Events (
    -- * Events
    repositoryEventsR,
    userEventsR,
    module GitHub.Data,
    ) where

import GitHub.Data
import GitHub.Internal.Prelude
import Prelude ()

-- | List repository events.
-- See <https://developer.github.com/v3/activity/events/#list-repository-events>
repositoryEventsR :: Name Owner -> Name Repo -> FetchCount -> Request 'RO (Vector Event)
repositoryEventsR :: Name Owner -> Name Repo -> FetchCount -> Request 'RO (Vector Event)
repositoryEventsR Name Owner
user Name Repo
repo =
    Paths -> QueryString -> FetchCount -> Request 'RO (Vector Event)
forall a (mt :: RW).
FromJSON a =>
Paths -> QueryString -> FetchCount -> Request mt (Vector a)
pagedQuery  [Text
"repos", Name Owner -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Owner
user, Name Repo -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name Repo
repo, Text
"events"] []

-- | List user public events.
-- See <https://developer.github.com/v3/activity/events/#list-public-events-performed-by-a-user>
userEventsR :: Name User -> FetchCount -> Request 'RO (Vector Event)
userEventsR :: Name User -> FetchCount -> Request 'RO (Vector Event)
userEventsR Name User
user =
    Paths -> QueryString -> FetchCount -> Request 'RO (Vector Event)
forall a (mt :: RW).
FromJSON a =>
Paths -> QueryString -> FetchCount -> Request mt (Vector a)
pagedQuery [Text
"users", Name User -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name User
user, Text
"events", Text
"public"] []