diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,14 @@ -## Changes for next +## Changes for 0.23 + +- Escape URI paths + [#404](https://github.com/phadej/github/pull/404) +- Add OwnerBot to OwnerType + [#399](https://github.com/phadej/github/pull/399) +- Make File.fileSha optional + [#392](https://github.com/phadej/github/pull/392) +- Update User-Agent to contain up to date version + [#403](https://github.com/phadej/github/pull/403) + [#394](https://github.com/phadej/github/pull/394) ## Changes for 0.22 diff --git a/fixtures/user-bot.json b/fixtures/user-bot.json new file mode 100644 --- /dev/null +++ b/fixtures/user-bot.json @@ -0,0 +1,32 @@ +{ + "login": "mike-burns", + "id": 4550, + "avatar_url": "https://avatars.githubusercontent.com/u/4550?v=3", + "gravatar_id": "", + "url": "https://api.github.com/users/mike-burns", + "html_url": "https://github.com/mike-burns", + "followers_url": "https://api.github.com/users/mike-burns/followers", + "following_url": "https://api.github.com/users/mike-burns/following{/other_user}", + "gists_url": "https://api.github.com/users/mike-burns/gists{/gist_id}", + "starred_url": "https://api.github.com/users/mike-burns/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/mike-burns/subscriptions", + "organizations_url": "https://api.github.com/users/mike-burns/orgs", + "repos_url": "https://api.github.com/users/mike-burns/repos", + "events_url": "https://api.github.com/users/mike-burns/events{/privacy}", + "received_events_url": "https://api.github.com/users/mike-burns/received_events", + "type": "Bot", + "site_admin": false, + "name": "Mike Burns", + "company": "thoughtbot", + "blog": "http://mike-burns.com/", + "location": "Stockholm, Sweden", + "email": "mburns@thoughtbot.com", + "hireable": true, + "bio": null, + "public_repos": 35, + "public_gists": 32, + "followers": 171, + "following": 0, + "created_at": "2008-04-03T17:54:24Z", + "updated_at": "2015-10-02T16:53:25Z" +} diff --git a/github.cabal b/github.cabal --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: github -version: 0.22 +version: 0.23 synopsis: Access to the GitHub API, v3. category: Network description: @@ -30,7 +30,13 @@ Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus tested-with: - GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1 + GHC ==7.8.4 + || ==7.10.3 + || ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.1 extra-source-files: README.md @@ -42,6 +48,7 @@ fixtures/pull-request-review-requested.json fixtures/user-organizations.json fixtures/user.json + fixtures/user-bot.json source-repository head type: git @@ -49,8 +56,8 @@ flag openssl description: "Use http-client-openssl" - manual: True - default: False + manual: True + default: False library default-language: Haskell2010 @@ -106,8 +113,8 @@ GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate GitHub.Endpoints.Activity.Events - GitHub.Endpoints.Activity.Starring GitHub.Endpoints.Activity.Notifications + GitHub.Endpoints.Activity.Starring GitHub.Endpoints.Activity.Watching GitHub.Endpoints.Gists GitHub.Endpoints.Gists.Comments @@ -135,10 +142,10 @@ GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Repos.Deployments GitHub.Endpoints.Repos.Forks + GitHub.Endpoints.Repos.Invitations GitHub.Endpoints.Repos.Releases GitHub.Endpoints.Repos.Statuses GitHub.Endpoints.Repos.Webhooks - GitHub.Endpoints.Repos.Invitations GitHub.Endpoints.Search GitHub.Endpoints.Users GitHub.Endpoints.Users.Emails @@ -147,9 +154,11 @@ GitHub.Internal.Prelude GitHub.Request + other-modules: Paths_github + -- Packages bundles with GHC, mtl and text are also here build-depends: - base >=4.7 && <4.13 + base >=4.7 && <4.14 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.11 , containers >=0.5.5.1 && <0.7 @@ -162,7 +171,7 @@ -- other packages build-depends: aeson >=1.4.0.0 && <1.5 - , base-compat >=0.10.4 && <0.11 + , base-compat >=0.10.4 && <0.12 , base16-bytestring >=0.1.1.6 && <0.2 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 @@ -182,17 +191,17 @@ if flag(openssl) build-depends: - http-client-openssl >=0.3.0.0 && <0.4 - , HsOpenSSL >=0.11.4.16 && <0.12 - , HsOpenSSL-x509-system >=0.1.0.3 && <0.2 + HsOpenSSL >=0.11.4.16 && <0.12 + , HsOpenSSL-x509-system >=0.1.0.3 && <0.2 + , http-client-openssl >=0.2.2.0 && <0.4 + else build-depends: - http-client-tls >=0.3.5.3 && <0.4 - , tls >=1.4.1 + http-client-tls >=0.3.5.3 && <0.4 + , tls >=1.4.1 - if !impl(ghc >= 8.0) - build-depends: - semigroups >=0.18.5 && <0.20 + if !impl(ghc >=8.0) + build-depends: semigroups >=0.18.5 && <0.20 test-suite github-test default-language: Haskell2010 @@ -208,8 +217,8 @@ GitHub.EventsSpec GitHub.IssuesSpec GitHub.OrganizationsSpec - GitHub.PullRequestReviewsSpec GitHub.PublicSSHKeysSpec + GitHub.PullRequestReviewsSpec GitHub.PullRequestsSpec GitHub.RateLimitSpec GitHub.ReleasesSpec @@ -224,8 +233,8 @@ , bytestring , file-embed , github + , hspec >=2.6.1 && <2.8 , tagged , text - , hspec >=2.6.1 && <2.8 , unordered-containers , vector diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -41,6 +41,10 @@ let userInfo = eitherDecodeStrict $(embedFile "fixtures/user.json") userLogin (fromRightS userInfo) `shouldBe` "mike-burns" + it "decodes user-bot json" $ do + let userInfo = eitherDecodeStrict $(embedFile "fixtures/user-bot.json") + userLogin (fromRightS userInfo) `shouldBe` "mike-burns" + it "returns information about the user" $ withAuth $ \auth -> do userInfo <- userInfoFor' (Just auth) "mike-burns" userLogin (fromRightS userInfo) `shouldBe` "mike-burns" diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -32,7 +32,7 @@ instance E.Exception Error -- | Type of the repository owners. -data OwnerType = OwnerUser | OwnerOrganization +data OwnerType = OwnerUser | OwnerOrganization | OwnerBot deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable, Data) instance NFData OwnerType @@ -77,7 +77,7 @@ { userId :: !(Id User) , userLogin :: !(Name User) , userName :: !(Maybe Text) - , userType :: !OwnerType -- ^ Should always be 'OwnerUser' + , userType :: !OwnerType -- ^ Should always be 'OwnerUser' or 'OwnerBot' , userCreatedAt :: !UTCTime , userPublicGists :: !Int , userAvatarUrl :: !URL @@ -137,6 +137,7 @@ parseJSON = withText "OwnerType" $ \t -> case T.toLower t of "user" -> pure $ OwnerUser "organization" -> pure $ OwnerOrganization + "bot" -> pure $ OwnerBot _ -> fail $ "Unknown OwnerType: " <> T.unpack t instance FromJSON SimpleUser where @@ -205,7 +206,7 @@ <*> obj .: "created_at" instance FromJSON User where - parseJSON = mfilter ((== OwnerUser) . userType) . withObject "User" parseUser + parseJSON = mfilter ((/= OwnerOrganization) . userType) . withObject "User" parseUser instance FromJSON Organization where parseJSON = withObject "Organization" parseOrganization @@ -215,6 +216,7 @@ t <- obj .: "type" case t of OwnerUser -> Owner . Left <$> parseUser obj + OwnerBot -> Owner . Left <$> parseUser obj OwnerOrganization -> Owner . Right <$> parseOrganization obj -- | Filter members returned in the list. diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs --- a/src/GitHub/Data/Deployments.hs +++ b/src/GitHub/Data/Deployments.hs @@ -12,6 +12,10 @@ , CreateDeploymentStatus (..) ) where + +import GitHub.Internal.Prelude +import Prelude () + import Control.Arrow (second) import Data.ByteString (ByteString) @@ -24,7 +28,6 @@ import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.URL (URL) -import GitHub.Internal.Prelude import qualified Data.Aeson as JSON import qualified Data.Text as T diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -188,7 +188,7 @@ , fileStatus :: !Text , fileRawUrl :: !(Maybe URL) , fileAdditions :: !Int - , fileSha :: !Text + , fileSha :: !(Maybe Text) , fileChanges :: !Int , filePatch :: !(Maybe Text) , fileFilename :: !Text @@ -255,7 +255,7 @@ <*> o .: "status" <*> o .:? "raw_url" <*> o .: "additions" - <*> o .: "sha" + <*> o .:? "sha" <*> o .: "changes" <*> o .:? "patch" <*> o .: "filename" diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -67,8 +67,10 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) -import Data.List (find) +import Data.List (find, intercalate) +import Data.String (fromString) import Data.Tagged (Tagged (..)) +import Data.Version (showVersion) import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), getUri, @@ -77,7 +79,9 @@ import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) -import Network.URI (URI, parseURIReference, relativeTo) +import Network.URI + (URI, escapeURIString, isUnescapedInURIComponent, parseURIReference, + relativeTo) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS @@ -88,11 +92,11 @@ import qualified Network.HTTP.Client.Internal as HTTP #ifdef MIN_VERSION_http_client_tls -import Network.HTTP.Client.TLS (tlsManagerSettings) +import Network.HTTP.Client.TLS (tlsManagerSettings) #else import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL) -import qualified OpenSSL.Session as SSL +import qualified OpenSSL.Session as SSL import qualified OpenSSL.X509.SystemStore as SSL #endif @@ -101,6 +105,8 @@ import GitHub.Data.PullRequests (MergeResult (..)) import GitHub.Data.Request +import Paths_github (version) + #ifdef MIN_VERSION_http_client_tls withOpenSSL :: IO a -> IO a withOpenSSL = id @@ -405,11 +411,12 @@ . setMethod (toMethod m) $ req where - parseUrl' :: MonadThrow m => Text -> m HTTP.Request - parseUrl' = HTTP.parseUrlThrow . T.unpack + parseUrl' :: MonadThrow m => String -> m HTTP.Request + parseUrl' = HTTP.parseUrlThrow - url :: Paths -> Text - url paths = maybe "https://api.github.com" id (endpoint =<< auth) <> "/" <> T.intercalate "/" paths + url :: Paths -> String + url paths = maybe "https://api.github.com" T.unpack (endpoint =<< auth) ++ "/" ++ intercalate "/" paths' where + paths' = map (escapeURIString isUnescapedInURIComponent . T.unpack) paths setReqHeaders :: HTTP.Request -> HTTP.Request setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } @@ -418,7 +425,7 @@ setMethod m req = req { method = m } reqHeaders :: RequestHeaders - reqHeaders = [("User-Agent", "github.hs/0.21")] -- Version + reqHeaders = [("User-Agent", "github.hs/" <> fromString (showVersion version))] -- Version <> [("Accept", unTagged (contentType :: Tagged mt BS.ByteString))] setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request