Skip to content

Commit 8b31817

Browse files
toddmohneyphadej
authored andcommitted
Implement interface to GitHub's SSH public key API
1 parent ec65aae commit 8b31817

5 files changed

Lines changed: 191 additions & 0 deletions

File tree

github.cabal

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -87,6 +87,7 @@ library
8787
GitHub.Data.Milestone
8888
GitHub.Data.Name
8989
GitHub.Data.Options
90+
GitHub.Data.PublicSSHKeys
9091
GitHub.Data.PullRequests
9192
GitHub.Data.RateLimit
9293
GitHub.Data.Releases
@@ -137,6 +138,7 @@ library
137138
GitHub.Endpoints.Users
138139
GitHub.Endpoints.Users.Emails
139140
GitHub.Endpoints.Users.Followers
141+
GitHub.Endpoints.Users.PublicSSHKeys
140142
GitHub.Internal.Prelude
141143
GitHub.Request
142144

@@ -194,6 +196,7 @@ test-suite github-test
194196
GitHub.IssuesSpec
195197
GitHub.OrganizationsSpec
196198
GitHub.PullRequestReviewsSpec
199+
GitHub.PublicSSHKeysSpec
197200
GitHub.PullRequestsSpec
198201
GitHub.RateLimitSpec
199202
GitHub.ReleasesSpec

spec/GitHub/PublicSSHKeysSpec.hs

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE TemplateHaskell #-}
3+
module GitHub.PublicSSHKeysSpec where
4+
5+
import GitHub (Auth (..), PublicSSHKeyBasic (..), PublicSSHKey (..),
6+
executeRequest, repositoryR)
7+
import GitHub.Endpoints.Users.PublicSSHKeys (publicSSHKeysFor', publicSSHKeys',
8+
publicSSHKey')
9+
10+
import Data.Either.Compat (isRight)
11+
import Data.String (fromString)
12+
import System.Environment (lookupEnv)
13+
import Test.Hspec (Spec, describe, it, pendingWith, shouldBe,
14+
shouldSatisfy)
15+
16+
import qualified Data.HashMap.Strict as HM
17+
import qualified Data.Vector as V
18+
19+
fromRightS :: Show a => Either a b -> b
20+
fromRightS (Right b) = b
21+
fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a
22+
23+
withAuth :: (Auth -> IO ()) -> IO ()
24+
withAuth action = do
25+
mtoken <- lookupEnv "GITHUB_TOKEN"
26+
case mtoken of
27+
Nothing -> pendingWith "no GITHUB_TOKEN"
28+
Just token -> action (OAuth $ fromString token)
29+
30+
spec :: Spec
31+
spec = do
32+
describe "publicSSHKeysFor'" $ do
33+
it "works" $ do
34+
keys <- publicSSHKeysFor' "phadej"
35+
V.length (fromRightS keys) `shouldSatisfy` (> 1)
36+
37+
describe "publicSSHKeys' and publicSSHKey'" $ do
38+
it "works" $ withAuth $ \auth -> do
39+
keys <- publicSSHKeys' auth
40+
V.length (fromRightS keys) `shouldSatisfy` (> 1)
41+
42+
key <- publicSSHKey' auth (publicSSHKeyId $ V.head (fromRightS keys))
43+
key `shouldSatisfy` isRight

src/GitHub/Data.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -48,6 +48,7 @@ module GitHub.Data (
4848
module GitHub.Data.Issues,
4949
module GitHub.Data.Milestone,
5050
module GitHub.Data.Options,
51+
module GitHub.Data.PublicSSHKeys,
5152
module GitHub.Data.PullRequests,
5253
module GitHub.Data.RateLimit,
5354
module GitHub.Data.Releases,
@@ -81,6 +82,7 @@ import GitHub.Data.Issues
8182
import GitHub.Data.Milestone
8283
import GitHub.Data.Name
8384
import GitHub.Data.Options
85+
import GitHub.Data.PublicSSHKeys
8486
import GitHub.Data.PullRequests
8587
import GitHub.Data.RateLimit
8688
import GitHub.Data.Releases

src/GitHub/Data/PublicSSHKeys.hs

Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
-----------------------------------------------------------------------------
2+
-- |
3+
-- License : BSD-3-Clause
4+
-- Maintainer : Todd Mohney <toddmohney@gmail.com>
5+
--
6+
module GitHub.Data.PublicSSHKeys where
7+
8+
import GitHub.Data.Id (Id)
9+
import GitHub.Data.URL (URL)
10+
import GitHub.Internal.Prelude
11+
import Prelude ()
12+
13+
data PublicSSHKeyBasic = PublicSSHKeyBasic
14+
{ basicPublicSSHKeyId :: !(Id PublicSSHKey)
15+
, basicPublicSSHKeyKey :: !Text
16+
}
17+
deriving (Show, Data, Typeable, Eq, Ord, Generic)
18+
19+
instance FromJSON PublicSSHKeyBasic where
20+
parseJSON = withObject "PublicSSHKeyBasic" $ \o -> PublicSSHKeyBasic
21+
<$> o .: "id"
22+
<*> o .: "key"
23+
24+
data PublicSSHKey = PublicSSHKey
25+
{ publicSSHKeyId :: !(Id PublicSSHKey)
26+
, publicSSHKeyKey :: !Text
27+
, publicSSHKeyUrl :: !URL
28+
, publicSSHKeyTitle :: !Text
29+
, publicSSHKeyVerified :: !Bool
30+
, publicSSHKeyCreatedAt :: !UTCTime
31+
, publicSSHKeyReadOnly :: !Bool
32+
}
33+
deriving (Show, Data, Typeable, Eq, Ord, Generic)
34+
35+
instance FromJSON PublicSSHKey where
36+
parseJSON = withObject "PublicSSHKey" $ \o -> PublicSSHKey
37+
<$> o .: "id"
38+
<*> o .: "key"
39+
<*> o .: "url"
40+
<*> o .: "title"
41+
<*> o .: "verified"
42+
<*> o .: "created_at"
43+
<*> o .: "read_only"
44+
45+
data NewPublicSSHKey = NewPublicSSHKey
46+
{ newPublicSSHKeyKey :: !Text
47+
, newPublicSSHKeyTitle :: !Text
48+
}
49+
deriving (Show, Data, Typeable, Eq, Ord, Generic)
50+
51+
instance ToJSON NewPublicSSHKey where
52+
toJSON (NewPublicSSHKey key title) = object
53+
[ "key" .= key
54+
, "title" .= title
55+
]
56+
57+
instance FromJSON NewPublicSSHKey where
58+
parseJSON = withObject "PublicSSHKey" $ \o -> NewPublicSSHKey
59+
<$> o .: "key"
60+
<*> o .: "title"
Lines changed: 83 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,83 @@
1+
-----------------------------------------------------------------------------
2+
-- |
3+
-- License : BSD-3-Clause
4+
-- Maintainer : Todd Mohney <toddmohney@gmail.com>
5+
--
6+
-- The public keys API, as described at
7+
-- <https://developer.github.com/v3/users/keys/>
8+
module GitHub.Endpoints.Users.PublicSSHKeys (
9+
-- * Querying public SSH keys
10+
publicSSHKeys',
11+
publicSSHKeysR,
12+
publicSSHKeysFor',
13+
publicSSHKeysForR,
14+
publicSSHKey',
15+
publicSSHKeyR,
16+
17+
-- ** Create
18+
createUserPublicSSHKey',
19+
createUserPublicSSHKeyR,
20+
21+
-- ** Delete
22+
deleteUserPublicSSHKey',
23+
deleteUserPublicSSHKeyR,
24+
) where
25+
26+
import GitHub.Data
27+
import GitHub.Internal.Prelude
28+
import GitHub.Request
29+
import Prelude ()
30+
31+
-- | Querying public SSH keys.
32+
publicSSHKeysFor' :: Name Owner -> IO (Either Error (Vector PublicSSHKeyBasic))
33+
publicSSHKeysFor' user =
34+
executeRequest' $ publicSSHKeysForR user FetchAll
35+
36+
-- | Querying public SSH keys.
37+
-- See <https://developer.github.com/v3/users/keys/#list-public-keys-for-a-user>
38+
publicSSHKeysForR :: Name Owner -> FetchCount -> Request 'RO (Vector PublicSSHKeyBasic)
39+
publicSSHKeysForR user =
40+
pagedQuery ["users", toPathPart user, "keys"] []
41+
42+
-- | Querying the authenticated users' public SSH keys
43+
publicSSHKeys' :: Auth -> IO (Either Error (Vector PublicSSHKey))
44+
publicSSHKeys' auth =
45+
executeRequest auth publicSSHKeysR
46+
47+
-- | Querying the authenticated users' public SSH keys
48+
-- See <https://developer.github.com/v3/users/keys/#list-your-public-keys>
49+
publicSSHKeysR :: Request 'RA (Vector PublicSSHKey)
50+
publicSSHKeysR =
51+
query ["user", "keys"] []
52+
53+
-- | Querying a public SSH key
54+
publicSSHKey' :: Auth -> Id PublicSSHKey -> IO (Either Error PublicSSHKey)
55+
publicSSHKey' auth keyId =
56+
executeRequest auth $ publicSSHKeyR keyId
57+
58+
-- | Querying a public SSH key.
59+
-- See <https://developer.github.com/v3/users/keys/#get-a-single-public-key>
60+
publicSSHKeyR :: Id PublicSSHKey -> Request 'RA PublicSSHKey
61+
publicSSHKeyR keyId =
62+
query ["user", "keys", toPathPart keyId] []
63+
64+
-- | Create a public SSH key
65+
createUserPublicSSHKey' :: Auth -> NewPublicSSHKey -> IO (Either Error PublicSSHKey)
66+
createUserPublicSSHKey' auth key =
67+
executeRequest auth $ createUserPublicSSHKeyR key
68+
69+
-- | Create a public SSH key.
70+
-- See <https://developer.github.com/v3/users/keys/#create-a-public-key>.
71+
createUserPublicSSHKeyR :: NewPublicSSHKey -> Request 'RW PublicSSHKey
72+
createUserPublicSSHKeyR key =
73+
command Post ["user", "keys"] (encode key)
74+
75+
deleteUserPublicSSHKey' :: Auth -> Id PublicSSHKey -> IO (Either Error ())
76+
deleteUserPublicSSHKey' auth keyId =
77+
executeRequest auth $ deleteUserPublicSSHKeyR keyId
78+
79+
-- | Delete a public SSH key.
80+
-- See <https://developer.github.com/v3/users/keys/#delete-a-public-key>
81+
deleteUserPublicSSHKeyR :: Id PublicSSHKey -> Request 'RW ()
82+
deleteUserPublicSSHKeyR keyId =
83+
command Delete ["user", "keys", toPathPart keyId] mempty

0 commit comments

Comments
 (0)