Pull 363 ssh keys endpoints

.travis.yml

@@ -34,8 +34,8 @@ matrix:
       env: GHCHEAD=true
     - compiler: ghc-8.6.5
       addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}}
-    - compiler: ghc-8.4.3
-      addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.3","cabal-install-2.4"]}}
+    - compiler: ghc-8.4.4
+      addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}}
     - compiler: ghc-8.2.2
       addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}}
     - compiler: ghc-8.0.2

CHANGELOG.md

@@ -2,16 +2,22 @@
 
 ## Changes for 0.22
 
-  [#370](https://github.com/phadej/github/pull/370)
 - Type-class for various auth methods
   [#365](https://github.com/phadej/github/pull/365)
 - Throw on non-200 responses
   [#350](https://github.com/phadej/github/pull/350)
 - Add extension point for (preview) media types
+  [#370](https://github.com/phadej/github/pull/370)
 - Add missing webhook event types
   [#359](https://github.com/phadej/github/pull/359)
+- Add invitation endpoint
+  [#360](https://github.com/phadej/github/pull/360)
 - Add notifications endpoints
   [#324](https://github.com/phadej/github/pull/324)
+- Add ssh keys endpoints
+  [#363](https://github.com/phadej/github/pull/365)
+- Case insensitive enum parsing
+  [#373](https://github.com/phadej/github/pull/373)
 - Update dependencies
   [#364](https://github.com/phadej/github/pull/364)
   [#368](https://github.com/phadej/github/pull/368)

github.cabal

@@ -30,7 +30,7 @@ copyright:
   Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus
 
 tested-with:
-  GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.3 || ==8.6.5 || ==8.8.1
+  GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1
 
 extra-source-files:
   README.md
@@ -87,6 +87,7 @@ library
     GitHub.Data.Milestone
     GitHub.Data.Name
     GitHub.Data.Options
+    GitHub.Data.PublicSSHKeys
     GitHub.Data.PullRequests
     GitHub.Data.RateLimit
     GitHub.Data.Releases
@@ -132,10 +133,12 @@ library
     GitHub.Endpoints.Repos.Releases
     GitHub.Endpoints.Repos.Statuses
     GitHub.Endpoints.Repos.Webhooks
+    GitHub.Endpoints.Repos.Invitations
     GitHub.Endpoints.Search
     GitHub.Endpoints.Users
     GitHub.Endpoints.Users.Emails
     GitHub.Endpoints.Users.Followers
+    GitHub.Endpoints.Users.PublicSSHKeys
     GitHub.Internal.Prelude
     GitHub.Request
 
@@ -193,6 +196,7 @@ test-suite github-test
     GitHub.IssuesSpec
     GitHub.OrganizationsSpec
     GitHub.PullRequestReviewsSpec
+    GitHub.PublicSSHKeysSpec
     GitHub.PullRequestsSpec
     GitHub.RateLimitSpec
     GitHub.ReleasesSpec

samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main (main) where
+
+import qualified GitHub.Data.PublicSSHKeys as PK
+import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK
+import qualified GitHub.Auth as Auth
+import Data.Text (Text)
+
+main :: IO ()
+main = do
+  let auth = Auth.OAuth "auth_token"
+  ePublicSSHKey <- PK.createUserPublicSSHKey' auth newPublicSSHKey
+  case ePublicSSHKey of
+    (Left err) -> putStrLn $ "Error: " ++ (show err)
+    (Right publicSSHKey) -> putStrLn $ show publicSSHKey
+
+newPublicSSHKey :: PK.NewPublicSSHKey
+newPublicSSHKey =
+    PK.NewPublicSSHKey
+        { PK.newPublicSSHKeyKey = "test-key"
+        , PK.newPublicSSHKeyTitle = "some-name-for-your-key"
+        }

samples/Users/PublicSSHKeys/DeletePublicSSHKey.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main (main) where
+
+import GitHub.Data.Id (Id (..))
+import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK
+import qualified GitHub.Auth as Auth
+
+main :: IO ()
+main = do
+  let auth = Auth.OAuth "auth_token"
+  ePublicSSHKey <- PK.deleteUserPublicSSHKey' auth (Id 18530161)
+  case ePublicSSHKey of
+    (Left err) -> putStrLn $ "Error: " ++ (show err)
+    (Right _) -> putStrLn $ "Deleted public SSH key!"

samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main (main) where
+
+import qualified GitHub.Data.PublicSSHKeys as PK
+import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK
+import qualified GitHub.Auth as Auth
+import Data.List (intercalate)
+import Data.Vector (toList)
+
+main :: IO ()
+main = do
+  -- Fetch the SSH public keys of another user
+  ePublicSSHKeys <- PK.publicSSHKeysFor' "github_name"
+  case ePublicSSHKeys of
+    (Left err) -> putStrLn $ "Error: " ++ (show err)
+    (Right publicSSHKeys) -> putStrLn $ intercalate "\n" $ map show (toList publicSSHKeys)
+
+  -- Fetch my SSH public keys
+  let auth = Auth.OAuth "auth_token"
+  eMyPublicSSHKeys <- PK.publicSSHKeys' auth
+  case eMyPublicSSHKeys of
+    (Left err) -> putStrLn $ "Error: " ++ (show err)
+    (Right publicSSHKeys) -> putStrLn $ intercalate "\n" $ map show (toList publicSSHKeys)
+

samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main (main) where
+
+import GitHub.Data.Id (Id (..))
+import qualified GitHub.Data.PublicSSHKeys as PK
+import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK
+import qualified GitHub.Auth as Auth
+
+main :: IO ()
+main = do
+  let auth = Auth.OAuth "auth_token"
+  ePublicSSHKey <- PK.publicSSHKey' auth (Id 18528451)
+  case ePublicSSHKey of
+    (Left err) -> putStrLn $ "Error: " ++ (show err)
+    (Right publicSSHKey) -> putStrLn $ show publicSSHKey

samples/github-samples.cabal

@@ -269,3 +269,56 @@ executable github-teaminfo-for
     , text
     , github-samples
   default-language: Haskell2010
+
+executable github-create-public-ssh-key
+  main-is: CreatePublicSSHKey.hs
+  hs-source-dirs:
+      Users/PublicSSHKeys
+  ghc-options: -Wall
+  build-depends:
+      base
+    , base-compat
+    , github
+    , text
+    , github-samples
+  default-language: Haskell2010
+
+executable github-delete-public-ssh-key
+  main-is: DeletePublicSSHKey.hs
+  hs-source-dirs:
+      Users/PublicSSHKeys
+  ghc-options: -Wall
+  build-depends:
+      base
+    , base-compat
+    , github
+    , text
+    , github-samples
+  default-language: Haskell2010
+
+executable github-list-public-ssh-keys
+  main-is: ListPublicSSHKeys.hs
+  hs-source-dirs:
+      Users/PublicSSHKeys
+  ghc-options: -Wall
+  build-depends:
+      base
+    , base-compat
+    , github
+    , text
+    , github-samples
+    , vector
+  default-language: Haskell2010
+
+executable github-get-public-ssh-key
+  main-is: ShowPublicSSHKey.hs
+  hs-source-dirs:
+      Users/PublicSSHKeys
+  ghc-options: -Wall
+  build-depends:
+      base
+    , base-compat
+    , github
+    , text
+    , github-samples
+  default-language: Haskell2010

spec/GitHub/PublicSSHKeysSpec.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+module GitHub.PublicSSHKeysSpec where
+
+import GitHub
+       (Auth (..), FetchCount (..), PublicSSHKey (..), executeRequest)
+import GitHub.Endpoints.Users.PublicSSHKeys
+       (publicSSHKey', publicSSHKeys', publicSSHKeysForR)
+
+import Data.Either.Compat (isRight)
+import Data.String        (fromString)
+import System.Environment (lookupEnv)
+import Test.Hspec         (Spec, describe, it, pendingWith, shouldSatisfy)
+
+import qualified Data.Vector as V
+
+fromRightS :: Show a => Either a b -> b
+fromRightS (Right b) = b
+fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a
+
+withAuth :: (Auth -> IO ()) -> IO ()
+withAuth action = do
+  mtoken <- lookupEnv "GITHUB_TOKEN"
+  case mtoken of
+    Nothing    -> pendingWith "no GITHUB_TOKEN"
+    Just token -> action (OAuth $ fromString token)
+
+spec :: Spec
+spec = do
+  describe "publicSSHKeysFor'" $ do
+    it "works" $ withAuth $ \auth -> do
+      keys <- executeRequest auth $ publicSSHKeysForR "phadej" FetchAll
+      V.length (fromRightS keys) `shouldSatisfy` (> 1)
+
+  describe "publicSSHKeys' and publicSSHKey'" $ do
+    it "works" $ withAuth $ \auth -> do
+      keys <- publicSSHKeys' auth
+      V.length (fromRightS keys) `shouldSatisfy` (> 1)
+
+      key <- publicSSHKey' auth (publicSSHKeyId $ V.head (fromRightS keys))
+      key `shouldSatisfy` isRight

src/GitHub.hs

@@ -319,6 +319,19 @@ module GitHub (
     latestReleaseR,
     releaseByTagNameR,
 
+    -- ** Invitations
+    -- | See <https://developer.github.com/v3/repos/invitations/>
+    -- Missing endpoints:
+
+    -- * Delete a repository invitation
+    -- * Update a repository invitation
+    -- * Decline a repository invitation
+
+    listInvitationsOnR,
+    acceptInvitationFromR,
+    listInvitationsForR,
+
+
     -- * Search
     -- | See <https://developer.github.com/v3/search/>
     --
@@ -408,6 +421,7 @@ import GitHub.Endpoints.Repos.Comments
 import GitHub.Endpoints.Repos.Commits
 import GitHub.Endpoints.Repos.Deployments
 import GitHub.Endpoints.Repos.Forks
+import GitHub.Endpoints.Repos.Invitations
 import GitHub.Endpoints.Repos.Releases
 import GitHub.Endpoints.Repos.Statuses
 import GitHub.Endpoints.Repos.Webhooks

src/GitHub/Data.hs

@@ -48,6 +48,7 @@ module GitHub.Data (
     module GitHub.Data.Issues,
     module GitHub.Data.Milestone,
     module GitHub.Data.Options,
+    module GitHub.Data.PublicSSHKeys,
     module GitHub.Data.PullRequests,
     module GitHub.Data.RateLimit,
     module GitHub.Data.Releases,
@@ -81,6 +82,7 @@ import GitHub.Data.Issues
 import GitHub.Data.Milestone
 import GitHub.Data.Name
 import GitHub.Data.Options
+import GitHub.Data.PublicSSHKeys
 import GitHub.Data.PullRequests
 import GitHub.Data.RateLimit
 import GitHub.Data.Releases

src/GitHub/Data/Activities.hs

@@ -12,6 +12,8 @@ import GitHub.Internal.Prelude
 
 import Prelude ()
 
+import qualified Data.Text as T
+
 data RepoStarred = RepoStarred
     { repoStarredStarredAt :: !UTCTime
     , repoStarredRepo      :: !Repo
@@ -65,18 +67,18 @@ 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
+    parseJSON = withText "NotificationReason" $ \t -> case T.toLower 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
+        "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

src/GitHub/Data/Invitation.hs

@@ -8,6 +8,8 @@ module GitHub.Data.Invitation where
 import GitHub.Data.Definitions
 import GitHub.Data.Id          (Id)
 import GitHub.Data.Name        (Name)
+import GitHub.Data.Repos       (Repo)
+import GitHub.Data.URL         (URL)
 import GitHub.Internal.Prelude
 import Prelude ()
 
@@ -57,3 +59,29 @@ instance FromJSON InvitationRole where
         "hiring_manager"  -> pure InvitationRoleHiringManager
         "reinstate"       -> pure InvitationRoleReinstate
         _                 -> fail $ "Unknown InvitationRole: " <> T.unpack t
+
+data RepoInvitation = RepoInvitation
+    { repoInvitationId         :: !(Id RepoInvitation)
+    , repoInvitationInvitee    :: !SimpleUser
+    , repoInvitationInviter    :: !SimpleUser
+    , repoInvitationRepo       :: !Repo
+    , repoInvitationUrl        :: !URL
+    , repoInvitationCreatedAt  :: !UTCTime
+    , repoInvitationPermission :: !Text
+    , repoInvitationHtmlUrl    :: !URL
+    }
+  deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData RepoInvitation where rnf = genericRnf
+instance Binary RepoInvitation
+
+instance FromJSON RepoInvitation where
+    parseJSON = withObject "RepoInvitation" $ \o -> RepoInvitation
+        <$> o .: "id"
+        <*> o .: "invitee"
+        <*> o .: "inviter"
+        <*> o .: "repository"
+        <*> o .: "url"
+        <*> o .: "created_at"
+        <*> o .: "permissions"
+        <*> o .: "html_url"