Add notifications endpoint

Fixes #323

Author: colonelpanic8

github.cabal

@@ -101,6 +101,7 @@ library
     GitHub.Data.Webhooks.Validate
     GitHub.Endpoints.Activity.Events
     GitHub.Endpoints.Activity.Starring
+    GitHub.Endpoints.Activity.Notifications
     GitHub.Endpoints.Activity.Watching
     GitHub.Endpoints.Gists
     GitHub.Endpoints.Gists.Comments

src/GitHub/Data/Activities.hs

@@ -5,8 +5,11 @@
 --
 module GitHub.Data.Activities where
 
-import GitHub.Data.Repos       (Repo)
+import GitHub.Data.Id          (Id, mkId)
+import GitHub.Data.Repos       (Repo, RepoRef)
+import GitHub.Data.URL         (URL)
 import GitHub.Internal.Prelude
+
 import Prelude ()
 
 data RepoStarred = RepoStarred
@@ -24,3 +27,82 @@ instance FromJSON RepoStarred where
         <$> o .: "starred_at"
         <*> o .: "repo"
 
+data Subject = Subject
+    { subjectTitle :: !Text
+    , subjectURL :: !URL
+    , subjectLatestCommentURL :: !(Maybe URL)
+    -- https://developer.github.com/v3/activity/notifications/ doesn't indicate
+    -- what the possible values for this field are.
+    -- TODO: Make an ADT for this.
+    , subjectType :: !Text
+    }
+  deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Subject where rnf = genericRnf
+instance Binary Subject
+
+instance FromJSON Subject where
+    parseJSON = withObject "Subject" $ \o -> Subject
+        <$> o .: "title"
+        <*> o .: "url"
+        <*> o .:? "latest_comment_url"
+        <*> o .: "type"
+
+data NotificationReason
+    = AssignReason
+    | AuthorReason
+    | CommentReason
+    | InvitationReason
+    | ManualReason
+    | MentionReason
+    | ReviewRequestedReason
+    | StateChangeReason
+    | SubscribedReason
+    | TeamMentionReason
+  deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic)
+
+instance NFData NotificationReason where rnf = genericRnf
+instance Binary NotificationReason
+
+instance FromJSON NotificationReason where
+    parseJSON = withText "NotificationReason" $ \t -> case t of
+        "assign" -> pure AssignReason
+        "author" -> pure AuthorReason
+        "comment" -> pure CommentReason
+        "invitation" -> pure InvitationReason
+        "manual" -> pure ManualReason
+        "mention" -> pure MentionReason
+        "review_requested" -> pure ReviewRequestedReason
+        "state_change" -> pure StateChangeReason
+        "subscribed" -> pure SubscribedReason
+        "team_mention" -> pure TeamMentionReason
+        _ -> fail $ "Unknown NotificationReason " ++ show t
+
+data Notification = Notification
+    -- XXX: The notification id field type IS in fact string. Not sure why gh
+    -- chose to do this when all the other ids are Numbers...
+    { notificationId :: !(Id Notification)
+    , notificationRepo :: !RepoRef
+    , notificationSubject :: !Subject
+    , notificationReason :: !NotificationReason
+    , notificationUnread :: !Bool
+    , notificationUpdatedAt :: !(Maybe UTCTime)
+    , notificationLastReadAt :: !(Maybe UTCTime)
+    , notificationUrl :: !URL
+    }
+  deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Notification where rnf = genericRnf
+instance Binary Notification
+
+instance FromJSON Notification where
+    parseJSON = withObject "Notification" $ \o -> Notification
+        <$> (mkId undefined . read <$> o .: "id")
+        <*> o .: "repository"
+        <*> o .: "subject"
+        <*> o .: "reason"
+        <*> o .: "unread"
+        <*> o .: "updated_at"
+        <*> o .: "last_read_at"
+        <*> o .: "url"
+

src/GitHub/Endpoints/Activity/Notifications.hs

@@ -0,0 +1,39 @@
+-----------------------------------------------------------------------------
+-- |
+-- License     :  BSD-3-Clause
+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
+--
+-- The repo watching API as described on
+-- <https://developer.github.com/v3/activity/notifications/>.
+
+module GitHub.Endpoints.Activity.Notifications where
+
+import GitHub.Data
+import GitHub.Internal.Prelude
+import GitHub.Request
+import Prelude ()
+
+getNotifications :: Auth -> IO (Either Error (Vector Notification))
+getNotifications auth =
+  executeRequest auth $ getNotificationsR FetchAll
+
+getNotificationsR :: FetchCount -> Request 'RA (Vector Notification)
+getNotificationsR =
+  pagedQuery ["notifications"] []
+
+markNotificationAsRead :: Auth -> Id Notification -> IO (Either Error ())
+markNotificationAsRead auth notificationId =
+  executeRequest auth $ markNotificationAsReadR notificationId
+
+markNotificationAsReadR :: Id Notification -> Request 'RW ()
+markNotificationAsReadR notificationId = SimpleQuery $
+  Command Patch ["notifications", "threads", toPathPart notificationId]
+            (encode ())
+
+markNotificationsAsRead :: Auth -> IO (Either Error ())
+markNotificationsAsRead auth =
+  executeRequest auth markAllNotificationsAsReadR
+
+markAllNotificationsAsReadR :: Request 'RW ()
+markAllNotificationsAsReadR = SimpleQuery $
+  Command Put ["notifications"] $ encode emptyObject

src/GitHub/Internal/Prelude.hs

@@ -22,6 +22,7 @@ module GitHub.Internal.Prelude (
     Semigroup(..),
     -- * Aeson
     FromJSON(..), ToJSON(..), Value(..), Object,
+    emptyObject,
     encode,
     withText, withObject, (.:), (.:?), (.!=), (.=), object, typeMismatch,
     -- * Control.Applicative
@@ -40,7 +41,7 @@ import Control.DeepSeq.Generics (genericRnf)
 import Data.Aeson
        (FromJSON (..), Object, ToJSON (..), Value (..), encode, object,
        withObject, withText, (.!=), (.:), (.:?), (.=))
-import Data.Aeson.Types         (typeMismatch)
+import Data.Aeson.Types         (emptyObject, typeMismatch)
 import Data.Binary              (Binary)
 import Data.Binary.Instances ()
 import Data.Data                (Data, Typeable)