diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 Justin Leitgeb + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/octohat.cabal b/octohat.cabal --- a/octohat.cabal +++ b/octohat.cabal @@ -1,7 +1,9 @@ Name: octohat Synopsis: A tested, minimal wrapper around GitHub's API. -Version: 0.1.2 +Description: A tested, minimal wrapper around GitHub's API. +Version: 0.1.3 License: MIT +License-file: LICENSE Author: Stack Builders Maintainer: hackage@stackbuilders.com Stability: Experimental @@ -16,8 +18,8 @@ Build-depends: aeson == 0.8.* - , base >= 4.5 && < 4.8 - , base-compat == 0.5.* + , base >= 4.4 && < 4.8 + , base-compat == 0.6.* , base16-bytestring == 0.1.1.* , base64-bytestring == 1.0.* , bytestring >= 0.9 @@ -26,9 +28,10 @@ , dotenv == 0.1.* , either == 4.3.* , errors == 1.4.* + , ghc-prim >= 0.2 , http-client == 0.4.* , http-types == 0.8.* - , lens >= 4.0 && <= 4.7 + , lens >= 4.0 && <= 4.7.0.1 , mtl == 2.* , text == 1.2.* , time == 1.4.* @@ -47,13 +50,29 @@ default-language: Haskell2010 +Executable abc + hs-source-dirs: src-demo + main-is: Web/GitHub/CLI/Main.hs + + Build-depends: + aeson ==0.8.0.*, + base >=4.4 && <4.8, + text ==1.2.0.*, + optparse-applicative ==0.11.0.*, + octohat ==0.1.2, + utf8-string >=0.3 && <=1, + yaml ==0.8.10.* + + default-language: Haskell2010 + ghc-options: -threaded -Wall + test-suite spec ghc-options : -Wall type : exitcode-stdio-1.0 hs-source-dirs : spec main-is : Spec.hs - build-depends : base >= 4.5 && <4.8 - , base-compat == 0.5.* + build-depends : base >= 4.4 && <4.8 + , base-compat == 0.6.* , hspec == 2.1.* , hspec-expectations == 0.6.* , text == 1.2.* diff --git a/spec/Network/Octohat/TestData.hs b/spec/Network/Octohat/TestData.hs --- a/spec/Network/Octohat/TestData.hs +++ b/spec/Network/Octohat/TestData.hs @@ -5,6 +5,8 @@ , loadTestAccountOne , loadTestAccountTwo , loadTestAccountThree + , loadTestAccountFour + , loadTestRepo , publicKeyFixture , publicKeyHostnameFixture , fingerprintFixture @@ -13,7 +15,7 @@ import Network.Octohat.Types import Network.Octohat (teamForTeamNameInOrg) -import Network.Octohat.Members (userForUsername) +import Network.Octohat.Members (userForUsername, repoForReponame) import Control.Monad.IO.Class (liftIO) import Control.Arrow (second) @@ -27,7 +29,9 @@ organization :: T.Text, accountOne :: T.Text, accountTwo :: T.Text, - accountThree :: T.Text + accountThree :: T.Text, + accountFour :: T.Text, + testRepo :: T.Text } readEnv :: [(String, String)] -> Maybe TestEnvironment @@ -36,6 +40,8 @@ <*> lookup "TEST_ACCOUNT_ONE" env <*> lookup "TEST_ACCOUNT_TWO" env <*> lookup "TEST_ACCOUNT_THREE" env + <*> lookup "TEST_ACCOUNT_FOUR" env + <*> lookup "TEST_REPO" env where env = map (second T.pack) environment loadEnv :: IO TestEnvironment @@ -60,6 +66,15 @@ loadTestAccountThree :: GitHub Member loadTestAccountThree = liftIO (accountThree `fmap` loadEnv) >>= userForUsername + +loadTestAccountFour :: GitHub Member +loadTestAccountFour = liftIO (accountFour `fmap` loadEnv) >>= userForUsername + +loadTestRepo :: GitHub Repo +loadTestRepo = do + org <- liftIO (organization `fmap` loadEnv) + repo <- liftIO (testRepo `fmap` loadEnv) + repoForReponame org repo publicKeyHostnameFixture :: T.Text publicKeyHostnameFixture = "octohat@stackbuilders" diff --git a/src-demo/Web/GitHub/CLI/Main.hs b/src-demo/Web/GitHub/CLI/Main.hs new file mode 100644 --- /dev/null +++ b/src-demo/Web/GitHub/CLI/Main.hs @@ -0,0 +1,32 @@ +module Main where + +import Web.GitHub.CLI.Options +import Web.GitHub.CLI.Actions + +import Options.Applicative +import Network.Octohat.Types (OrganizationName(..), TeamName(..)) +import qualified Data.Text as T (pack) + +accessBotCLI :: TeamOptions -> IO () +accessBotCLI (TeamOptions (ListTeams nameOfOrg)) = + findTeamsInOrganization (OrganizationName $ T.pack nameOfOrg) +accessBotCLI (TeamOptions (ListMembers nameOfOrg nameOfTeam)) = + findMembersInTeam (OrganizationName $ T.pack nameOfOrg) (TeamName $ T.pack nameOfTeam) +accessBotCLI (TeamOptions (AddToTeam nameOfOrg nameOfTeam nameOfUser)) = + addUserToTeamInOrganization nameOfUser + (OrganizationName $ T.pack nameOfOrg) + (TeamName $ T.pack nameOfTeam) +accessBotCLI (TeamOptions (DeleteFromTeam nameOfOrg nameOfTeam nameOfUser)) = + deleteUserFromTeamInOrganization nameOfUser + (OrganizationName $ T.pack nameOfOrg) + (TeamName $ T.pack nameOfTeam) + +main :: IO () +main = execParser argumentsParser >>= accessBotCLI + +argumentsParser :: ParserInfo TeamOptions +argumentsParser = info (helper <*> teamOptions) + (fullDesc + <> progDesc "GitHub client to manage teams. Please specify your token as GITHUB_TOKEN" + <> header "Some options" + ) diff --git a/src/Network/Octohat/Members.hs b/src/Network/Octohat/Members.hs --- a/src/Network/Octohat/Members.hs +++ b/src/Network/Octohat/Members.hs @@ -4,14 +4,18 @@ module Network.Octohat.Members ( membersForOrganization - , membersForTeam , teamsForOrganization + , membersForTeam + , reposForTeam , addMemberToTeam + , addRepoToTeam , deleteMemberFromTeam , deleteTeamFromOrganization , publicKeysForUser , addTeamToOrganization + , organizations , userForUsername + , repoForReponame , addPublicKey ) where @@ -25,10 +29,11 @@ -- and creates a new team. Regular GitHub authorization/authentication applies. addTeamToOrganization :: TeamName -- ^ Name of new team -> T.Text -- ^ Description of new team + -> TeamPermission -- ^ Permission setting for team (push, pull, or admin) -> OrganizationName -- ^ Organization name where the team will be created -> GitHub Team -addTeamToOrganization (TeamName nameOfNewTeam) descOfTeam (OrganizationName orgName) = - postRequestTo (composeEndpoint ["orgs", orgName, "teams"]) (TeamCreateRequest nameOfNewTeam descOfTeam) +addTeamToOrganization (TeamName nameOfNewTeam) descOfTeam teamPerm (OrganizationName org) = + postRequestTo (composeEndpoint ["orgs", org, "teams"]) (TeamCreateRequest nameOfNewTeam descOfTeam teamPerm) -- | Deletes a team from an organization using its team ID. deleteTeamFromOrganization :: Integer -- ^ ID of Team to delete @@ -45,11 +50,20 @@ -> GitHub [Member] membersForTeam idOfTeam = getRequestTo (composeEndpoint ["teams", T.pack $ show idOfTeam, "members"]) +-- | Returns a list of repos of a team with the given team ID. +reposForTeam :: Integer -- ^ The team ID + -> GitHub [Repo] +reposForTeam idOfTeam = getRequestTo (composeEndpoint ["teams", T.pack $ show idOfTeam, "repos"]) + -- | Returns a list of teams for the organization with the given name teamsForOrganization :: OrganizationName -- ^ The organization name -> GitHub [Team] teamsForOrganization (OrganizationName nameOfOrg) = getRequestTo (composeEndpoint ["orgs", nameOfOrg, "teams"]) +-- | Returns a list of all organizations for the user +organizations :: GitHub [Organization] +organizations = getRequestTo (composeEndpoint ["user", "orgs"]) + -- | Adds a member to a team, might invite or add the member. Refer to 'StatusInTeam' addMemberToTeam :: T.Text -- ^ The GitHub username to add to a team -> Integer -- ^ The Team ID @@ -57,6 +71,14 @@ addMemberToTeam nameOfUser idOfTeam = putRequestTo (composeEndpoint ["teams", T.pack $ show idOfTeam, "memberships", nameOfUser]) +-- | Adds a repo to a team, might invite or add the member. Refer to 'StatusInTeam' +addRepoToTeam :: OrganizationName -- ^ The GitHub organization name + -> T.Text -- ^ The GitHub repo name + -> Integer -- ^ The Team ID + -> GitHub StatusInTeam +addRepoToTeam (OrganizationName nameOfOrg) nameOfRepo idOfTeam = + putRequestTo (composeEndpoint ["teams", T.pack $ show idOfTeam, "repos", nameOfOrg, nameOfRepo]) + -- | Deletes a member with the given name from a team with the given ID. Might or might not delete deleteMemberFromTeam :: T.Text -- ^ GitHub username -> Integer -- ^ GitHub team ID @@ -73,6 +95,12 @@ userForUsername :: T.Text -- ^ GitHub username -> GitHub Member userForUsername username = getRequestTo (composeEndpoint ["users", username]) + +-- | Finds a repo ID given their reponame +repoForReponame :: T.Text -- ^ GitHub org + -> T.Text -- ^ GitHub repo + -> GitHub Repo +repoForReponame org repo = getRequestTo (composeEndpoint ["repos", org, repo]) -- | Add a key for the currently authenticated user addPublicKey :: T.Text -- ^ Base64 RSA Key (ssh-rsa AA..) diff --git a/src/Network/Octohat/Types.hs b/src/Network/Octohat/Types.hs --- a/src/Network/Octohat/Types.hs +++ b/src/Network/Octohat/Types.hs @@ -4,6 +4,9 @@ module Network.Octohat.Types ( Member(..) , MemberWithKey(..) , Team(..) + , TeamPermission(..) + , Repo(..) + , Organization(..) , BearerToken(..) , OrganizationName(..) , TeamName(..) @@ -37,11 +40,23 @@ , memberId :: Integer } deriving (Show, Eq) +-- | Represents the different permissions that a team can have in an organisation. +data TeamPermission = OwnerAccess -- ^ Default team of owners. + | PullAccess -- ^ This team will be able to view and clone its + -- repositories. + | PushAccess -- ^ This team will be able to read its + -- repositories, as well as push to them. + | AdminAccess -- ^ This team will be able to push/pull to its + -- repositories, as well as add other + -- collaborators to them. + deriving (Show,Eq) + -- | Represents a team in GitHub. Contains the team's ID, the team's name and an optional description data Team = Team { teamId :: Integer , teamName :: T.Text , teamDescription :: Maybe T.Text + , teamPermission :: TeamPermission } deriving (Show, Eq) -- | Represents a request to create a new team within an organization. The rest of the paramaters @@ -49,8 +64,23 @@ data TeamCreateRequest = TeamCreateRequest { newTeamName :: T.Text , newTeamDescription :: T.Text + , newTeamPermission :: TeamPermission } deriving (Show, Eq) +-- | Represents an organisation in GitHub. Only has name and description +data Organization = + Organization + { orgLogin :: T.Text + , orgDescription :: Maybe T.Text + } deriving (Show, Eq) + +-- | Represents a repo in GitHub. Contains the Name, Description, and Private status +data Repo = + Repo { repoName :: T.Text + , repoDescription :: Maybe T.Text + , repoPrivate :: Bool + } deriving (Show, Eq) + -- | Represents a GitHub user with its public keys and fingerprints. A GitHub user might or might not -- have any public keys data MemberWithKey = @@ -107,8 +137,29 @@ Nothing -> (fail . maybe "No error message from GitHub" show) (HS.lookup "message" o) parseJSON _ = fail "Expected a membership document, got something else" +instance FromJSON TeamPermission where + parseJSON (String p) = + case p of + "pull" -> pure PullAccess + "push" -> pure PushAccess + "admin" -> pure AdminAccess + "owner" -> pure OwnerAccess + _ -> fail "Expected a valid team permission ?" + parseJSON _ = fail "Expected a team permssion, got something else" + +instance ToJSON TeamPermission where + toJSON p = + case p of + PullAccess -> String "pull" + PushAccess -> String "push" + AdminAccess -> String "admin" + OwnerAccess -> String "owner" + + $(deriveJSON defaultOptions { fieldLabelModifier = drop 6 . map toLower } ''Member) $(deriveJSON defaultOptions { fieldLabelModifier = drop 4 . map toLower } ''Team) +$(deriveJSON defaultOptions { fieldLabelModifier = drop 4 . map toLower } ''Repo) +$(deriveJSON defaultOptions { fieldLabelModifier = drop 3 . map toLower } ''Organization) $(deriveJSON defaultOptions { fieldLabelModifier = drop 7 . map toLower } ''TeamCreateRequest) $(deriveJSON defaultOptions { fieldLabelModifier = drop 19 . map toLower } ''AddPublicKeyRequest) @@ -142,15 +193,15 @@ -- | GitHub's OAuth 2.0 bearer token. This is simply added in an -- Authorization header -newtype BearerToken = BearerToken { unBearerToken :: T.Text } +newtype BearerToken = BearerToken { unBearerToken :: T.Text } deriving Show -- | OrganizationName is added in order to have type safety in functions where the -- Organization name and the Team name are both strings and may be confused -newtype OrganizationName = OrganizationName { unOrganizationName :: T.Text } +newtype OrganizationName = OrganizationName { unOrganizationName :: T.Text } deriving Show -- | TeamName is added in order to have type safety in functions where the -- Team name and the Organization name are both strings and may be confused -newtype TeamName = TeamName { unTeamName :: T.Text } +newtype TeamName = TeamName { unTeamName :: T.Text } deriving Show -- | The monad transformer where all operations run. Supports initial configuration -- through a Reader monad and the possibility of failure through Either