octohat 0.1.2 → 0.1.3
raw patch · 6 files changed
+179/−14 lines, 6 filesdep +ghc-primdep +optparse-applicativedep +utf8-stringdep ~aesondep ~basedep ~base-compatnew-component:exe:abc
Dependencies added: ghc-prim, optparse-applicative, utf8-string, yaml
Dependency ranges changed: aeson, base, base-compat, lens, octohat, text
Files
- LICENSE +20/−0
- octohat.cabal +25/−6
- spec/Network/Octohat/TestData.hs +17/−2
- src-demo/Web/GitHub/CLI/Main.hs +32/−0
- src/Network/Octohat/Members.hs +31/−3
- src/Network/Octohat/Types.hs +54/−3
+ LICENSE view
@@ -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.
octohat.cabal view
@@ -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.*
spec/Network/Octohat/TestData.hs view
@@ -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"
+ src-demo/Web/GitHub/CLI/Main.hs view
@@ -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"+ )
src/Network/Octohat/Members.hs view
@@ -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..)
src/Network/Octohat/Types.hs view
@@ -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