Adding read-only parts of emails endpoint

mwu · mwu · commit bf59f09d3b3f · 2018-01-18T00:20:17.000-08:00
diff --git a/github.cabal b/github.cabal
@@ -75,6 +75,7 @@ Library
     GitHub.Data.Content
     GitHub.Data.Definitions
     GitHub.Data.DeployKeys
+    GitHub.Data.Email
     GitHub.Data.Events
     GitHub.Data.Gists
     GitHub.Data.GitData
@@ -126,6 +127,7 @@ Library
     GitHub.Endpoints.Repos.Webhooks
     GitHub.Endpoints.Search
     GitHub.Endpoints.Users
+    GitHub.Endpoints.Users.Emails
     GitHub.Endpoints.Users.Followers
     GitHub.Request
 
diff --git a/samples/Users/Emails/ListEmails.hs b/samples/Users/Emails/ListEmails.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main (main) where
+
+import Common
+import Prelude ()
+import qualified GitHub.Endpoints.Users.Emails as GitHub
+
+
+main :: IO ()
+main = do
+    emails <- GitHub.currentUserEmails' (GitHub.OAuth "token")
+    putStrLn $ either (("Error: " <>) . tshow)
+                      (foldMap ((<> "\n") . formatEmail))
+                      emails
+
+formatEmail :: GitHub.Email -> Text
+formatEmail e = GitHub.emailAddress e <> if GitHub.emailPrimary e then " [primary]" else ""
diff --git a/src/GitHub.hs b/src/GitHub.hs
@@ -315,6 +315,17 @@ module GitHub (
     ownerInfoForR,
     userInfoCurrentR,
 
+    -- ** Emails
+    -- | See <https://developer.github.com/v3/users/emails/>
+    --
+    -- Missing endpoints:
+    --
+    -- * Add email address(es)
+    -- * Delete email address(es)
+    -- * Toggle primary email visibility
+    currentUserEmailsR,
+    currentUserPublicEmailsR,
+
     -- ** Followers
     -- | See <https://developer.github.com/v3/users/followers/>
     --
@@ -370,5 +381,6 @@ import GitHub.Endpoints.Repos.Statuses
 import GitHub.Endpoints.Repos.Webhooks
 import GitHub.Endpoints.Search
 import GitHub.Endpoints.Users
+import GitHub.Endpoints.Users.Emails
 import GitHub.Endpoints.Users.Followers
 import GitHub.Request
diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs
@@ -37,6 +37,7 @@ module GitHub.Data (
     module GitHub.Data.Content,
     module GitHub.Data.Definitions,
     module GitHub.Data.DeployKeys,
+    module GitHub.Data.Email,
     module GitHub.Data.Events,
     module GitHub.Data.Gists,
     module GitHub.Data.GitData,
@@ -64,6 +65,7 @@ import GitHub.Data.Comments
 import GitHub.Data.Content
 import GitHub.Data.Definitions
 import GitHub.Data.DeployKeys
+import GitHub.Data.Email
 import GitHub.Data.Events
 import GitHub.Data.Gists
 import GitHub.Data.GitData
diff --git a/src/GitHub/Data/Email.hs b/src/GitHub/Data/Email.hs
@@ -0,0 +1,39 @@
+-----------------------------------------------------------------------------
+-- |
+-- License     :  BSD-3-Clause
+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
+--
+module GitHub.Data.Email where
+
+import GitHub.Internal.Prelude
+import Prelude ()
+
+data EmailVisibility
+    = EmailVisibilityPrivate
+    | EmailVisibilityPublic
+    deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic)
+
+instance NFData EmailVisibility where rnf = genericRnf
+instance Binary EmailVisibility
+
+instance FromJSON EmailVisibility where
+    parseJSON (String "private") = pure EmailVisibilityPrivate
+    parseJSON (String "public")  = pure EmailVisibilityPublic
+    parseJSON _ = fail "Could not build an EmailVisibility"
+
+data Email = Email
+    { emailAddress    :: !Text
+    , emailVerified   :: !Bool
+    , emailPrimary    :: !Bool
+    , emailVisibility :: !(Maybe EmailVisibility)
+    } deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData Email where rnf = genericRnf
+instance Binary Email
+
+instance FromJSON Email where
+    parseJSON = withObject "Email" $ \o -> Email
+        <$> o .:  "email"
+        <*> o .:  "verified"
+        <*> o .:  "primary"
+        <*> o .:? "visibility"
diff --git a/src/GitHub/Endpoints/Users/Emails.hs b/src/GitHub/Endpoints/Users/Emails.hs
@@ -0,0 +1,45 @@
+-----------------------------------------------------------------------------
+-- |
+-- License     :  BSD-3-Clause
+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
+--
+-- The user emails API as described on
+-- <http://developer.github.com/v3/users/emails/>.
+module GitHub.Endpoints.Users.Emails (
+    currentUserEmails',
+    currentUserEmailsR,
+    currentUserPublicEmails',
+    currentUserPublicEmailsR,
+    module GitHub.Data,
+    ) where
+
+import GitHub.Data
+import GitHub.Internal.Prelude
+import GitHub.Request
+import Prelude ()
+
+-- | List email addresses for the authenticated user.
+--
+-- > currentUserEmails' (OAuth "token")
+currentUserEmails' :: Auth -> IO (Either Error (Vector Email))
+currentUserEmails' auth =
+    executeRequest auth $ currentUserEmailsR FetchAll
+
+-- | List email addresses.
+-- See <https://developer.github.com/v3/users/emails/#list-email-addresses-for-a-user>
+currentUserEmailsR :: FetchCount -> Request 'RA (Vector Email)
+currentUserEmailsR =
+    pagedQuery ["user", "emails"] []
+
+-- | List public email addresses for the authenticated user.
+--
+-- > currentUserPublicEmails' (OAuth "token")
+currentUserPublicEmails' :: Auth -> IO (Either Error (Vector Email))
+currentUserPublicEmails' auth =
+    executeRequest auth $ currentUserPublicEmailsR FetchAll
+
+-- | List public email addresses.
+-- See <https://developer.github.com/v3/users/emails/#list-public-email-addresses-for-a-user>
+currentUserPublicEmailsR :: FetchCount -> Request 'RA (Vector Email)
+currentUserPublicEmailsR =
+    pagedQuery ["user", "public_emails"] []
