Add Statuses endpoints

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

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

src/GitHub.hs

@@ -328,6 +328,12 @@ module GitHub (
     usersFollowingR,
     usersFollowedByR,
 
+    -- ** Statuses
+    -- | See <https://developer.github.com/v3/repos/statuses/>
+    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

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
 

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"

src/GitHub/Endpoints/Repos/Statuses.hs

@@ -0,0 +1,66 @@
+-----------------------------------------------------------------------------
+-- |
+-- License     :  BSD-3-Clause
+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
+--
+-- The repo statuses API as described on
+-- <https://developer.github.com/v3/repos/statuses/>.
+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 <https://developer.github.com/v3/repos/statuses/#create-a-status>
+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 <https://developer.github.com/v3/repos/statuses/#list-statuses-for-a-specific-ref>
+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 <https://developer.github.com/v3/repos/statuses/#get-the-combined-status-for-a-specific-ref>
+statusForR :: Name Owner -> Name Repo -> Name Commit -> Request 'RW CombinedStatus
+statusForR user repo sha =
+    query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "status"] []