Skip to content

Commit 1604fd7

Browse files
nhibberdnhibberd
committed
Adding branch protections
1 parent 2629dc1 commit 1604fd7

7 files changed

Lines changed: 99 additions & 13 deletions

File tree

‎Github/Data/Definitions.hs‎

Lines changed: 33 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -265,7 +265,7 @@ data EventType =
265265
| Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened.
266266
| Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged.
267267
| Assigned -- ^ The issue was assigned to the actor.
268-
| 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.
268+
| 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.
269269
| Reopened -- ^ The issue was reopened by the actor.
270270
deriving (Show, Data, Typeable, Eq, Ord)
271271

@@ -487,3 +487,35 @@ data Hook = Hook {
487487
,hookCreatedAt :: GithubDate
488488
,hookUpdatedAt :: GithubDate
489489
} deriving (Show, Data, Typeable, Eq, Ord)
490+
491+
data Protection =
492+
Protection {
493+
requiredStatusChecks :: Maybe RequiredStatusChecks
494+
, pushRestrictions :: Maybe PushRestrictions
495+
} deriving (Show, Data, Typeable, Eq, Ord)
496+
497+
data RequiredStatusChecks =
498+
RequiredStatusChecks {
499+
enforcementLevel :: EnforcementLevel
500+
, strict :: Bool
501+
, context :: [String]
502+
} deriving (Show, Data, Typeable, Eq, Ord)
503+
504+
data EnforcementLevel =
505+
Everyone
506+
| NotAdmins
507+
deriving (Show, Data, Typeable, Eq, Ord)
508+
509+
data PushRestrictions =
510+
PushRestrictions [User] [Team]
511+
deriving (Show, Data, Typeable, Eq, Ord)
512+
513+
newtype User =
514+
User {
515+
user :: String
516+
} deriving (Show, Data, Typeable, Eq, Ord)
517+
518+
newtype Team =
519+
Team {
520+
team :: String
521+
} deriving (Show, Data, Typeable, Eq, Ord)

‎Github/Private.hs‎

Lines changed: 14 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ githubGet = githubGet' Nothing
3232
githubGet' :: (FromJSON b, Show b) => Maybe GithubAuth -> [String] -> IO (Either Error b)
3333
githubGet' auth paths =
3434
githubAPI (BS.pack "GET")
35+
Nothing
3536
(buildUrl paths)
3637
auth
3738
(Nothing :: Maybe Value)
@@ -42,40 +43,42 @@ githubGetWithQueryString = githubGetWithQueryString' Nothing
4243
githubGetWithQueryString' :: (FromJSON b, Show b) => Maybe GithubAuth -> [String] -> String -> IO (Either Error b)
4344
githubGetWithQueryString' auth paths qs =
4445
githubAPI (BS.pack "GET")
46+
Nothing
4547
(buildUrl paths ++ "?" ++ qs)
4648
auth
4749
(Nothing :: Maybe Value)
4850

4951
githubPost :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b)
5052
githubPost auth paths body =
5153
githubAPI (BS.pack "POST")
54+
Nothing
5255
(buildUrl paths)
5356
(Just auth)
5457
(Just body)
5558

5659
githubPatch :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b)
5760
githubPatch auth paths body =
5861
githubAPI (BS.pack "PATCH")
62+
Nothing
5963
(buildUrl paths)
6064
(Just auth)
6165
(Just body)
6266

63-
6467
githubPut auth paths = do
65-
r <- doHttps "PUT" (buildUrl paths) (Just auth) Nothing
68+
r <- doHttps "PUT" Nothing (buildUrl paths) (Just auth) Nothing
6669
return r
6770

6871
githubPutBody auth paths p = do
69-
r <- doHttps "PUT" (buildUrl paths) (Just auth) $ fmap (RequestBodyLBS . encode) p
72+
r <- doHttps "PUT" Nothing (buildUrl paths) (Just auth) $ fmap (RequestBodyLBS . encode) p
7073
return r
7174

7275
buildUrl :: [String] -> String
7376
buildUrl paths = "https://api.github.com/" ++ intercalate "/" paths
7477

75-
githubAPI :: (ToJSON a, Show a, FromJSON b, Show b) => BS.ByteString -> String
78+
githubAPI :: (ToJSON a, Show a, FromJSON b, Show b) => BS.ByteString -> Maybe BS.ByteString -> String
7679
-> Maybe GithubAuth -> Maybe a -> IO (Either Error b)
77-
githubAPI apimethod url auth body = do
78-
result <- doHttps apimethod url auth (encodeBody body)
80+
githubAPI apimethod mversion url auth body = do
81+
result <- doHttps apimethod mversion url auth (encodeBody body)
7982
case result of
8083
Left e -> return (Left (HTTPConnectionError e))
8184
Right resp -> either Left (\x -> jsonResultToE (LBS.pack (show x))
@@ -106,7 +109,7 @@ githubAPI apimethod url auth body = do
106109
nextJson <- handleBody nextResp
107110
return $ (\(Array x) -> Array (ary <> x))
108111
<$> nextJson)
109-
=<< doHttps apimethod nu auth Nothing
112+
=<< doHttps apimethod mversion nu auth Nothing
110113
handleJson _ gotjson = return (Right gotjson)
111114

112115
getNextUrl l =
@@ -116,21 +119,22 @@ githubAPI apimethod url auth body = do
116119
in Just (Data.List.takeWhile (/= '>') s')
117120
else Nothing
118121

119-
-- doHttps :: Method -> String -> Maybe GithubAuth
122+
-- doHttps :: Method -> Maybe ByteString -> String -> Maybe GithubAuth
120123
-- -> Maybe (RequestBody (ResourceT IO))
121124
-- -> IO (Either E.SomeException (Response LBS.ByteString))
122-
doHttps reqMethod url auth body = do
125+
doHttps reqMethod mversion url auth body = do
123126
let reqBody = fromMaybe (RequestBodyBS $ BS.pack "") body
124127
reqHeaders = maybe [] getOAuth auth
125128
Just uri = parseUrl url
129+
version = maybe "application/vnd.github.preview" id mversion
126130
request = uri { method = reqMethod
127131
, secure = True
128132
, port = 443
129133
, requestBody = reqBody
130134
, responseTimeout = Just 20000000
131135
, requestHeaders = reqHeaders <>
132136
[("User-Agent", "github.hs/0.7.4")]
133-
<> [("Accept", "application/vnd.github.preview")]
137+
<> [("Accept", version)]
134138
, checkStatus = successOrMissing
135139
}
136140
authRequest = getAuthRequest auth request

‎Github/Repos.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -302,7 +302,7 @@ deleteRepo :: GithubAuth
302302
-> String -- ^ repository name
303303
-> IO (Either Error ())
304304
deleteRepo auth owner repo = do
305-
result <- doHttps "DELETE" url (Just auth) Nothing
305+
result <- doHttps "DELETE" Nothing url (Just auth) Nothing
306306
case result of
307307
Left e -> return (Left (HTTPConnectionError e))
308308
Right resp ->

‎Github/Repos/Branches.hs‎

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
-- | The repo starring API as described on
3+
-- <http://developer.github.com/v3/repos/hooks/>.
4+
module Github.Repos.Branches (
5+
) where
6+
7+
import Data.Aeson
8+
import qualified Data.ByteString.Char8 as BS
9+
10+
import Github.Data
11+
import Github.Private
12+
13+
import qualified Network.HTTP.Conduit as C (responseStatus)
14+
import qualified Network.HTTP.Types as T (statusCode)
15+
16+
17+
-- https://developer.github.com/v3/repos/branches/#update-branch-protection
18+
--protect :: GithubAuth -> String -> String -> String -> Protection -> IO (Either SomeException ())
19+
protect auth userName reqRepoName branch protection = do
20+
githubPutBody
21+
auth
22+
["repos", userName, reqRepoName, "branches", branch, "protection"]
23+
protection
24+
25+
instance ToJSON Protection where
26+
toJSON (Protection r p) =
27+
object [
28+
("required_status_checks", maybeOrNull r $ \(RequiredStatusChecks e s c) ->
29+
object [
30+
"include_admins" .= case e of { Everyone -> True; NotAdmins -> False }
31+
, "strict" .= s
32+
, "contexts" .= toJSON c
33+
])
34+
, ("restrictions", maybeOrNull p $ \(PushRestrictions us ts) ->
35+
object [
36+
"users" .= toJSON (fmap user us)
37+
, "teams" .= toJSON (fmap team ts)
38+
])
39+
]
40+
41+
maybeOrNull :: Maybe a -> (a -> Value) -> Value
42+
maybeOrNull m f =
43+
case m of
44+
Nothing ->
45+
Null
46+
Just a ->
47+
f a

‎Github/Repos/Collaborators.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ collaboratorsOn userName reqRepoName =
2929
isCollaboratorOn :: String -> String -> String -> IO (Either Error Bool)
3030
isCollaboratorOn userName repoOwnerName reqRepoName = do
3131
result <- doHttps (pack "GET")
32+
Nothing
3233
(buildUrl ["repos", repoOwnerName, reqRepoName, "collaborators", userName])
3334
Nothing
3435
Nothing
@@ -40,6 +41,7 @@ isCollaboratorOn userName repoOwnerName reqRepoName = do
4041
removeCollaborator :: String -> String -> String -> IO (Either Error Bool)
4142
removeCollaborator userName repoOwnerName reqRepoName = do
4243
result <- doHttps (pack "DELETE")
44+
Nothing
4345
(buildUrl ["repos", repoOwnerName, reqRepoName, "collaborators", userName])
4446
Nothing
4547
Nothing

‎Github/Repos/Hooks.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -56,4 +56,4 @@ jinS _ Nothing = []
5656

5757
jinB :: String -> Maybe Bool -> [(Text, Value)]
5858
jinB k (Just x) = [(pack k, Bool x)]
59-
jinB _ Nothing = []
59+
jinB _ Nothing = []

‎github.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -132,6 +132,7 @@ Library
132132
Github.Organizations.Members,
133133
Github.PullRequests,
134134
Github.Repos,
135+
Github.Repos.Branches,
135136
Github.Repos.Collaborators,
136137
Github.Repos.Commits,
137138
Github.Repos.Forks,

0 commit comments

Comments
 (0)