diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,16 @@ # bugzilla-redhat version history +## 0.3.2 (2021-06-19) +- BugillaServer can now be fully qualified (@TristanCacqueray) +- Add apikeySession to support api_key auth (@TristanCacqueray) +- Add isNotEmpty search expression operator (@TristanCacqueray) +- Add changedSince and changedUntil search expression (@TristanCacqueray) +- Add searchBugsAllWithLimit, searchBugsAll and getBugAll + to get all the bug fields (@TristanCacqueray) +- Change Bug to include ExternalBugs information (@TristanCacqueray) +- Export Request +- support ghc-9.0 (@juhp) + ## 0.3.1 (2021-02-07) - export sendBzRequest diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -10,3 +10,12 @@ Relevant links: - https://bugzilla.redhat.com/docs/en/html/api/index.html + +## Contributing +Bug reports, feedback, and fixes are welcome. + +Thanks to the contributors! + + + + diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO @@ -0,0 +1,7 @@ +- support getting bug's requested fields + +- instance Monoid SearchExpression? + +- rename Bugzilla.Redhat to RedHatBugzilla for 0.4 + +- use http-query (http-conduit Simple) diff --git a/bugzilla-redhat.cabal b/bugzilla-redhat.cabal --- a/bugzilla-redhat.cabal +++ b/bugzilla-redhat.cabal @@ -1,8 +1,8 @@ name: bugzilla-redhat -version: 0.3.1 +version: 0.3.2 synopsis: A Haskell interface to the Bugzilla native REST API -description: This package is designed to provide an easy-to-use, typesafe - interface to querying Bugzilla from Haskell. +description: This package is designed to provide an easy-to-use, + type-safe interface to querying Bugzilla from Haskell. . This is a friendly fork of Seth Fowler's library, with minor updates and API tweaks needed for @@ -13,12 +13,12 @@ author: Seth Fowler maintainer: Jens Petersen copyright: 2014 Seth Fowler, - 2020 Jens Petersen + 2020-2021 Jens Petersen category: Web build-type: Simple extra-source-files: README.md ChangeLog.md - changelog.orig + TODO cabal-version: >=1.10 source-repository head @@ -36,7 +36,7 @@ other-modules: Web.Bugzilla.RedHat.Internal.Network, Web.Bugzilla.RedHat.Internal.Search, Web.Bugzilla.RedHat.Internal.Types - build-depends: base >=4.6 && <4.15, + build-depends: base >=4.6 && <5, aeson >=0.7 && <1.6, blaze-builder >=0.3 && <0.5, bytestring >=0.10 && <0.11, @@ -62,10 +62,22 @@ ghc-options: -Wall main-is: BugzillaDemo.hs - build-depends: base >=4.6 && <4.15, + build-depends: base >=4.6 && <5, bugzilla-redhat, containers >=0.5 && <0.7, text >=0.11 && <1.3, time >=1.4 && <1.10 hs-source-dirs: demo + default-language: Haskell2010 + +test-suite bugzilla-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base >=4.6 && <5, + aeson >=0.7 && <1.6, + bugzilla-redhat, + hspec >=2.0 && <3.0, + time >=1.4 && <1.10 + ghc-options: -Wall default-language: Haskell2010 diff --git a/changelog.orig b/changelog.orig deleted file mode 100644 --- a/changelog.orig +++ /dev/null @@ -1,18 +0,0 @@ -0.2.1.1 - - * Tightened the version bounds for data-default. The old bounds weren't - accurate. - -0.2.1.0 - - * Added searchBugs' and searchBugsWithLimit', variations which return - only a list of BugIds. These are more suitable for polling than the - existing functions. - -0.2.0.0 - - * History events now have a sequential id, just like comments. - - * When using an anonymous session, Bugzilla does not return email - addresses for users. To accomodate this, the User type now stores email - addresses as type 'Maybe UserEmail'. diff --git a/src/Web/Bugzilla/RedHat.hs b/src/Web/Bugzilla/RedHat.hs --- a/src/Web/Bugzilla/RedHat.hs +++ b/src/Web/Bugzilla/RedHat.hs @@ -10,7 +10,7 @@ -- -- A very simple program using this package might look like this: -- --- > ctx <- newBugzillaContext "bugzilla.example.org" +-- > ctx <- newBugzillaContext "bugzilla.redhat.com" -- > let session = anonymousSession ctx -- > user = "me@example.org" -- > query = AssignedToField .==. user .&&. @@ -21,23 +21,29 @@ -- -- There's a somewhat more in-depth demo program included with the -- source code to this package. + module Web.Bugzilla.RedHat ( -- * Connecting to Bugzilla newBugzillaContext , loginSession +, apikeySession , anonymousSession , BugzillaServer , BugzillaContext , BugzillaSession (..) , BugzillaToken (..) +, BugzillaApikey (..) -- * Querying Bugzilla , searchBugs +, searchBugsAll , searchBugs' , searchBugsWithLimit +, searchBugsAllWithLimit , searchBugsWithLimit' , getBug +, getBugAll , getAttachment , getAttachments , getComments @@ -49,6 +55,7 @@ , sendBzRequest , intAsText +, Request , BugId , AttachmentId , CommentId @@ -61,6 +68,8 @@ , User (..) , Flag (..) , Bug (..) +, ExternalBug (..) +, ExternalType (..) , Attachment (..) , Comment (..) , History (..) @@ -74,6 +83,7 @@ import Control.Exception (throw, try) import Control.Monad.IO.Class (liftIO) +import Data.Aeson (FromJSON) import qualified Data.Text as T import Network.Connection (TLSSettings(..)) import Network.HTTP.Conduit (mkManagerSettings, newManager) @@ -106,6 +116,10 @@ Left e -> throw e Right token -> Just $ LoginSession ctx token +-- | Creates a 'BugzillaSession' using the provided api key. +apikeySession :: BugzillaContext -> BugzillaApikey -> BugzillaSession +apikeySession = ApikeySession + -- | Creates an anonymous 'BugzillaSession'. Note that some content -- will be hidden by Bugzilla when you make queries in this state. anonymousSession :: BugzillaContext -> BugzillaSession @@ -118,11 +132,15 @@ -- can be constructed conveniently using the operators in "Web.Bugzilla.Search". searchBugs :: BugzillaSession -> SearchExpression -> IO [Bug] searchBugs session search = do - let searchQuery = evalSearchExpr search - req = newBzRequest session ["bug"] searchQuery - (BugList bugs) <- sendBzRequest session req + BugList bugs <- doSearchBugs session search Nothing Nothing return bugs +-- | Similar to 'searchBugs', but return _all fields. +searchBugsAll :: BugzillaSession -> SearchExpression -> IO [Bug] +searchBugsAll session search = do + BugList bugs <- doSearchBugs session search (Just "_all") Nothing + return bugs + -- | Like 'searchBugs', but returns a list of 'BugId's. You can -- retrieve the 'Bug' for each 'BugId' using 'getBug'. The combination -- of 'searchBugs'' and 'getBug' is much less efficient than @@ -131,12 +149,22 @@ -- set of bugs returned by a query has changed. searchBugs' :: BugzillaSession -> SearchExpression -> IO [BugId] searchBugs' session search = do - let fieldsQuery = [("include_fields", Just "id")] - searchQuery = evalSearchExpr search - req = newBzRequest session ["bug"] (fieldsQuery ++ searchQuery) - (BugIdList bugs) <- sendBzRequest session req + BugIdList bugs <- doSearchBugs session search (Just "id") Nothing return bugs +doSearchBugs :: FromJSON a => BugzillaSession -> SearchExpression -> Maybe T.Text -> Maybe (Int, Int) -> IO a +doSearchBugs session search includeField limits = do + let fieldsQuery = case includeField of + Nothing -> [] + Just field -> [("include_fields", Just field)] + limitQuery = case limits of + Nothing -> [] + Just (limit, offset) -> [("limit", Just $ intAsText limit), + ("offset", Just $ intAsText offset)] + searchQuery = evalSearchExpr search + req = newBzRequest session ["bug"] (limitQuery ++ fieldsQuery ++ searchQuery) + sendBzRequest session req + -- | Search Bugzilla and returns a limited number of results. You can -- call this repeatedly and use 'offset' to retrieve the results of -- a large query incrementally. Note that most Bugzillas won't @@ -149,13 +177,19 @@ -> SearchExpression -> IO [Bug] searchBugsWithLimit session limit offset search = do - let limitQuery = [("limit", Just $ intAsText limit), - ("offset", Just $ intAsText offset)] - searchQuery = evalSearchExpr search - req = newBzRequest session ["bug"] (limitQuery ++ searchQuery) - (BugList bugs) <- sendBzRequest session req + BugList bugs <- doSearchBugs session search Nothing (Just (limit, offset)) return bugs +-- | Similar to 'searchBugsWithLimit', but return _all fields. +searchBugsAllWithLimit :: BugzillaSession + -> Int -- ^ The maximum number of results to return. + -> Int -- ^ The offset from the first result to start from. + -> SearchExpression + -> IO [Bug] +searchBugsAllWithLimit session limit offset search = do + BugList bugs <- doSearchBugs session search (Just "_all") (Just (limit, offset)) + return bugs + -- | Like 'searchBugsWithLimit', but returns a list of 'BugId's. See -- 'searchBugs'' for more discussion. searchBugsWithLimit' :: BugzillaSession @@ -164,24 +198,29 @@ -> SearchExpression -> IO [BugId] searchBugsWithLimit' session limit offset search = do - let fieldsQuery = [("include_fields", Just "id")] - limitQuery = [("limit", Just $ intAsText limit), - ("offset", Just $ intAsText offset)] - searchQuery = evalSearchExpr search - req = newBzRequest session ["bug"] (fieldsQuery ++ limitQuery ++ searchQuery) - (BugIdList bugs) <- sendBzRequest session req + BugIdList bugs <- doSearchBugs session search (Just "id") (Just (limit, offset)) return bugs -- | Retrieve a bug by bug number. getBug :: BugzillaSession -> BugId -> IO (Maybe Bug) -getBug session bid = do - let req = newBzRequest session ["bug", intAsText bid] [] +getBug session bid = getBugIncludeFields session bid [] + +-- | Retrieve all bug field by bug number +getBugAll :: BugzillaSession -> BugId -> IO (Maybe Bug) +getBugAll session bid = getBugIncludeFields session bid ["_all"] + +-- | Retrieve a bug by bug number with fields +getBugIncludeFields :: BugzillaSession -> BugId -> [T.Text] -> IO (Maybe Bug) +getBugIncludeFields session bid includeFields = do + let req = newBzRequest session ["bug", intAsText bid] query (BugList bugs) <- sendBzRequest session req case bugs of [bug] -> return $ Just bug [] -> return Nothing _ -> throw $ BugzillaUnexpectedValue "Request for a single bug returned multiple bugs" + where + query = map (\f -> ("include_fields", Just f)) includeFields -- | Retrieve a bug by attachment number. getAttachment :: BugzillaSession -> AttachmentId -> IO (Maybe Attachment) diff --git a/src/Web/Bugzilla/RedHat/Internal/Network.hs b/src/Web/Bugzilla/RedHat/Internal/Network.hs --- a/src/Web/Bugzilla/RedHat/Internal/Network.hs +++ b/src/Web/Bugzilla/RedHat/Internal/Network.hs @@ -5,6 +5,7 @@ module Web.Bugzilla.RedHat.Internal.Network ( BugzillaServer , BugzillaContext (..) +, BugzillaApikey (..) , BugzillaToken (..) , BugzillaSession (..) , BugzillaException (..) @@ -24,6 +25,7 @@ import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Resource (runResourceT) import Data.Aeson +import Data.Maybe (fromMaybe) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL #if !MIN_VERSION_base(4,11,0) @@ -32,14 +34,13 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.Typeable -import Network.HTTP.Conduit (Manager, Request(..), Response(..), defaultRequest, host, httpLbs, path, queryString, secure) +import Network.HTTP.Conduit (Manager, Request(..), Response(..), defaultRequest, host, httpLbs, path, queryString, secure, parseRequest) import Network.HTTP.Types.URI (QueryText, encodePathSegments, renderQueryText) type BugzillaServer = T.Text -- | Holds information about a 'BugzillaServer' and manages outgoing --- connections. You can use 'newBugzillaContext' or --- 'withBugzillaContext' to create one. +-- connections. You can use 'newBugzillaContext' to create one. data BugzillaContext = BugzillaContext { bzServer :: BugzillaServer , bzManager :: Manager @@ -47,6 +48,8 @@ newtype BugzillaToken = BugzillaToken T.Text +newtype BugzillaApikey = BugzillaApikey T.Text + instance FromJSON BugzillaToken where parseJSON (Object v) = BugzillaToken <$> v .: "token" parseJSON _ = mzero @@ -55,10 +58,12 @@ -- 'loginSession', as appropriate, to create one. data BugzillaSession = AnonymousSession BugzillaContext | LoginSession BugzillaContext BugzillaToken + | ApikeySession BugzillaContext BugzillaApikey bzContext :: BugzillaSession -> BugzillaContext bzContext (AnonymousSession ctx) = ctx bzContext (LoginSession ctx _) = ctx +bzContext (ApikeySession ctx _) = ctx data BugzillaException = BugzillaJSONParseError String @@ -81,15 +86,22 @@ newBzRequest :: BugzillaSession -> [T.Text] -> QueryText -> Request newBzRequest session methodParts query = - sslRequest { - host = TE.encodeUtf8 . bzServer . bzContext $ session, + baseRequest { path = toByteString $ encodePathSegments $ "rest" : methodParts, queryString = toByteString $ renderQueryText True queryWithToken } where + -- Try to parse the bzServer first, if it has a scheme then use it as the base request, + -- otherwise force a secure ssl request. + baseRequest :: Request + baseRequest = fromMaybe (sslRequest { host = serverBytes }) (parseRequest serverStr) + serverBytes = TE.encodeUtf8 serverTxt + serverStr = T.unpack serverTxt + serverTxt = bzServer . bzContext $ session queryWithToken = case session of - AnonymousSession _ -> query - LoginSession _ (BugzillaToken token) -> ("token", Just token) : query + AnonymousSession _ -> query + LoginSession _ (BugzillaToken token) -> ("token", Just token) : query + ApikeySession _ (BugzillaApikey token) -> ("api_key", Just token) : query data BzError = BzError Int String deriving (Eq, Show) diff --git a/src/Web/Bugzilla/RedHat/Internal/Search.hs b/src/Web/Bugzilla/RedHat/Internal/Search.hs --- a/src/Web/Bugzilla/RedHat/Internal/Search.hs +++ b/src/Web/Bugzilla/RedHat/Internal/Search.hs @@ -37,6 +37,7 @@ data SearchTerm where UnaryOp :: FieldType a => T.Text -> Field a -> SearchTerm BinaryOp :: (FieldType a, FieldType b) => T.Text -> Field a -> b -> SearchTerm + EqTerm :: (FieldType a, FieldType b) => Field a -> b -> SearchTerm -- | A Boolean expression which can be used to query Bugzilla. data SearchExpression @@ -56,6 +57,7 @@ evalSearchTerm :: Int -> SearchTerm -> [QueryPart] evalSearchTerm t (UnaryOp op field) = termQuery t field op ("" :: T.Text) evalSearchTerm t (BinaryOp op field val) = termQuery t field op val +evalSearchTerm _ (EqTerm field val) = [(searchFieldName field, Just . fvAsText $ val)] evalSearchExpr :: SearchExpression -> [QueryPart] evalSearchExpr e = snd $ evalSearchExpr' 1 e diff --git a/src/Web/Bugzilla/RedHat/Internal/Types.hs b/src/Web/Bugzilla/RedHat/Internal/Types.hs --- a/src/Web/Bugzilla/RedHat/Internal/Types.hs +++ b/src/Web/Bugzilla/RedHat/Internal/Types.hs @@ -18,6 +18,8 @@ , User (..) , UserList (..) , Flag (..) +, ExternalType (..) +, ExternalBug (..) , Bug (..) , BugList (..) , BugIdList (..) @@ -338,6 +340,46 @@ <*> v .:? "requestee" parseJSON _ = mzero +-- | An external bug type +data ExternalType = ExternalType + { externalTypeDescription :: T.Text + , externalTypeUrl :: T.Text + , externalTypeId :: Int + , externalTypeType :: T.Text + , externalTypeFullUrl :: T.Text + } deriving (Eq, Ord, Show) + +instance FromJSON ExternalType where + parseJSON (Object v) = + ExternalType <$> v .: "description" + <*> v .: "url" + <*> v .: "id" + <*> v .: "type" + <*> v .: "full_url" + parseJSON _ = mzero + +-- | An external bug. +data ExternalBug = ExternalBug + { externalDescription :: T.Text + , externalBzId :: Int + , externalPriority :: T.Text + , externalBugId :: T.Text + , externalStatus :: T.Text + , externalId :: Int + , externalType :: ExternalType + } deriving (Eq, Ord, Show) + +instance FromJSON ExternalBug where + parseJSON (Object v) = + ExternalBug <$> v .: "ext_description" + <*> v .: "ext_bz_id" + <*> v .: "ext_priority" + <*> v .: "ext_bz_bug_id" + <*> v .: "ext_status" + <*> v .: "id" + <*> v .: "type" + parseJSON _ = mzero + -- | A Bugzilla bug. data Bug = Bug { bugId :: !BugId @@ -377,6 +419,7 @@ , bugVersion :: [T.Text] , bugWhiteboard :: T.Text , bugCustomFields :: H.HashMap T.Text T.Text + , bugExternalBugs :: Maybe [ExternalBug] } deriving (Eq, Show) instance FromJSON Bug where @@ -418,6 +461,7 @@ <*> v .: "version" <*> v .: "whiteboard" <*> pure (customFields v) + <*> v .:? "external_bugs" parseJSON _ = mzero customFields :: Object -> H.HashMap T.Text T.Text diff --git a/src/Web/Bugzilla/RedHat/Search.hs b/src/Web/Bugzilla/RedHat/Search.hs --- a/src/Web/Bugzilla/RedHat/Search.hs +++ b/src/Web/Bugzilla/RedHat/Search.hs @@ -22,11 +22,15 @@ , containsAll , changedBefore , changedAfter +, changedSince +, changedUntil +, changedRange , changedFrom , changedTo , changedBy , contentMatches , isEmpty +, isNotEmpty , (.&&.) , (.||.) , not' @@ -94,6 +98,18 @@ changedAfter :: FieldType a => Field a -> UTCTime -> SearchExpression changedAfter = (Term .) . BinaryOp "changedafter" +-- | Filter bug changed since UTCTime +changedSince :: UTCTime -> SearchExpression +changedSince ts = Term $ EqTerm (CustomField "chfieldfrom") ts + +-- | Filter bug changed until UTCTime +changedUntil :: UTCTime -> SearchExpression +changedUntil ts = Term $ EqTerm (CustomField "chfieldto") ts + +-- | Filter bug changed in range +changedRange :: UTCTime -> UTCTime -> SearchExpression +changedRange from to = changedSince from .&&. changedUntil to + changedFrom :: FieldType a => Field a -> a -> SearchExpression changedFrom = (Term .) . BinaryOp "changedfrom" @@ -108,6 +124,9 @@ isEmpty :: FieldType a => Field a -> SearchExpression isEmpty = Term . UnaryOp "isempty" + +isNotEmpty :: FieldType a => Field a -> SearchExpression +isNotEmpty = Term . UnaryOp "isnotempty" (.&&.) :: SearchExpression -> SearchExpression -> SearchExpression (.&&.) (And as) (And bs) = And (as ++ bs) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +module Main (main) where + +import Test.Hspec +import Web.Bugzilla.RedHat.Search + +main :: IO () +main = hspec spec + +spec :: Spec +spec = describe "unit tests" $ do + describe "search" $ do + it "eval isNotEmpty" $ do + evalSearchExpr (isNotEmpty (CustomField "my_field")) + `shouldBe` [ ("f1", Just "my_field"), + ("o1", Just "isnotempty"), + ("v1", Just "") + ] + it "eval changedSince" $ do + evalSearchExpr (changedSince (read "2021-04-01 00:00:00 UTC")) + `shouldBe` [("chfieldfrom", Just "2021-04-01T00:00:00Z")] + + it "eval changedRange" $ do + evalSearchExpr + ( changedRange + (read "2021-04-01 00:00:00 UTC") + (read "2021-04-13 00:00:00 UTC") + ) + `shouldBe` [ -- TODO: fix unused f1 and f4 query args + ("f1", Just "OP"), + ("f4", Just "CP"), + ("chfieldfrom", Just "2021-04-01T00:00:00Z"), + ("chfieldto", Just "2021-04-13T00:00:00Z") + ]