-- |
-- The repo watching API as described on
-- <https://developer.github.com/v3/activity/notifications/>.

module GitHub.Endpoints.Activity.Notifications (
    getNotificationsR,
    markNotificationAsReadR,
    markAllNotificationsAsReadR,
    ) where

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

-- | List your notifications.
-- See <https://developer.github.com/v3/activity/notifications/#list-your-notifications>
getNotificationsR :: FetchCount -> Request 'RA (Vector Notification)
getNotificationsR :: FetchCount -> Request 'RA (Vector Notification)
getNotificationsR = forall a (mt :: RW).
FromJSON a =>
Paths -> QueryString -> FetchCount -> Request mt (Vector a)
pagedQuery [Text
"notifications"] []

-- | Mark a thread as read.
-- See <https://developer.github.com/v3/activity/notifications/#mark-a-thread-as-read>
markNotificationAsReadR :: Id Notification -> GenRequest 'MtUnit 'RW ()
markNotificationAsReadR :: Id Notification -> GenRequest 'MtUnit 'RW ()
markNotificationAsReadR Id Notification
nid = forall (mt :: MediaType (*)) a.
CommandMethod -> Paths -> ByteString -> GenRequest mt 'RW a
Command
    CommandMethod
Patch
    [Text
"notifications", Text
"threads", forall a. IsPathPart a => a -> Text
toPathPart Id Notification
nid]
    (forall a. ToJSON a => a -> ByteString
encode ())

-- | Mark as read.
-- See <https://developer.github.com/v3/activity/notifications/#mark-as-read>
markAllNotificationsAsReadR :: GenRequest 'MtUnit 'RW ()
markAllNotificationsAsReadR :: GenRequest 'MtUnit 'RW ()
markAllNotificationsAsReadR =
    forall (mt :: MediaType (*)) a.
CommandMethod -> Paths -> ByteString -> GenRequest mt 'RW a
Command CommandMethod
Put [Text
"notifications"] forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Value
emptyObject