Skip to content

Commit 342a4e5

Browse files
adarquiadarqui
committed
This commit implements most of the "teams api".Some requests marked deprecated
were not implemented. A few new functions were created to support these requests: githubPut, githubDelete. All of the samples have been tested and are working at the time of this commit. A few requests were not implemented because they depend on a specific header being set: application/vnd.github.ironman-preview+json; this header is needed until the v3 api becomes the law of the land, apparently. Teams API reference: https://developer.github.com/v3/orgs/teams
1 parent 97ff002 commit 342a4e5

17 files changed

Lines changed: 553 additions & 4 deletions

‎Github/Data.hs‎

Lines changed: 116 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -650,6 +650,122 @@ instance FromJSON DetailedOwner where
650650
<*> o .: "login"
651651
parseJSON _ = fail "Could not build a DetailedOwner"
652652

653+
instance FromJSON Privacy where
654+
parseJSON (String attr) =
655+
case attr of
656+
"secret" -> return PrivacySecret
657+
"closed" -> return PrivacyClosed
658+
_ -> fail "Unknown Privacy Attribute"
659+
parseJSON _ = fail "Could not build Privacy"
660+
661+
instance ToJSON Privacy where
662+
toJSON attr =
663+
String $
664+
case attr of
665+
PrivacySecret -> "secret"
666+
PrivacyClosed -> "closed"
667+
668+
instance FromJSON Permission where
669+
parseJSON (String attr) =
670+
case attr of
671+
"pull" -> return PermissionPull
672+
"push" -> return PermissionPush
673+
"admin" -> return PermissionAdmin
674+
_ -> fail "Unknown Permission Attribute"
675+
parseJSON _ = fail "Could not build Permission"
676+
677+
instance ToJSON Permission where
678+
toJSON attr =
679+
String $
680+
case attr of
681+
PermissionPull -> "pull"
682+
PermissionPush -> "push"
683+
PermissionAdmin -> "admin"
684+
685+
instance FromJSON Team where
686+
parseJSON (Object o) =
687+
Team <$> o .: "id"
688+
<*> o .: "url"
689+
<*> o .: "name"
690+
<*> o .: "slug"
691+
<*> o .:?"description" .!= Nothing
692+
<*> o .:?"privacy" .!= Nothing
693+
<*> o .: "permission"
694+
<*> o .: "members_url"
695+
<*> o .: "repositories_url"
696+
parseJSON _ = fail "Could not build Team"
697+
698+
instance FromJSON DetailedTeam where
699+
parseJSON (Object o) =
700+
DetailedTeam <$> o .: "id"
701+
<*> o .: "url"
702+
<*> o .: "name"
703+
<*> o .: "slug"
704+
<*> o .:?"description" .!= Nothing
705+
<*> o .:?"privacy" .!= Nothing
706+
<*> o .: "permission"
707+
<*> o .: "members_url"
708+
<*> o .: "repositories_url"
709+
<*> o .: "members_count"
710+
<*> o .: "repos_count"
711+
<*> o .: "organization"
712+
parseJSON _ = fail "Could not build a DetailedTeam"
713+
714+
instance ToJSON CreateTeam where
715+
toJSON (CreateTeam name desc repo_names {-privacy-} permissions) =
716+
object [ "name" .= name
717+
, "description" .= desc
718+
, "repo_names" .= repo_names
719+
{-, "privacy" .= privacy-}
720+
, "permissions" .= permissions ]
721+
722+
instance ToJSON EditTeam where
723+
toJSON (EditTeam name desc {-privacy-} permissions) =
724+
object [ "name" .= name
725+
, "description" .= desc
726+
{-, "privacy" .= privacy-}
727+
, "permissions" .= permissions ]
728+
729+
instance FromJSON Role where
730+
parseJSON (String attr) =
731+
case attr of
732+
"maintainer" -> return RoleMaintainer
733+
"member" -> return RoleMember
734+
_ -> fail "Unknown Role"
735+
parseJSON _ = fail "Could not build Role"
736+
737+
instance ToJSON Role where
738+
toJSON RoleMaintainer = String "maintainer"
739+
toJSON RoleMember = String "member"
740+
741+
instance FromJSON ReqState where
742+
parseJSON (String attr) =
743+
case attr of
744+
"active" -> return StateActive
745+
"pending" -> return StatePending
746+
_ -> fail "Unknown ReqState"
747+
parseJSON _ = fail "Could not build ReqState"
748+
749+
instance ToJSON ReqState where
750+
toJSON StateActive = String "active"
751+
toJSON StatePending = String "pending"
752+
753+
instance FromJSON TeamMembership where
754+
parseJSON (Object o) =
755+
TeamMembership <$> o .: "url"
756+
<*> o .: "role"
757+
<*> o .: "state"
758+
parseJSON _ = fail "Could not build TeamMembership"
759+
760+
instance FromJSON CreateTeamMembership where
761+
parseJSON (Object o) =
762+
CreateTeamMembership <$> o .: "role"
763+
parseJSON _ = fail "Could not build CreateTeamMembership"
764+
765+
instance ToJSON CreateTeamMembership where
766+
toJSON (CreateTeamMembership { createTeamMembershipRole = role }) =
767+
object [ "role" .= role ]
768+
653769
instance FromJSON RepoWebhook where
654770
parseJSON (Object o) =
655771
RepoWebhook <$> o .: "url"

‎Github/Data/Definitions.hs‎

Lines changed: 94 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -335,7 +335,7 @@ data EventType =
335335
| Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened.
336336
| Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged.
337337
| Assigned -- ^ The issue was assigned to the actor.
338-
| Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax.
338+
| Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax.
339339
| Reopened -- ^ The issue was reopened by the actor.
340340
| ActorUnassigned -- ^ The issue was unassigned to the actor
341341
| Labeled -- ^ A label was added to the issue.
@@ -770,3 +770,96 @@ data EditPullRequestState =
770770
deriving (Show, Generic)
771771

772772
instance NFData EditPullRequestState
773+
774+
data Privacy =
775+
PrivacyClosed
776+
| PrivacySecret
777+
deriving (Show, Data, Typeable, Eq, Ord, Generic)
778+
779+
instance NFData Privacy
780+
781+
data Permission =
782+
PermissionPull
783+
| PermissionPush
784+
| PermissionAdmin
785+
deriving (Show, Data, Typeable, Eq, Ord, Generic)
786+
787+
instance NFData Permission
788+
789+
data Team = Team {
790+
teamId :: Int
791+
,teamUrl :: String
792+
,teamName :: String
793+
,teamSlug :: String
794+
,teamDescription :: Maybe String
795+
,teamPrivacy :: Maybe Privacy
796+
,teamPermission :: Permission
797+
,teamMembersUrl :: String
798+
,teamRepositoriesUrl :: String
799+
} deriving (Show, Data, Typeable, Eq, Ord, Generic)
800+
801+
instance NFData Team
802+
803+
data DetailedTeam = DetailedTeam {
804+
detailedTeamId :: Int
805+
,detailedTeamUrl :: String
806+
,detailedTeamName :: String
807+
,detailedTeamSlug :: String
808+
,detailedTeamDescription :: Maybe String
809+
,detailedTeamPrivacy :: Maybe Privacy
810+
,detailedTeamPermission :: Permission
811+
,detailedTeamMembersUrl :: String
812+
,detailedTeamRepositoriesUrl :: String
813+
,detailedTeamMembersCount :: Int
814+
,detailedTeamReposCount :: Int
815+
,detailedTeamOrganization :: GithubOwner
816+
} deriving (Show, Data, Typeable, Eq, Ord, Generic)
817+
818+
instance NFData DetailedTeam
819+
820+
data CreateTeam = CreateTeam {
821+
createTeamName :: String
822+
,createTeamDescription :: Maybe String
823+
,createRepoNames :: [String]
824+
{-,createTeamPrivacy :: Privacy-}
825+
,createTeamPermission :: Permission
826+
} deriving (Show, Data, Typeable, Eq, Ord, Generic)
827+
828+
instance NFData CreateTeam
829+
830+
data EditTeam = EditTeam {
831+
editTeamName :: String
832+
,editTeamDescription :: Maybe String
833+
{-,editTeamPrivacy :: Privacy-}
834+
,editTeamPermission :: Permission
835+
} deriving (Show, Data, Typeable, Eq, Ord, Generic)
836+
837+
instance NFData EditTeam
838+
839+
data Role =
840+
RoleMaintainer
841+
| RoleMember
842+
deriving (Show, Data, Typeable, Eq, Ord, Generic)
843+
844+
instance NFData Role
845+
846+
data ReqState =
847+
StatePending
848+
| StateActive
849+
deriving (Show, Data, Typeable, Eq, Ord, Generic)
850+
851+
instance NFData ReqState
852+
853+
data TeamMembership = TeamMembership {
854+
teamMembershipUrl :: String,
855+
teamMembershipRole :: Role,
856+
teamMembershipReqState :: ReqState
857+
} deriving (Show, Data, Typeable, Eq, Ord, Generic)
858+
859+
instance NFData TeamMembership
860+
861+
data CreateTeamMembership = CreateTeamMembership {
862+
createTeamMembershipRole :: Role
863+
} deriving (Show, Data, Typeable, Eq, Ord, Generic)
864+
865+
instance NFData CreateTeamMembership

‎Github/Organizations/Teams.hs‎

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
-- | The organization teams API as described on
2+
-- <http://developer.github.com/v3/orgs/teams/>.
3+
module Github.Organizations.Teams (
4+
teamsOf
5+
,teamsOf'
6+
,module Github.Data
7+
) where
8+
9+
import Github.Data
10+
import Github.Private
11+
12+
-- | List the teams of an organization.
13+
-- | When authenticated, lists private teams visible to the authenticated user.
14+
-- | When unauthenticated, lists only public teams for an organization.
15+
--
16+
-- > teamsOf' (Just $ GithubOAuth "token") "thoughtbot"
17+
teamsOf' :: Maybe GithubAuth -> String -> IO (Either Error [Team])
18+
teamsOf' auth organization = githubGet' auth ["orgs", organization, "teams"]
19+
20+
-- | List the public teams of an organization.
21+
--
22+
-- > teamsOf "thoughtbot"
23+
teamsOf :: String -> IO (Either Error [Team])
24+
teamsOf = teamsOf' Nothing

‎Github/Private.hs‎

Lines changed: 41 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -72,6 +72,17 @@ githubPatch auth paths body =
7272
(Just auth)
7373
(Just body)
7474

75+
githubPut :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b)
76+
githubPut auth paths body =
77+
githubAPI (BS.pack "PUT")
78+
(buildPath paths)
79+
(Just auth)
80+
(Just body)
81+
82+
githubDelete :: GithubAuth -> [String] -> IO (Either Error ())
83+
githubDelete auth paths =
84+
githubAPIDelete auth (buildPath paths)
85+
7586
apiEndpoint :: Maybe GithubAuth -> String
7687
apiEndpoint (Just (GithubEnterpriseOAuth endpoint _)) = endpoint
7788
apiEndpoint _ = "https://api.github.com"
@@ -127,7 +138,7 @@ doHttps :: BS.ByteString
127138
-> [Char]
128139
-> Maybe GithubAuth
129140
-> Maybe RequestBody
130-
-> IO (Either E.SomeException (Response LBS.ByteString))
141+
-> IO (Either E.SomeException (Response LBS.ByteString))
131142
doHttps reqMethod url auth body = do
132143
let reqBody = fromMaybe (RequestBodyBS $ BS.pack "") body
133144
reqHeaders = maybe [] getOAuth auth
@@ -209,3 +220,32 @@ jsonResultToE jsonString result = case result of
209220
parseJson :: (FromJSON b, Show b) => LBS.ByteString -> Either Error b
210221
parseJson jsonString = either Left (jsonResultToE jsonString . fromJSON)
211222
(parseJsonRaw jsonString)
223+
224+
-- | Generically delete something
225+
--
226+
-- > githubApiDelete (GithubBasicAuth (user, password)) ["some", "path"]
227+
githubAPIDelete :: GithubAuth
228+
-> String -- ^ paths
229+
-> IO (Either Error ())
230+
githubAPIDelete auth paths = do
231+
result <- doHttps "DELETE"
232+
(apiEndpoint (Just auth) ++ paths)
233+
(Just auth)
234+
Nothing
235+
case result of
236+
Left e -> return (Left (HTTPConnectionError e))
237+
Right resp ->
238+
let status = responseStatus resp
239+
headers = responseHeaders resp
240+
in if status == notFound404
241+
-- doHttps silently absorbs 404 errors, but for this operation
242+
-- we want the user to know if they've tried to delete a
243+
-- non-existent repository
244+
then return (Left (HTTPConnectionError
245+
(E.toException
246+
(StatusCodeException status headers
247+
#if MIN_VERSION_http_conduit(1, 9, 0)
248+
(responseCookieJar resp)
249+
#endif
250+
))))
251+
else return (Right ())

‎Github/Teams.hs‎

Lines changed: 64 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,64 @@
1+
module Github.Teams (
2+
teamInfoFor
3+
,teamInfoFor'
4+
,teamsInfo'
5+
,createTeamFor'
6+
,editTeam'
7+
,deleteTeam'
8+
,listTeamsCurrent'
9+
,module Github.Data
10+
) where
11+
12+
import Github.Data
13+
import Github.Private
14+
15+
-- | The information for a single team, by team id.
16+
-- | With authentication
17+
--
18+
-- > teamInfoFor' (Just $ GithubOAuth "token") 1010101
19+
teamInfoFor' :: Maybe GithubAuth -> Int -> IO (Either Error DetailedTeam)
20+
teamInfoFor' auth team_id = githubGet' auth ["teams", show team_id]
21+
22+
-- | The information for a single team, by team id.
23+
--
24+
-- > teamInfoFor' (Just $ GithubOAuth "token") 1010101
25+
teamInfoFor :: Int -> IO (Either Error DetailedTeam)
26+
teamInfoFor = teamInfoFor' Nothing
27+
28+
-- | Lists all teams, across all organizations, that the current user belongs to.
29+
--
30+
-- > teamsInfo' (Just $ GithubOAuth "token")
31+
teamsInfo' :: Maybe GithubAuth -> IO (Either Error [DetailedTeam])
32+
teamsInfo' auth = githubGet' auth ["user", "teams"]
33+
34+
-- | Create a team under an organization
35+
--
36+
-- > createTeamFor' (GithubOAuth "token") "organization" (CreateTeam "newteamname" "some description" [] PermssionPull)
37+
createTeamFor' :: GithubAuth
38+
-> String
39+
-> CreateTeam
40+
-> IO (Either Error DetailedTeam)
41+
createTeamFor' auth organization create_team =
42+
githubPost auth ["orgs", organization, "teams"] create_team
43+
44+
-- | Edit a team, by id.
45+
--
46+
-- > editTeamFor'
47+
editTeam' :: GithubAuth
48+
-> Int
49+
-> EditTeam
50+
-> IO (Either Error DetailedTeam)
51+
editTeam' auth team_id edit_team =
52+
githubPatch auth ["teams", show team_id] edit_team
53+
54+
-- | Delete a team, by id.
55+
--
56+
-- > deleteTeam' (GithubOAuth "token") 1010101
57+
deleteTeam' :: GithubAuth -> Int -> IO (Either Error ())
58+
deleteTeam' auth team_id = githubDelete auth ["teams", show team_id]
59+
60+
-- | List teams for current authenticated user
61+
--
62+
-- > listTeamsCurrent' (GithubOAuth "token")
63+
listTeamsCurrent' :: GithubAuth -> IO (Either Error [DetailedTeam])
64+
listTeamsCurrent' auth = githubGet' (Just auth) ["user", "teams"]

0 commit comments

Comments
 (0)