diff --git a/github.cabal b/github.cabal index d6c2ac2c..75c1de42 100644 --- a/github.cabal +++ b/github.cabal @@ -86,6 +86,7 @@ Library GitHub.Data.Request GitHub.Data.Reviews GitHub.Data.Search + GitHub.Data.Statuses GitHub.Data.Teams GitHub.Data.URL GitHub.Data.Webhooks @@ -118,6 +119,7 @@ Library GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Repos.Forks GitHub.Endpoints.Repos.Releases + GitHub.Endpoints.Repos.Statuses GitHub.Endpoints.Repos.Webhooks GitHub.Endpoints.Search GitHub.Endpoints.Users diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs index 2ca4f1a4..046fd36d 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -6,13 +6,12 @@ import qualified GitHub import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Repos.Commits (Commit, commitSha, commitsFor', - commitsForR, diffR, mkName) + commitsForR, diffR, mkCommitName) import GitHub.Request (executeRequest) import Control.Monad (forM_) import Data.Either.Compat (isRight) import Data.List (nub, sort) -import Data.Proxy (Proxy (..)) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, @@ -59,6 +58,5 @@ spec = do d `shouldSatisfy` isRight it "issue #155" $ withAuth $ \auth -> do - let mkCommitName = mkName (Proxy :: Proxy Commit) d <- executeRequest auth $ diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master") d `shouldSatisfy` isRight diff --git a/src/GitHub.hs b/src/GitHub.hs index bd29d3da..4e1598db 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -328,6 +328,12 @@ module GitHub ( usersFollowingR, usersFollowedByR, + -- ** Statuses + -- | See + createStatusR, + statusesForR, + statusForR, + -- * Data definitions module GitHub.Data, -- * Request handling @@ -361,6 +367,7 @@ import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits import GitHub.Endpoints.Repos.Forks import GitHub.Endpoints.Repos.Releases +import GitHub.Endpoints.Repos.Statuses import GitHub.Endpoints.Repos.Webhooks import GitHub.Endpoints.Search import GitHub.Endpoints.Users diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs index 38d4efab..67fb6b09 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -16,6 +16,7 @@ module GitHub.Data ( mkTeamName, mkOrganizationName, mkRepoName, + mkCommitName, fromUserName, fromOrganizationName, -- ** Id @@ -48,6 +49,7 @@ module GitHub.Data ( module GitHub.Data.Request, module GitHub.Data.Reviews, module GitHub.Data.Search, + module GitHub.Data.Statuses, module GitHub.Data.Teams, module GitHub.Data.URL, module GitHub.Data.Webhooks @@ -76,6 +78,7 @@ import GitHub.Data.Repos import GitHub.Data.Request import GitHub.Data.Reviews import GitHub.Data.Search +import GitHub.Data.Statuses import GitHub.Data.Teams import GitHub.Data.URL import GitHub.Data.Webhooks @@ -110,6 +113,9 @@ mkRepoId = Id mkRepoName :: Text -> Name Repo mkRepoName = N +mkCommitName :: Text -> Name Commit +mkCommitName = N + fromOrganizationName :: Name Organization -> Name Owner fromOrganizationName = N . untagName diff --git a/src/GitHub/Data/Statuses.hs b/src/GitHub/Data/Statuses.hs new file mode 100644 index 00000000..0b5e3b37 --- /dev/null +++ b/src/GitHub/Data/Statuses.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module GitHub.Data.Statuses where + +import GitHub.Data.Definitions +import GitHub.Data.Name (Name) +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import GitHub.Data.GitData (Commit) +import GitHub.Data.Repos (RepoRef) + + +data StatusState + = StatusPending + | StatusSuccess + | StatusError + | StatusFailure + deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + +instance NFData StatusState where rnf = genericRnf +instance Binary StatusState + +instance FromJSON StatusState where + parseJSON (String "pending") = pure StatusPending + parseJSON (String "success") = pure StatusSuccess + parseJSON (String "error") = pure StatusError + parseJSON (String "failure") = pure StatusFailure + parseJSON _ = fail "Could not build a StatusState" + +instance ToJSON StatusState where + toJSON StatusPending = String "pending" + toJSON StatusSuccess = String "success" + toJSON StatusError = String "error" + toJSON StatusFailure = String "failure" + + +data Status = Status + { statusCreatedAt :: !UTCTime + , statusUpdatedAt :: !UTCTime + , statusState :: !StatusState + , statusTargetUrl :: !(Maybe URL) + , statusDescription :: !(Maybe Text) + , statusId :: !(Id Status) + , statusUrl :: !URL + , statusContext :: !(Maybe Text) + , statusCreator :: !(Maybe SimpleUser) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance FromJSON Status where + parseJSON = withObject "Status" $ \o -> Status + <$> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "state" + <*> o .:? "target_url" + <*> o .:? "description" + <*> o .: "id" + <*> o .: "url" + <*> o .:? "context" + <*> o .:? "creator" + + +data NewStatus = NewStatus + { newStatusState :: !StatusState + , newStatusTargetUrl :: !(Maybe URL) + , newStatusDescription :: !(Maybe Text) + , newStatusContext :: !(Maybe Text) + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance NFData NewStatus where rnf = genericRnf +instance Binary NewStatus + +instance ToJSON NewStatus where + toJSON (NewStatus s t d c) = object $ filter notNull $ + [ "state" .= s + , "target_url" .= t + , "description" .= d + , "context" .= c + ] + where + notNull (_, Null) = False + notNull (_, _) = True + + +data CombinedStatus = CombinedStatus + { combinedStatusState :: !StatusState + , combinedStatusSha :: !(Name Commit) + , combinedStatusTotalCount :: !Int + , combinedStatusStatuses :: !(Vector Status) + , combinedStatusRepository :: !RepoRef + , combinedStatusCommitUrl :: !URL + , combinedStatusUrl :: !URL + } + deriving (Show, Data, Typeable, Eq, Ord, Generic) + +instance FromJSON CombinedStatus where + parseJSON = withObject "CombinedStatus" $ \o -> CombinedStatus + <$> o .: "state" + <*> o .: "sha" + <*> o .: "total_count" + <*> o .: "statuses" + <*> o .: "repository" + <*> o .: "commit_url" + <*> o .: "url" diff --git a/src/GitHub/Endpoints/Repos/Statuses.hs b/src/GitHub/Endpoints/Repos/Statuses.hs new file mode 100644 index 00000000..d25186d6 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Statuses.hs @@ -0,0 +1,66 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Oleg Grenrus +-- +-- The repo statuses API as described on +-- . +module GitHub.Endpoints.Repos.Statuses ( + createStatus, + createStatusR, + statusesFor, + statusesForR, + statusFor, + statusForR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import GitHub.Request +import Prelude () + +-- | Create a new status +-- +-- > createStatus (BasicAuth user password) "thoughtbot" "paperclip" +-- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" +-- > (NewStatus StatusSuccess Nothing "Looks good!" Nothing) +createStatus :: Auth -> Name Owner -> Name Repo -> Name Commit -> NewStatus -> IO (Either Error Status) +createStatus auth owner repo sha ns = + executeRequest auth $ createStatusR owner repo sha ns + +-- | Create a new status +-- See +createStatusR :: Name Owner -> Name Repo -> Name Commit -> NewStatus -> Request 'RW Status +createStatusR owner repo sha = + command Post parts . encode + where + parts = ["repos", toPathPart owner, toPathPart repo, "statuses", toPathPart sha] + +-- | All statuses for a commit +-- +-- > statusesFor (BasicAuth user password) "thoughtbot" "paperclip" +-- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" +statusesFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Status)) +statusesFor auth user repo sha = + executeRequest auth $ statusesForR user repo sha FetchAll + +-- | All statuses for a commit +-- See +statusesForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request 'RW (Vector Status) +statusesForR user repo sha = + pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "statuses"] [] + +-- | The combined status for a specific commit +-- +-- > statusFor (BasicAuth user password) "thoughtbot" "paperclip" +-- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" +statusFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error CombinedStatus) +statusFor auth user repo sha = + executeRequest auth $ statusForR user repo sha + +-- | The combined status for a specific commit +-- See +statusForR :: Name Owner -> Name Repo -> Name Commit -> Request 'RW CombinedStatus +statusForR user repo sha = + query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "status"] []