bugzilla-redhat 0.3.3 → 1.0.0

raw patch · 15 files changed

+1382/−1438 lines, 15 filesdep ~aesondep ~bytestringdep ~resourcetPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, bytestring, resourcet, text, time

API changes (from Hackage documentation)

Files

• ChangeLog.md +12/−0
• TODO +1/−3
• bugzilla-redhat.cabal +8/−8
• demo/BugzillaDemo.hs +14/−32
• src/Web/Bugzilla/RedHat.hs +0/−283
• src/Web/Bugzilla/RedHat/Internal/Network.hs +0/−127
• src/Web/Bugzilla/RedHat/Internal/Search.hs +0/−90
• src/Web/Bugzilla/RedHat/Internal/Types.hs +0/−747
• src/Web/Bugzilla/RedHat/Search.hs +0/−147
• src/Web/RedHatBugzilla.hs +249/−0
• src/Web/RedHatBugzilla/Internal/Network.hs +114/−0
• src/Web/RedHatBugzilla/Internal/Search.hs +90/−0
• src/Web/RedHatBugzilla/Internal/Types.hs +747/−0
• src/Web/RedHatBugzilla/Search.hs +146/−0
• test/Spec.hs +1/−1

@@ -1,5 +1,17 @@ # bugzilla-redhat version history +## 1.0.0 (2022-02-20)+- rename Web.Bugzilla.RedHat to Web.RedHatBugzilla+- use Network.HTTP.Simple global session Manager+- from 28 Feb 2022 Red Hat Bugzilla only allows API key authentication:+- remove newBugzillaContext and BugzillaContext+- drop loginSession and also BugzillaToken+- bzServer replaces bzContext+- newBzRequest now puts API key in Authorization header+- sendBzRequest no longer takes a session argument+- rename BugzillaApikey to BugzillaApiKey+- rename ApikeySession to ApiKeySession+ ## 0.3.3 (2021-10-14) - support building with aeson-2.0 

@@ -2,6 +2,4 @@  - instance Monoid SearchExpression? -- rename Bugzilla.Redhat to RedHatBugzilla for 0.4--- use http-query (http-conduit Simple)+* use http-query

@@ -1,11 +1,11 @@ name:                bugzilla-redhat-version:             0.3.3+version:             1.0.0 synopsis:            A Haskell interface to the Bugzilla native REST API 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+                     with updates and API tweaks needed for                      bugzilla.redhat.com. homepage:            https://github.com/juhp/hsbugzilla license:             BSD3@@ -13,7 +13,7 @@ author:              Seth Fowler <mark.seth.fowler@gmail.com> maintainer:          Jens Petersen <juhpetersen@gmail.com> copyright:           2014 Seth Fowler,-                     2020-2021 Jens Petersen+                     2020-2022 Jens Petersen category:            Web build-type:          Simple extra-source-files:  README.md@@ -31,11 +31,11 @@  library   ghc-options:         -Wall-  exposed-modules:     Web.Bugzilla.RedHat,-                       Web.Bugzilla.RedHat.Search-  other-modules:       Web.Bugzilla.RedHat.Internal.Network,-                       Web.Bugzilla.RedHat.Internal.Search,-                       Web.Bugzilla.RedHat.Internal.Types+  exposed-modules:     Web.RedHatBugzilla,+                       Web.RedHatBugzilla.Search+  other-modules:       Web.RedHatBugzilla.Internal.Network,+                       Web.RedHatBugzilla.Internal.Search,+                       Web.RedHatBugzilla.Internal.Types   build-depends:       base >=4.6 && <5,                        aeson >=0.7 && <2.1,                        blaze-builder >=0.3 && <0.5,

@@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -import Control.Exception (bracket) import Control.Monad import Data.Maybe import qualified Data.Text as T@@ -9,25 +8,23 @@ import System.Environment (getArgs) import System.IO -import Web.Bugzilla.RedHat-import Web.Bugzilla.RedHat.Search+import Web.RedHatBugzilla+import Web.RedHatBugzilla.Search  main :: IO ()-main = dispatch Nothing Nothing =<< getArgs+main = dispatch Nothing =<< getArgs -dispatch :: Maybe UserEmail -> Maybe BugzillaServer -> [String] -> IO ()-dispatch Nothing s ("--login" : user : as)    = dispatch (Just $ T.pack user) s as-dispatch l Nothing ("--server" : server : as) = dispatch l (Just $ T.pack server) as-dispatch l s ["--assigned-to", user]          = withBz l s $ doAssignedTo (T.pack user)-dispatch l s ["--assigned-to-brief", user]    = withBz l s $ doAssignedToBrief (T.pack user)-dispatch l s ["--requests", user]             = withBz l s $ doRequests (T.pack user)-dispatch l s ["--history", bug, n]            = withBz l s $ doHistory (read bug) (read n)-dispatch _ _ _                                = usage+dispatch :: Maybe BugzillaServer -> [String] -> IO ()+dispatch Nothing ("--server" : server : as) = dispatch (Just $ T.pack server) as+dispatch s ["--assigned-to", user]          = withBz s $ doAssignedTo (T.pack user)+dispatch s ["--assigned-to-brief", user]    = withBz s $ doAssignedToBrief (T.pack user)+dispatch s ["--requests", user]             = withBz s $ doRequests (T.pack user)+dispatch s ["--history", bug, n]            = withBz s $ doHistory (read bug) (read n)+dispatch _ _                                = usage  usage :: IO () usage = hPutStrLn stderr "Connection options:"      >> hPutStrLn stderr "  --server [domain name] - REQUIRED. The Bugzilla server to access."-     >> hPutStrLn stderr "  --login [user email]   - The user to log in with."      >> hPutStrLn stderr ""      >> hPutStrLn stderr "Bugzilla queries:"      >> hPutStrLn stderr "  --assigned-to [user email] - List bugs assigned to the user."@@ -35,22 +32,13 @@      >> hPutStrLn stderr "  --requests [user email]    - List requests for the user."      >> hPutStrLn stderr "  --history [bug number] [n] - List the most recent 'n' changes to the bug." -withBz :: Maybe UserEmail -> Maybe BugzillaServer -> (BugzillaSession -> IO ()) -> IO ()-withBz mLogin mServer f = do+withBz :: Maybe BugzillaServer -> (BugzillaSession -> IO ())+       -> IO ()+withBz mServer f = do   let server = case mServer of                  Just s  -> s                  Nothing -> error "Please specify a server with '--server'"-  ctx <- newBugzillaContext server-  case mLogin of-    Just login -> do hPutStrLn stderr "Enter password: "-                     password <- T.pack <$> withEcho False getLine-                     mSession <- loginSession ctx login password-                     case mSession of-                       Just session -> do hPutStrLn stderr "Login successful."-                                          f session-                       Nothing      -> do hPutStrLn stderr "Login failed. Falling back to anonymous session."-                                          f $ anonymousSession ctx-    Nothing -> f $ anonymousSession ctx+  f $ anonymousSession server   doAssignedTo :: UserEmail -> BugzillaSession -> IO ()@@ -158,9 +146,3 @@     showAid :: Maybe AttachmentId -> String     showAid (Just aid) = " (Attachment " ++ show aid ++ ")"     showAid Nothing    = ""--withEcho :: Bool -> IO a -> IO a-withEcho echo action =-    bracket (hGetEcho stdin)-            (hSetEcho stdin)-            (const $ hSetEcho stdin echo >> action)

@@ -1,283 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}---- | This package is designed to provide an easy-to-use, typesafe---   interface to querying Bugzilla from Haskell.------   A modified version of Web.Bugzilla to support---   the list fields in Red Hat's modified bugzilla API.------   A very simple program using this package might look like this:------ >   ctx <- newBugzillaContext "https://bugzilla.redhat.com"--- >   let session = anonymousSession ctx--- >       user = "me@example.org"--- >       query = AssignedToField .==. user .&&.--- >               FlagRequesteeField .==. user .&&.--- >               (FlagsField `contains` "review" .||. FlagsField `contains` "feedback")--- >   bugs <- searchBugs session query--- >   mapM_ (putStrLn . show . bugSummary) bugs------   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-, getHistory-, searchUsers-, getUser-, getUserById-, newBzRequest-, sendBzRequest-, intAsText--, Request-, BugId-, AttachmentId-, CommentId-, UserId-, EventId-, FlagId-, FlagType-, UserEmail-, Field (..)-, User (..)-, Flag (..)-, Bug (..)-, ExternalBug (..)-, ExternalType (..)-, Attachment (..)-, Comment (..)-, History (..)-, HistoryEvent (..)-, Change (..)-, Modification (..)-, fieldName--, BugzillaException (..)-) where--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)--import Web.Bugzilla.RedHat.Internal.Network-import Web.Bugzilla.RedHat.Internal.Search-import Web.Bugzilla.RedHat.Internal.Types---- | Creates a new 'BugzillaContext', suitable for connecting to the---   provided server. You should try to reuse 'BugzillaContext's---   whenever possible, because creating them is expensive.-newBugzillaContext :: BugzillaServer -> IO BugzillaContext-newBugzillaContext server = do-  let settings = mkManagerSettings (TLSSettingsSimple True False False) Nothing-  manager <- liftIO $ newManager settings-  return $ BugzillaContext server manager---- | Attempts to create a logged-in 'BugzillaSession' using the---   provided username and password. Returns 'Nothing' if login---   fails.-loginSession :: BugzillaContext -> UserEmail -> T.Text -> IO (Maybe BugzillaSession)-loginSession ctx user password = do-  let loginQuery = [("login", Just user),-                    ("password", Just password)]-      session = anonymousSession ctx-      req = newBzRequest session ["login"] loginQuery-  eToken <- try $ sendBzRequest session req-  return $ case eToken of-             Left (BugzillaAPIError 300 _) -> Nothing-             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-anonymousSession = AnonymousSession--intAsText :: Int -> T.Text-intAsText = T.pack . show---- | Searches Bugzilla and returns a list of 'Bug's. The 'SearchExpression'--- can be constructed conveniently using the operators in "Web.Bugzilla.Search".-searchBugs :: BugzillaSession -> SearchExpression -> IO [Bug]-searchBugs session search = do-  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--- 'searchBugs'. 'searchBugs'' is suitable for cases where you won't need to call--- 'getBug' most of the time - for example, polling to determine whether the--- set of bugs returned by a query has changed.-searchBugs' :: BugzillaSession -> SearchExpression -> IO [BugId]-searchBugs' session search = do-  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---   return all of the results for a very large query by default, but---   you can request this by calling 'searchBugsWithLimit' with 0 for---   the limit.-searchBugsWithLimit :: BugzillaSession-                    -> Int  -- ^ The maximum number of results to return.-                    -> Int  -- ^ The offset from the first result to start from.-                    -> SearchExpression-                    -> IO [Bug]-searchBugsWithLimit session limit offset search = do-  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-                     -> Int  -- ^ The maximum number of results to return.-                     -> Int  -- ^ The offset from the first result to start from.-                     -> SearchExpression-                     -> IO [BugId]-searchBugsWithLimit' session limit offset search = do-  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 = 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)-getAttachment session aid = do-  let req = newBzRequest session ["bug", "attachment", intAsText aid] []-  (AttachmentList as) <- sendBzRequest session req-  case as of-    [a] -> return $ Just a-    []  -> return Nothing-    _   -> throw $ BugzillaUnexpectedValue-                   "Request for a single attachment returned multiple attachments"---- | Get all attachments for a bug.-getAttachments :: BugzillaSession -> BugId -> IO [Attachment]-getAttachments session bid = do-  let req = newBzRequest session ["bug", intAsText bid, "attachment"] []-  (AttachmentList as) <- sendBzRequest session req-  return as---- | Get all comments for a bug.-getComments :: BugzillaSession -> BugId -> IO [Comment]-getComments session bid = do-  let req = newBzRequest session ["bug", intAsText bid, "comment"] []-  (CommentList as) <- sendBzRequest session req-  return as---- | Get the history for a bug.-getHistory :: BugzillaSession -> BugId -> IO History-getHistory session bid = do-  let req = newBzRequest session ["bug", intAsText bid, "history"] []-  sendBzRequest session req---- | Search user names and emails using a substring search.-searchUsers :: BugzillaSession -> T.Text -> IO [User]-searchUsers session text = do-  let req = newBzRequest session ["user"] [("match", Just text)]-  (UserList users) <- sendBzRequest session req-  return users---- | Get a user by email.-getUser :: BugzillaSession -> UserEmail -> IO (Maybe User)-getUser session user = do-  let req = newBzRequest session ["user", user] []-  (UserList users) <- sendBzRequest session req-  case users of-    [u] -> return $ Just u-    []  -> return Nothing-    _   -> throw $ BugzillaUnexpectedValue-                   "Request for a single user returned multiple users"---- | Get a user by user ID.-getUserById :: BugzillaSession -> UserId -> IO (Maybe User)-getUserById session uid = do-  let req = newBzRequest session ["user", intAsText uid] []-  (UserList users) <- sendBzRequest session req-  case users of-    [u] -> return $ Just u-    []  -> return Nothing-    _   -> throw $ BugzillaUnexpectedValue-                   "Request for a single user returned multiple users"

@@ -1,127 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings #-}--module Web.Bugzilla.RedHat.Internal.Network-( BugzillaServer-, BugzillaContext (..)-, BugzillaApikey (..)-, BugzillaToken (..)-, BugzillaSession (..)-, BugzillaException (..)-, QueryPart-, Request-, requestUrl-, newBzRequest-, sendBzRequest-) where--import Blaze.ByteString.Builder (toByteString)-#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>), (<*>))-#endif-import Control.Exception (Exception, throw)-import Control.Monad (mzero)-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)-import Data.Monoid ((<>))-#endif-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, 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' to create one.-data BugzillaContext = BugzillaContext-  { bzServer  :: BugzillaServer-  , bzManager :: Manager-  }--newtype BugzillaToken = BugzillaToken T.Text--newtype BugzillaApikey = BugzillaApikey T.Text--instance FromJSON BugzillaToken where-  parseJSON (Object v) = BugzillaToken <$> v .: "token"-  parseJSON _          = mzero---- | A session for Bugzilla queries. Use 'anonymousSession' and--- '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-  | BugzillaAPIError Int String-  | BugzillaUnexpectedValue String-    deriving (Show, Typeable)-instance Exception BugzillaException--type QueryPart = (T.Text, Maybe T.Text)--requestUrl :: Request -> B.ByteString-requestUrl req = "https://" <> host req <> path req <> queryString req--sslRequest :: Request-sslRequest =-  defaultRequest {-    secure = True,-    port   = 443-  }--newBzRequest :: BugzillaSession -> [T.Text] -> QueryText -> Request-newBzRequest session methodParts query =-    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-                       ApikeySession _ (BugzillaApikey token) -> ("api_key", Just token) : query--data BzError = BzError Int String-               deriving (Eq, Show)--instance FromJSON BzError where-  parseJSON (Object v) = BzError <$> v .: "code"-                                 <*> v .: "message"-  parseJSON _          = mzero--handleError :: String -> BL.ByteString -> IO b-handleError parseError body = do-  let mError = eitherDecode body-  case mError of-    Left _                   -> throw $ BugzillaJSONParseError parseError-    Right (BzError code msg) -> throw $ BugzillaAPIError code msg--sendBzRequest :: FromJSON a => BugzillaSession -> Request -> IO a-sendBzRequest session req = runResourceT $ do-  response <- liftIO $ httpLbs req . bzManager . bzContext $ session-  let mResult = eitherDecode $ responseBody response-  case mResult of-    Left msg      -> liftIO $ handleError msg (responseBody response)-    Right decoded -> return decoded

@@ -1,90 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}---- | Operators which can be used to construct queries for Bugzilla.---   These operators are intended to be typesafe: you should not be---   able to construct a query that causes Bugzilla to return an---   error. If you *are* able to construct an erroneous query, please---   report a bug.-module Web.Bugzilla.RedHat.Internal.Search-( FieldType-, SearchTerm (..)-, SearchExpression (..)-, evalSearchExpr-) where--import Data.List-import qualified Data.Text as T-import Data.Time.Clock (UTCTime(..))-import Data.Time.ISO8601 (formatISO8601)--import Web.Bugzilla.RedHat.Internal.Network-import Web.Bugzilla.RedHat.Internal.Types--class FieldType a where fvAsText :: a -> T.Text--instance FieldType T.Text where fvAsText = id-instance FieldType Int where fvAsText = T.pack . show-instance FieldType UTCTime where fvAsText = T.pack . formatISO8601--instance FieldType Bool where-  fvAsText True  = "true"-  fvAsText False = "false"--instance FieldType a => FieldType [a] where-  fvAsText = T.intercalate "," . map fvAsText--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-  = And [SearchExpression]-  | Or [SearchExpression]-  | Not SearchExpression-  | Term SearchTerm--taggedQueryPart :: Int -> Char -> T.Text -> QueryPart-taggedQueryPart t k v = (T.cons k . T.pack . show $ t, Just v)--termQuery :: FieldType b => Int -> Field a -> T.Text -> b -> [QueryPart]-termQuery t f o v = [taggedQueryPart t 'f' (searchFieldName f),-                     taggedQueryPart t 'o' o,-                     taggedQueryPart t 'v' (fvAsText v)]--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-  where-    evalExprGroup :: Int -> [SearchExpression] -> (Int, [QueryPart])-    evalExprGroup t es =-      let (subExprT, subExprQs) = foldl' evalSubExpr (t + 1, []) es-          qs = taggedQueryPart t 'f' "OP" :-               taggedQueryPart subExprT 'f' "CP" :-               subExprQs-      in (subExprT + 1, qs)--    evalSubExpr :: (Int, [QueryPart]) -> SearchExpression -> (Int, [QueryPart])-    evalSubExpr (t, qs) expr = let (nextT, qs') = evalSearchExpr' t expr-                               in  (nextT, qs ++ qs')--    evalSearchExpr' :: Int -> SearchExpression -> (Int, [QueryPart])-    evalSearchExpr' t (And es) = evalExprGroup t es--    evalSearchExpr' t (Or es) =-      let (groupT, groupQs) = evalExprGroup t es-          qs = taggedQueryPart t 'j' "OR" : groupQs-      in (groupT + 1, qs)--    evalSearchExpr' t (Not es) =-      let (groupT, groupQs) = evalSearchExpr' t es-          qs = taggedQueryPart t 'n' "1" : groupQs-      in (groupT + 1, qs)--    evalSearchExpr' t (Term term) = (t + 1, evalSearchTerm t term)

@@ -1,747 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}--module Web.Bugzilla.RedHat.Internal.Types-( BugId-, AttachmentId-, CommentId-, UserId-, EventId-, FlagId-, FlagType-, UserEmail-, Field (..)-, User (..)-, UserList (..)-, Flag (..)-, ExternalType (..)-, ExternalBug (..)-, Bug (..)-, BugList (..)-, BugIdList (..)-, Attachment (..)-, AttachmentList (..)-, Comment (..)-, CommentList (..)-, History (..)-, HistoryEvent (..)-, Change (..)-, Modification (..)-, fieldName-, searchFieldName-) where--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative (pure, (<$>), (<*>))-#endif-import Control.Monad (mzero)-import Data.Aeson-#if MIN_VERSION_aeson(1,0,0)-import Data.Aeson.Text-#else-import Data.Aeson.Encode-#endif-import Data.Aeson.Types-#if MIN_VERSION_aeson(2,0,0)-import Data.Aeson.Key-import qualified Data.Aeson.KeyMap as M-#else-import qualified Data.HashMap.Strict as M-#endif-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TLB-import qualified Data.Text.Read as TR-import qualified Data.Vector as V-import Data.Time.Clock (UTCTime(..))--type BugId        = Int-type AttachmentId = Int-type CommentId    = Int-type UserId       = Int-type EventId      = Int-type FlagId       = Int-type FlagType     = Int-type UserEmail    = T.Text---- | A field which you can search by using 'Web.Bugzilla.searchBugs' or track---   changes to using 'Web.Bugzilla.getHistory'. To get a human-readable name for---   a field, use 'fieldName'.-data Field a where-  AliasField                    :: Field [T.Text]         -- Alias-  AssignedToField               :: Field UserEmail        -- Assignee-  AttachmentCreatorField        :: Field UserEmail        -- Attachment creator-  AttachmentDataField           :: Field T.Text           -- Attachment data-  AttachmentDescriptionField    :: Field T.Text           -- Attachment description-  AttachmentFilenameField       :: Field T.Text           -- Attachment filename-  AttachmentIsObsoleteField     :: Field Bool             -- Attachment is obsolete-  AttachmentIsPatchField        :: Field Bool             -- Attachment is patch-  AttachmentIsPrivateField      :: Field Bool             -- Attachment is private-  AttachmentMimetypeField       :: Field T.Text           -- Attachment mime type-  BlocksField                   :: Field Int              -- Blocks-  BugIdField                    :: Field Int              -- Bug ID-  CcField                       :: Field UserEmail        -- CC-  CcListAccessibleField         :: Field Bool             -- CC list accessible-  ClassificationField           :: Field T.Text           -- Classification-  CommentField                  :: Field T.Text           -- Comment-  CommentIsPrivateField         :: Field T.Text           -- Comment is private-  CommentTagsField              :: Field T.Text           -- Comment Tags-  CommenterField                :: Field UserEmail        -- Commenter-  ComponentField                :: Field [T.Text]         -- Component-  ContentField                  :: Field T.Text           -- Content-  CreationDateField             :: Field UTCTime          -- Creation date-  DaysElapsedField              :: Field Int              -- Days since bug changed-  DependsOnField                :: Field Int              -- Depends on-  EverConfirmedField            :: Field Bool             -- Ever confirmed-  FlagRequesteeField            :: Field UserEmail        -- Flag Requestee-  FlagSetterField               :: Field UserEmail        -- Flag Setter-  FlagsField                    :: Field T.Text           -- Flags-  GroupField                    :: Field T.Text           -- Group-  KeywordsField                 :: Field [T.Text]         -- Keywords-  ChangedField                  :: Field UTCTime          -- Changed-  CommentCountField             :: Field Int              -- Number of Comments-  OperatingSystemField          :: Field T.Text           -- OS-  HardwareField                 :: Field T.Text           -- Hardware-  PriorityField                 :: Field T.Text           -- Priority-  ProductField                  :: Field T.Text           -- Product-  QaContactField                :: Field UserEmail        -- QA Contact-  ReporterField                 :: Field UserEmail        -- Reporter-  ReporterAccessibleField       :: Field Bool             -- Reporter accessible-  ResolutionField               :: Field T.Text           -- Resolution-  RestrictCommentsField         :: Field Bool             -- Restrict Comments-  SeeAlsoField                  :: Field T.Text           -- See Also-  SeverityField                 :: Field T.Text           -- Severity-  StatusField                   :: Field T.Text           -- Status-  WhiteboardField               :: Field T.Text           -- Whiteboard-  SummaryField                  :: Field T.Text           -- Summary-  TagsField                     :: Field T.Text           -- Tags-  TargetMilestoneField          :: Field T.Text           -- Target Milestone-  TimeSinceAssigneeTouchedField :: Field Int              -- Time Since Assignee Touched-  BugURLField                   :: Field T.Text           -- URL-  VersionField                  :: Field T.Text           -- Version-  VotesField                    :: Field T.Text           -- Votes-  CustomField                   :: T.Text -> Field T.Text -- (Custom fields)--instance Eq (Field a) where-  (CustomField a) == (CustomField b) = a == b-  (CustomField _) == _               = False-  _ == (CustomField _)               = False-  a == b                             = searchFieldName a == searchFieldName b--instance Show (Field a) where-  show AliasField                    = "AliasField"-  show AssignedToField               = "AssignedToField"-  show AttachmentCreatorField        = "AttachmentCreatorField"-  show AttachmentDataField           = "AttachmentDataField"-  show AttachmentDescriptionField    = "AttachmentDescriptionField"-  show AttachmentFilenameField       = "AttachmentFilenameField"-  show AttachmentIsObsoleteField     = "AttachmentIsObsoleteField"-  show AttachmentIsPatchField        = "AttachmentIsPatchField"-  show AttachmentIsPrivateField      = "AttachmentIsPrivateField"-  show AttachmentMimetypeField       = "AttachmentMimetypeField"-  show BlocksField                   = "BlocksField"-  show BugIdField                    = "BugIdField"-  show CcField                       = "CcField"-  show CcListAccessibleField         = "CcListAccessibleField"-  show ClassificationField           = "ClassificationField"-  show CommentField                  = "CommentField"-  show CommentIsPrivateField         = "CommentIsPrivateField"-  show CommentTagsField              = "CommentTagsField"-  show CommenterField                = "CommenterField"-  show ComponentField                = "ComponentField"-  show ContentField                  = "ContentField"-  show CreationDateField             = "CreationDateField"-  show DaysElapsedField              = "DaysElapsedField"-  show DependsOnField                = "DependsOnField"-  show EverConfirmedField            = "EverConfirmedField"-  show FlagRequesteeField            = "FlagRequesteeField"-  show FlagSetterField               = "FlagSetterField"-  show FlagsField                    = "FlagsField"-  show GroupField                    = "GroupField"-  show KeywordsField                 = "KeywordsField"-  show ChangedField                  = "ChangedField"-  show CommentCountField             = "CommentCountField"-  show OperatingSystemField          = "OperatingSystemField"-  show HardwareField                 = "HardwareField"-  show PriorityField                 = "PriorityField"-  show ProductField                  = "ProductField"-  show QaContactField                = "QaContactField"-  show ReporterField                 = "ReporterField"-  show ReporterAccessibleField       = "ReporterAccessibleField"-  show ResolutionField               = "ResolutionField"-  show RestrictCommentsField         = "RestrictCommentsField"-  show SeeAlsoField                  = "SeeAlsoField"-  show SeverityField                 = "SeverityField"-  show StatusField                   = "StatusField"-  show WhiteboardField               = "WhiteboardField"-  show SummaryField                  = "SummaryField"-  show TagsField                     = "TagsField"-  show TargetMilestoneField          = "TargetMilestoneField"-  show TimeSinceAssigneeTouchedField = "TimeSinceAssigneeTouchedField"-  show BugURLField                   = "BugURLField"-  show VersionField                  = "VersionField"-  show VotesField                    = "VotesField"-  show (CustomField name)            = "CustomField " ++ show name---- | Provides a human-readable name for a 'Field'.-fieldName :: Field a -> T.Text-fieldName AliasField                    = "Alias"-fieldName AssignedToField               = "Assigned to"-fieldName AttachmentCreatorField        = "Attachment creator"-fieldName AttachmentDataField           = "Attachment data"-fieldName AttachmentDescriptionField    = "Attachment description"-fieldName AttachmentFilenameField       = "Attachment filename"-fieldName AttachmentIsObsoleteField     = "Attachment is obsolete"-fieldName AttachmentIsPatchField        = "Attachment is patch"-fieldName AttachmentIsPrivateField      = "Attachment is private"-fieldName AttachmentMimetypeField       = "Attachment MIME type"-fieldName BlocksField                   = "Blocks"-fieldName BugIdField                    = "BugId"-fieldName CcField                       = "CC"-fieldName CcListAccessibleField         = "CC list is accessible"-fieldName ClassificationField           = "Classification"-fieldName CommentField                  = "Comment"-fieldName CommentIsPrivateField         = "Comment is private"-fieldName CommentTagsField              = "Comment tags"-fieldName CommenterField                = "Commenter"-fieldName ComponentField                = "Component"-fieldName ContentField                  = "Content"-fieldName CreationDateField             = "Creation date"-fieldName DaysElapsedField              = "Days elapsed"-fieldName DependsOnField                = "Depends on"-fieldName EverConfirmedField            = "Ever confirmed"-fieldName FlagRequesteeField            = "Flag requestee"-fieldName FlagSetterField               = "Flag setter"-fieldName FlagsField                    = "Flags"-fieldName GroupField                    = "Group"-fieldName KeywordsField                 = "Keywords"-fieldName ChangedField                  = "Changed"-fieldName CommentCountField             = "Comment count"-fieldName OperatingSystemField          = "Operating system"-fieldName HardwareField                 = "Hardware"-fieldName PriorityField                 = "Priority"-fieldName ProductField                  = "Product"-fieldName QaContactField                = "QA contact"-fieldName ReporterField                 = "Reporter"-fieldName ReporterAccessibleField       = "Reporter accessible"-fieldName ResolutionField               = "Resolution"-fieldName RestrictCommentsField         = "Restrict comments"-fieldName SeeAlsoField                  = "See also"-fieldName SeverityField                 = "Severity"-fieldName StatusField                   = "Status"-fieldName WhiteboardField               = "Whiteboard"-fieldName SummaryField                  = "Summary"-fieldName TagsField                     = "Tags"-fieldName TargetMilestoneField          = "Target milestone"-fieldName TimeSinceAssigneeTouchedField = "Time since assignee touched"-fieldName BugURLField                   = "Bug URL"-fieldName VersionField                  = "Version"-fieldName VotesField                    = "Votes"-fieldName (CustomField name)            = T.concat ["Custom field \"", T.pack (show name), "\""]--searchFieldName :: Field a -> T.Text-searchFieldName AliasField                    = "alias"-searchFieldName AssignedToField               = "assigned_to"-searchFieldName AttachmentCreatorField        = "attachments.submitter"-searchFieldName AttachmentDataField           = "attach_data.thedata"-searchFieldName AttachmentDescriptionField    = "attachments.description"-searchFieldName AttachmentFilenameField       = "attachments.filename"-searchFieldName AttachmentIsObsoleteField     = "attachments.isobsolete"-searchFieldName AttachmentIsPatchField        = "attachments.ispatch"-searchFieldName AttachmentIsPrivateField      = "attachments.isprivate"-searchFieldName AttachmentMimetypeField       = "attachments.mimetype"-searchFieldName BlocksField                   = "blocked"-searchFieldName BugIdField                    = "bug_id"-searchFieldName CcField                       = "cc"-searchFieldName CcListAccessibleField         = "cclist_accessible"-searchFieldName ClassificationField           = "classification"-searchFieldName CommentField                  = "longdesc"-searchFieldName CommentIsPrivateField         = "longdescs.isprivate"-searchFieldName CommentTagsField              = "comment_tag"-searchFieldName CommenterField                = "commenter"-searchFieldName ComponentField                = "component"-searchFieldName ContentField                  = "content"-searchFieldName CreationDateField             = "creation_ts"-searchFieldName DaysElapsedField              = "days_elapsed"-searchFieldName DependsOnField                = "dependson"-searchFieldName EverConfirmedField            = "everconfirmed"-searchFieldName FlagRequesteeField            = "requestees.login_name"-searchFieldName FlagSetterField               = "setters.login_name"-searchFieldName FlagsField                    = "flagtypes.name"-searchFieldName GroupField                    = "bug_group"-searchFieldName KeywordsField                 = "keywords"-searchFieldName ChangedField                  = "delta_ts"-searchFieldName CommentCountField             = "longdescs.count"-searchFieldName OperatingSystemField          = "op_sys"-searchFieldName HardwareField                 = "rep_platform"-searchFieldName PriorityField                 = "priority"-searchFieldName ProductField                  = "product"-searchFieldName QaContactField                = "qa_contact"-searchFieldName ReporterField                 = "reporter"-searchFieldName ReporterAccessibleField       = "reporter_accessible"-searchFieldName ResolutionField               = "resolution"-searchFieldName RestrictCommentsField         = "restrict_comments"-searchFieldName SeeAlsoField                  = "see_also"-searchFieldName SeverityField                 = "bug_severity"-searchFieldName StatusField                   = "bug_status"-searchFieldName WhiteboardField               = "status_whiteboard"-searchFieldName SummaryField                  = "short_desc"-searchFieldName TagsField                     = "tag"-searchFieldName TargetMilestoneField          = "target_milestone"-searchFieldName TimeSinceAssigneeTouchedField = "owner_idle_time"-searchFieldName BugURLField                   = "bug_file_loc"-searchFieldName VersionField                  = "version"-searchFieldName VotesField                    = "votes"-searchFieldName (CustomField name)            = name---- | A Bugzilla user.-data User = User-  { userId       :: !UserId-  , userEmail    :: Maybe UserEmail-  , userName     :: T.Text-  , userRealName :: T.Text-  } deriving (Eq, Ord, Show)--instance FromJSON User where-  parseJSON (Object v) =-    User <$> v .: "id"-         <*> v .:? "email"-         <*> v .: "name"-         <*> v .: "real_name"-  parseJSON _ = mzero--newtype UserList = UserList [User]-                deriving (Eq, Show)--instance FromJSON UserList where-  parseJSON (Object v) = UserList <$> v .: "users"-  parseJSON _          = mzero---- | Flags, which may be set on an attachment or on a bug directly.-data Flag = Flag-  { flagId               :: !FlagId-  , flagTypeId           :: !FlagType-  , flagName             :: T.Text-  , flagSetter           :: UserEmail-  , flagStatus           :: T.Text-  , flagCreationDate     :: UTCTime-  , flagModificationDate :: UTCTime-  , flagRequestee        :: Maybe UserEmail-  } deriving (Eq, Ord, Show)--instance FromJSON Flag where-  parseJSON (Object v) =-    Flag <$> v .: "id"-         <*> v .: "type_id"-         <*> v .: "name"-         <*> v .: "setter"-         <*> v .: "status"-         <*> v .: "creation_date"-         <*> v .: "modification_date"-         <*> 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-  , bugAlias               :: Maybe [T.Text]-  , bugAssignedTo          :: UserEmail-  , bugAssignedToDetail    :: User-  , bugBlocks              :: [BugId]-  , bugCc                  :: [UserEmail]-  , bugCcDetail            :: [User]-  , bugClassification      :: T.Text-  , bugComponent           :: [T.Text]-  , bugCreationTime        :: UTCTime-  , bugCreator             :: UserEmail-  , bugCreatorDetail       :: User-  , bugDependsOn           :: [BugId]-  , bugDupeOf              :: Maybe BugId-  , bugFlags               :: Maybe [Flag]-  , bugGroups              :: [T.Text]-  , bugIsCcAccessible      :: Bool-  , bugIsConfirmed         :: Bool-  , bugIsCreatorAccessible :: Bool-  , bugIsOpen              :: Bool-  , bugKeywords            :: [T.Text]-  , bugLastChangeTime      :: UTCTime-  , bugOpSys               :: T.Text-  , bugPlatform            :: T.Text-  , bugPriority            :: T.Text-  , bugProduct             :: T.Text-  , bugQaContact           :: UserEmail-  , bugResolution          :: T.Text-  , bugSeeAlso             :: [T.Text]-  , bugSeverity            :: T.Text-  , bugStatus              :: T.Text-  , bugSummary             :: T.Text-  , bugTargetMilestone     :: T.Text-  , bugUrl                 :: T.Text-  , bugVersion             :: [T.Text]-  , bugWhiteboard          :: T.Text-  , bugCustomFields        ::-#if MIN_VERSION_aeson(2,0,0)-                              M.KeyMap T.Text-#else-                              M.HashMap T.Text T.Text-#endif-, bugExternalBugs        :: Maybe [ExternalBug]-  } deriving (Eq, Show)--instance FromJSON Bug where-  parseJSON (Object v) =-      Bug <$> v .: "id"-          <*> v .:? "alias"-          <*> v .: "assigned_to"-          <*> v .: "assigned_to_detail"-          <*> v .: "blocks"-          <*> v .: "cc"-          <*> v .: "cc_detail"-          <*> v .: "classification"-          <*> v .: "component"-          <*> v .: "creation_time"-          <*> v .: "creator"-          <*> v .: "creator_detail"-          <*> v .: "depends_on"-          <*> v .:? "dupe_of"-          <*> v .:? "flags"-          <*> v .: "groups"-          <*> v .: "is_cc_accessible"-          <*> v .: "is_confirmed"-          <*> v .: "is_creator_accessible"-          <*> v .: "is_open"-          <*> v .: "keywords"-          <*> v .: "last_change_time"-          <*> v .: "op_sys"-          <*> v .: "platform"-          <*> v .: "priority"-          <*> v .: "product"-          <*> v .: "qa_contact"-          <*> v .: "resolution"-          <*> v .: "see_also"-          <*> v .: "severity"-          <*> v .: "status"-          <*> v .: "summary"-          <*> v .: "target_milestone"-          <*> v .: "url"-          <*> v .: "version"-          <*> v .: "whiteboard"-          <*> pure (customFields v)-          <*> v .:? "external_bugs"-  parseJSON _ = mzero--customFields :: Object ->-#if MIN_VERSION_aeson(2,0,0)-                M.KeyMap T.Text-#else-                M.HashMap T.Text T.Text-#endif-customFields = M.map stringifyCustomFields-             . M.filterWithKey filterCustomFields-  where-    stringifyCustomFields :: Value -> T.Text-    stringifyCustomFields (String t) = t-    stringifyCustomFields v          = T.concat-                                     . TL.toChunks-                                     . TLB.toLazyText-                                     . encodeToTextBuilder-                                     . toJSON-                                     $ v--    filterCustomFields k _ = "cf_" `T.isPrefixOf` toText k-#if !MIN_VERSION_aeson(2,0,0)-      where toText = id-#endif--newtype BugList = BugList [Bug]-               deriving (Eq, Show)--instance FromJSON BugList where-  parseJSON (Object v) = BugList <$> v .: "bugs"-  parseJSON _          = mzero--newtype BugIdList = BugIdList [BugId]-                 deriving (Eq, Show)--instance FromJSON BugIdList where-  parseJSON (Object v) = do-    bugs <- v .: "bugs"-    bugIds <- mapM (.: "id") bugs-    return $ BugIdList bugIds-  parseJSON _          = mzero---- | An attachment to a bug.-data Attachment = Attachment-  { attachmentId             :: !AttachmentId-  , attachmentBugId          :: !BugId-  , attachmentFileName       :: T.Text-  , attachmentSummary        :: T.Text-  , attachmentCreator        :: UserEmail-  , attachmentIsPrivate      :: Bool-  , attachmentIsObsolete     :: Bool-  , attachmentIsPatch        :: Bool-  , attachmentFlags          :: [Flag]-  , attachmentCreationTime   :: UTCTime-  , attachmentLastChangeTime :: UTCTime-  , attachmentContentType    :: T.Text-  , attachmentSize           :: !Int-  , attachmentData           :: T.Text-  } deriving (Eq, Show)--instance FromJSON Attachment where-  parseJSON (Object v) =-    Attachment <$> v .: "id"-               <*> v .: "bug_id"-               <*> v .: "file_name"-               <*> v .: "summary"-               <*> v .: "creator"-               <*> (fromNumericBool <$> v .: "is_private")-               <*> (fromNumericBool <$> v .: "is_obsolete")-               <*> (fromNumericBool <$> v .: "is_patch")-               <*> v .: "flags"-               <*> v .: "creation_time"-               <*> v .: "last_change_time"-               <*> v .: "content_type"-               <*> v .: "size"-               <*> v .: "data"-  parseJSON _ = mzero--fromNumericBool :: Int -> Bool-fromNumericBool 0 = False-fromNumericBool _ = True--newtype AttachmentList = AttachmentList [Attachment]-                      deriving (Eq, Show)--instance FromJSON AttachmentList where-  parseJSON (Object v) = do-    attachmentsVal <- v .: "attachments"-    bugsVal <- v .: "bugs"-    case (attachmentsVal, bugsVal) of-      (Object (M.toList -> [(_, as)]), _) -> AttachmentList . (:[]) <$> parseJSON as-      (_, Object (M.toList -> [(_, as)])) -> AttachmentList <$> parseJSON as-      _                                   -> mzero-  parseJSON _ = mzero---- | A bug comment. To display these the way Bugzilla does, you'll--- need to call 'getUser' and use the 'userRealName' for each user.-data Comment = Comment-  { commentId           :: !CommentId-  , commentBugId        :: !BugId-  , commentAttachmentId :: Maybe AttachmentId-  , commentCount        :: !Int-  , commentText         :: T.Text-  , commentCreator      :: UserEmail-  , commentCreationTime :: UTCTime-  , commentIsPrivate    :: Bool-  } deriving (Eq, Show)--instance FromJSON Comment where-  parseJSON (Object v) =-    Comment <$> v .: "id"-            <*> v .: "bug_id"-            <*> v .: "attachment_id"-            <*> v .: "count"-            <*> v .: "text"-            <*> v .: "creator"-            <*> v .: "creation_time"-            <*> v .: "is_private"-  parseJSON _ = mzero--newtype CommentList = CommentList [Comment]-                   deriving (Eq, Show)--instance FromJSON CommentList where-  parseJSON (Object v) = do-    bugsVal <- v .: "bugs"-    case bugsVal of-      Object (M.toList -> [(_, cs)]) ->-        do comments <- withObject "comments" (.: "comments") cs-           withArray "comment list" (\a -> CommentList <$> parseJSON (addCount a)) comments-      _ -> mzero-  parseJSON _ = mzero---- Note that we make the (possibly unwise) assumption that Bugzilla--- returns the comments in order. If it turns out that's not true, we--- can always sort by their 'id' to ensure correct results.-addCount :: V.Vector Value -> Value-addCount vs = Array $ V.zipWith addCount' (V.enumFromN 0 $ V.length vs) vs- where-   addCount' :: Int -> Value -> Value-   addCount' c (Object v) = Object $ M.insert "count" (Number $ fromIntegral c) v-   addCount' _ v          = v---- | History information for a bug.-data History = History-  { historyBugId   :: !BugId-  , historyEvents  :: [HistoryEvent]-  } deriving (Eq, Show)--instance FromJSON History where-  parseJSON (Object v) = do-    bugsVal <- v .: "bugs"-    case bugsVal of-      Array (V.toList -> [history]) ->-        withObject "history"-                   (\h -> History <$> h .: "id"-                                  <*> parseHistoryEvents h)-                   history-      _ -> mzero-  parseJSON _ = mzero--parseHistoryEvents :: Object -> Parser [HistoryEvent]-parseHistoryEvents h = do-  events <- h .: "history"-  withArray "event list" (parseJSON . addCount) events---- | An event in a bug's history.-data HistoryEvent = HistoryEvent-  { historyEventId      :: EventId   -- ^ A sequential event id.-  , historyEventTime    :: UTCTime   -- ^ When the event occurred.-  , historyEventUser    :: UserEmail -- ^ Which user was responsible.-  , historyEventChanges :: [Change]  -- ^ All the changes which are-                                     --   part of this event.-  } deriving (Eq, Show)--instance FromJSON HistoryEvent where-  parseJSON (Object v) =-    HistoryEvent <$> v .: "count"-                 <*> v .: "when"-                 <*> v .: "who"-                 <*> v .: "changes"-  parseJSON _ = mzero---- | A single change which is part of an event. Different constructors---   are used according to the type of the field. The 'Modification'---   describes the value of the field before and after the change.-data Change-  = TextFieldChange (Field T.Text) (Modification T.Text)-  | ListFieldChange (Field [T.Text]) (Modification [T.Text])-  | IntFieldChange (Field Int) (Modification Int)-  | TimeFieldChange (Field UTCTime) (Modification UTCTime)-  | BoolFieldChange (Field Bool) (Modification Bool)-    deriving (Eq, Show)--instance FromJSON Change where-  parseJSON (Object v) = do-    changedField <- v .: "field_name"-    case changedField of-      "alias"                  -> ListFieldChange AliasField <$> parseModification v-      "assigned_to"            -> TextFieldChange AssignedToField <$> parseModification v-      "attachments.submitter"  -> TextFieldChange AttachmentCreatorField <$> parseModification v-      "attach_data.thedata"    -> TextFieldChange AttachmentDataField <$> parseModification v-      "attachments.description"-> TextFieldChange AttachmentDescriptionField <$> parseModification v-      "attachments.filename"   -> TextFieldChange AttachmentFilenameField <$> parseModification v-      "attachments.isobsolete" -> BoolFieldChange AttachmentIsObsoleteField <$> parseModification v-      "attachments.ispatch"    -> BoolFieldChange AttachmentIsPatchField <$> parseModification v-      "attachments.isprivate"  -> BoolFieldChange AttachmentIsPrivateField <$> parseModification v-      "attachments.mimetype"   -> TextFieldChange AttachmentMimetypeField <$> parseModification v-      "blocks"                 -> IntFieldChange BlocksField <$> parseModification v-      "bug_id"                 -> IntFieldChange BugIdField <$> parseModification v-      "cc"                     -> TextFieldChange CcField <$> parseModification v-      "is_cc_accessible"       -> BoolFieldChange CcListAccessibleField <$> parseModification v-      "classification"         -> TextFieldChange ClassificationField <$> parseModification v-      "component"              -> ListFieldChange ComponentField <$> parseModification v-      "content"                -> TextFieldChange ContentField <$> parseModification v-      "creation_time"          -> TimeFieldChange CreationDateField <$> parseModification v-      "days_elapsed"           -> IntFieldChange DaysElapsedField <$> parseModification v-      "depends_on"             -> IntFieldChange DependsOnField <$> parseModification v-      "everconfirmed"          -> BoolFieldChange EverConfirmedField <$> parseModification v-      "flagtypes.name"         -> TextFieldChange FlagsField <$> parseModification v-      "bug_group"              -> TextFieldChange GroupField <$> parseModification v-      "keywords"               -> ListFieldChange KeywordsField <$> parseModification v-      "op_sys"                 -> TextFieldChange OperatingSystemField <$> parseModification v-      "platform"               -> TextFieldChange HardwareField <$> parseModification v-      "priority"               -> TextFieldChange PriorityField <$> parseModification v-      "product"                -> TextFieldChange ProductField <$> parseModification v-      "qa_contact"             -> TextFieldChange QaContactField <$> parseModification v-      "reporter"               -> TextFieldChange ReporterField <$> parseModification v-      "reporter_accessible"    -> BoolFieldChange ReporterAccessibleField <$> parseModification v-      "resolution"             -> TextFieldChange ResolutionField <$> parseModification v-      "restrict_comments"      -> BoolFieldChange RestrictCommentsField <$> parseModification v-      "see_also"               -> TextFieldChange SeeAlsoField <$> parseModification v-      "severity"               -> TextFieldChange SeverityField <$> parseModification v-      "status"                 -> TextFieldChange StatusField <$> parseModification v-      "whiteboard"             -> TextFieldChange WhiteboardField <$> parseModification v-      "summary"                -> TextFieldChange SummaryField <$> parseModification v-      "tag"                    -> TextFieldChange TagsField <$> parseModification v-      "target_milestone"       -> TextFieldChange TargetMilestoneField <$> parseModification v-      "url"                    -> TextFieldChange BugURLField <$> parseModification v-      "version"                -> TextFieldChange VersionField <$> parseModification v-      "votes"                  -> TextFieldChange VotesField <$> parseModification v-      name                     -> TextFieldChange (CustomField name) <$> parseModification v-  parseJSON _ = mzero---- | A description of how a field changed during a 'HistoryEvent'.-data (Eq a, Show a) => Modification a = Modification-  { modRemoved      :: Maybe a-  , modAdded        :: Maybe a-  , modAttachmentId :: Maybe AttachmentId-  } deriving (Eq, Show)--parseModification :: (FromJSON a, Eq b, Show b, ToModification a b) => Object -> Parser (Modification b)-parseModification v = Modification <$> (toMod =<< v .: "removed")-                                   <*> (toMod =<< v .: "added")-                                   <*> v .:? "attachment_id"--class ToModification a b | b -> a where toMod :: a -> Parser (Maybe b)-instance ToModification T.Text T.Text where toMod = return . Just-instance ToModification UTCTime UTCTime where toMod = return . Just--instance ToModification T.Text Int where-  toMod v | v == "" = return Nothing-          | otherwise = case TR.decimal v of-                          Left _       -> mzero-                          Right (i, _) -> return $ Just i--instance ToModification T.Text Bool where-  toMod v | v == "0"  = return $ Just False-          | v == "1"  = return $ Just True-          | otherwise = mzero--instance ToModification T.Text [T.Text] where-  toMod v = return . Just $ T.splitOn ", " v

@@ -1,147 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}---- | A modified version of Web.Bugzilla.Search to support---   the list fields in Red Hat's modified bugzilla API.--module Web.Bugzilla.RedHat.Search-(-  -- * Search operators-  (.==.)-, (./=.)-, (.<.)-, (.<=.)-, (.>.)-, (.>=.)-, (.=~.)-, (./=~.)-, equalsAny-, contains-, containsCase-, containsAny-, containsAll-, changedBefore-, changedAfter-, changedSince-, changedUntil-, changedRange-, changedFrom-, changedTo-, changedBy-, contentMatches-, isEmpty-, isNotEmpty-, (.&&.)-, (.||.)-, not'--  -- * Search expressions-, Field (..)-, SearchExpression-, evalSearchExpr-) where--import qualified Data.Text as T-import Data.Time.Clock (UTCTime(..))--import Web.Bugzilla.RedHat.Internal.Search-import Web.Bugzilla.RedHat.Internal.Types--(.==.) :: FieldType a => Field a -> a -> SearchExpression-(.==.) = (Term .) . BinaryOp "equals"-infix 4 .==.--(./=.) :: FieldType a => Field a -> a -> SearchExpression-(./=.) = (Term .) . BinaryOp "notequals"-infix 4 ./=.--(.<.) :: FieldType a => Field a -> a -> SearchExpression-(.<.) = (Term .) . BinaryOp "lessthan"-infix 4 .<.--(.<=.) :: FieldType a => Field a -> a -> SearchExpression-(.<=.) = (Term .) . BinaryOp "lessthaneq"-infix 4 .<=.--(.>.) :: FieldType a => Field a -> a -> SearchExpression-(.>.) = (Term .) . BinaryOp "greaterthan"-infix 4 .>.--(.>=.) :: FieldType a => Field a -> a -> SearchExpression-(.>=.) = (Term .) . BinaryOp "greaterthaneq"-infix 4 .>=.--(.=~.) :: FieldType a => Field a -> a -> SearchExpression-(.=~.) = (Term .) . BinaryOp "regexp"--(./=~.) :: FieldType a => Field a -> a -> SearchExpression-(./=~.) = (Term .) . BinaryOp "notregexp"--equalsAny :: FieldType a => Field a -> [a] -> SearchExpression-equalsAny = (Term .) . BinaryOp "anyexact"--contains :: Field T.Text -> T.Text -> SearchExpression-contains = (Term .) . BinaryOp "substring"--containsCase :: Field T.Text -> T.Text -> SearchExpression-containsCase = (Term .) . BinaryOp "casesubstring"--containsAny :: Field T.Text -> [T.Text] -> SearchExpression-containsAny = (Term .) . BinaryOp "anywordssubstr"--containsAll :: Field T.Text -> [T.Text] -> SearchExpression-containsAll = (Term .) . BinaryOp "allwordssubstr"--changedBefore :: FieldType a => Field a -> UTCTime -> SearchExpression-changedBefore = (Term .) . BinaryOp "changedbefore"--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"--changedTo :: FieldType a => Field a -> a -> SearchExpression-changedTo = (Term .) . BinaryOp "changedto"--changedBy :: FieldType a => Field a -> UserEmail -> SearchExpression-changedBy = (Term .) . BinaryOp "changedby"--contentMatches :: T.Text -> SearchExpression-contentMatches = Term . BinaryOp "matches" ContentField--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)-(.&&.) (And as) a = And (as ++ [a])-(.&&.) a (And as) = And (a:as)-(.&&.) a b        = And [a, b]-infixr 3 .&&.--(.||.) :: SearchExpression -> SearchExpression -> SearchExpression-(.||.) (Or as) (Or bs) = Or (as ++ bs)-(.||.) a (Or as) = Or (a:as)-(.||.) (Or as) a = Or (as ++ [a])-(.||.) a b       = Or [a, b]-infixr 2 .||.--not' :: SearchExpression -> SearchExpression-not' (Not a) = a-not' a       = Not a

@@ -0,0 +1,249 @@+{-# LANGUAGE OverloadedStrings #-}++-- | This package is designed to provide an easy-to-use, typesafe+--   interface to querying Bugzilla from Haskell.+--+--   A modified version of Web.Bugzilla to support+--   the list fields in Red Hat's modified bugzilla API.+--+--   A very simple program using this package might look like this:+--+-- >   let session = anonymousSession "https://bugzilla.redhat.com"+-- >       user = "me@example.org"+-- >       query = AssignedToField .==. user .&&.+-- >               FlagRequesteeField .==. user .&&.+-- >               (FlagsField `contains` "review" .||. FlagsField `contains` "feedback")+-- >   bugs <- searchBugs session query+-- >   mapM_ (putStrLn . show . bugSummary) bugs+--+--   There's a more in-depth demo program included with the+--   source code to this package.++module Web.RedHatBugzilla+( -- * Connecting to Bugzilla+  apikeySession+, anonymousSession++, BugzillaServer+, BugzillaSession (..)+, BugzillaApiKey (..)++  -- * Querying Bugzilla+, searchBugs+, searchBugsAll+, searchBugs'+, searchBugsWithLimit+, searchBugsAllWithLimit+, searchBugsWithLimit'+, getBug+, getBugAll+, getAttachment+, getAttachments+, getComments+, getHistory+, searchUsers+, getUser+, getUserById+, newBzRequest+, sendBzRequest+, intAsText++, Request+, BugId+, AttachmentId+, CommentId+, UserId+, EventId+, FlagId+, FlagType+, UserEmail+, Field (..)+, User (..)+, Flag (..)+, Bug (..)+, ExternalBug (..)+, ExternalType (..)+, Attachment (..)+, Comment (..)+, History (..)+, HistoryEvent (..)+, Change (..)+, Modification (..)+, fieldName++, BugzillaException (..)+) where++import Control.Exception (throw)+import Data.Aeson (FromJSON)+import qualified Data.Text as T++import Web.RedHatBugzilla.Internal.Network+import Web.RedHatBugzilla.Internal.Search+import Web.RedHatBugzilla.Internal.Types++-- | Creates a 'BugzillaSession' using the provided api key.+apikeySession :: BugzillaServer -> 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 :: BugzillaServer -> BugzillaSession+anonymousSession = AnonymousSession++intAsText :: Int -> T.Text+intAsText = T.pack . show++-- | Searches Bugzilla and returns a list of 'Bug's. The 'SearchExpression'+-- can be constructed conveniently using the operators in "Web.Bugzilla.Search".+searchBugs :: BugzillaSession -> SearchExpression -> IO [Bug]+searchBugs session search = do+  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+-- 'searchBugs'. 'searchBugs'' is suitable for cases where you won't need to call+-- 'getBug' most of the time - for example, polling to determine whether the+-- set of bugs returned by a query has changed.+searchBugs' :: BugzillaSession -> SearchExpression -> IO [BugId]+searchBugs' session search = do+  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 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+--   return all of the results for a very large query by default, but+--   you can request this by calling 'searchBugsWithLimit' with 0 for+--   the limit.+searchBugsWithLimit :: BugzillaSession+                    -> Int  -- ^ The maximum number of results to return.+                    -> Int  -- ^ The offset from the first result to start from.+                    -> SearchExpression+                    -> IO [Bug]+searchBugsWithLimit session limit offset search = do+  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+                     -> Int  -- ^ The maximum number of results to return.+                     -> Int  -- ^ The offset from the first result to start from.+                     -> SearchExpression+                     -> IO [BugId]+searchBugsWithLimit' session limit offset search = do+  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 = 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 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)+getAttachment session aid = do+  let req = newBzRequest session ["bug", "attachment", intAsText aid] []+  (AttachmentList as) <- sendBzRequest req+  case as of+    [a] -> return $ Just a+    []  -> return Nothing+    _   -> throw $ BugzillaUnexpectedValue+                   "Request for a single attachment returned multiple attachments"++-- | Get all attachments for a bug.+getAttachments :: BugzillaSession -> BugId -> IO [Attachment]+getAttachments session bid = do+  let req = newBzRequest session ["bug", intAsText bid, "attachment"] []+  (AttachmentList as) <- sendBzRequest req+  return as++-- | Get all comments for a bug.+getComments :: BugzillaSession -> BugId -> IO [Comment]+getComments session bid = do+  let req = newBzRequest session ["bug", intAsText bid, "comment"] []+  (CommentList as) <- sendBzRequest req+  return as++-- | Get the history for a bug.+getHistory :: BugzillaSession -> BugId -> IO History+getHistory session bid = do+  let req = newBzRequest session ["bug", intAsText bid, "history"] []+  sendBzRequest req++-- | Search user names and emails using a substring search.+searchUsers :: BugzillaSession -> T.Text -> IO [User]+searchUsers session text = do+  let req = newBzRequest session ["user"] [("match", Just text)]+  (UserList users) <- sendBzRequest req+  return users++-- | Get a user by email.+getUser :: BugzillaSession -> UserEmail -> IO (Maybe User)+getUser session user = do+  let req = newBzRequest session ["user", user] []+  (UserList users) <- sendBzRequest req+  case users of+    [u] -> return $ Just u+    []  -> return Nothing+    _   -> throw $ BugzillaUnexpectedValue+                   "Request for a single user returned multiple users"++-- | Get a user by user ID.+getUserById :: BugzillaSession -> UserId -> IO (Maybe User)+getUserById session uid = do+  let req = newBzRequest session ["user", intAsText uid] []+  (UserList users) <- sendBzRequest req+  case users of+    [u] -> return $ Just u+    []  -> return Nothing+    _   -> throw $ BugzillaUnexpectedValue+                   "Request for a single user returned multiple users"

@@ -0,0 +1,114 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++module Web.RedHatBugzilla.Internal.Network+( BugzillaServer+, BugzillaApiKey (..)+, BugzillaSession (..)+, BugzillaException (..)+, QueryPart+, Request+, requestUrl+, newBzRequest+, sendBzRequest+) where++import Blaze.ByteString.Builder (toByteString)+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>), (<*>))+#endif+import Control.Exception (Exception, throw)+import Control.Monad (mzero)+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)+import Data.Monoid ((<>))+#endif+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Data.Typeable+import Network.HTTP.Simple (defaultRequest, httpLBS, parseRequest)+import Network.HTTP.Conduit (Request(..), Response(..), host, path, port,+                             queryString, requestHeaders, secure)+import Network.HTTP.Types.URI (QueryText, encodePathSegments, renderQueryText)++type BugzillaServer  = T.Text++newtype BugzillaApiKey = BugzillaApiKey T.Text++-- | A session for Bugzilla queries. Use 'anonymousSession' and+-- 'loginSession', as appropriate, to create one.+data BugzillaSession = AnonymousSession BugzillaServer+                     | ApiKeySession BugzillaServer BugzillaApiKey++bzServer :: BugzillaSession -> BugzillaServer+bzServer (AnonymousSession svr) = svr+bzServer (ApiKeySession svr _)   = svr++data BugzillaException+  = BugzillaJSONParseError String+  | BugzillaAPIError Int String+  | BugzillaUnexpectedValue String+  deriving (Show, Typeable)++instance Exception BugzillaException++type QueryPart = (T.Text, Maybe T.Text)++requestUrl :: Request -> B.ByteString+requestUrl req = "https://" <> host req <> path req <> queryString req++sslRequest :: Request+sslRequest =+  defaultRequest {+    secure = True,+    port   = 443+  }++newBzRequest :: BugzillaSession -> [T.Text] -> QueryText -> Request+newBzRequest session methodParts query =+    let req =+          baseRequest {+          path = toByteString $ encodePathSegments $ "rest" : methodParts,+          queryString = toByteString $ renderQueryText True query+          }+    in case session of+         ApiKeySession _ (BugzillaApiKey key) ->+           req { requestHeaders = [("Authorization",+                                    "Bearer " <> TE.encodeUtf8 key)] }+         _ -> req+  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 session++data BzError = BzError Int String+               deriving (Eq, Show)++instance FromJSON BzError where+  parseJSON (Object v) = BzError <$> v .: "code"+                                 <*> v .: "message"+  parseJSON _          = mzero++handleError :: String -> BL.ByteString -> IO b+handleError parseError body = do+  let mError = eitherDecode body+  case mError of+    Left _                   -> throw $ BugzillaJSONParseError parseError+    Right (BzError code msg) -> throw $ BugzillaAPIError code msg++sendBzRequest :: FromJSON a => Request -> IO a+sendBzRequest req = runResourceT $ do+  response <- liftIO $ httpLBS req+  let mResult = eitherDecode $ responseBody response+  case mResult of+    Left msg      -> liftIO $ handleError msg (responseBody response)+    Right decoded -> return decoded

@@ -0,0 +1,90 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Operators which can be used to construct queries for Bugzilla.+--   These operators are intended to be typesafe: you should not be+--   able to construct a query that causes Bugzilla to return an+--   error. If you *are* able to construct an erroneous query, please+--   report a bug.+module Web.RedHatBugzilla.Internal.Search+( FieldType+, SearchTerm (..)+, SearchExpression (..)+, evalSearchExpr+) where++import Data.List+import qualified Data.Text as T+import Data.Time.Clock (UTCTime(..))+import Data.Time.ISO8601 (formatISO8601)++import Web.RedHatBugzilla.Internal.Network+import Web.RedHatBugzilla.Internal.Types++class FieldType a where fvAsText :: a -> T.Text++instance FieldType T.Text where fvAsText = id+instance FieldType Int where fvAsText = T.pack . show+instance FieldType UTCTime where fvAsText = T.pack . formatISO8601++instance FieldType Bool where+  fvAsText True  = "true"+  fvAsText False = "false"++instance FieldType a => FieldType [a] where+  fvAsText = T.intercalate "," . map fvAsText++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+  = And [SearchExpression]+  | Or [SearchExpression]+  | Not SearchExpression+  | Term SearchTerm++taggedQueryPart :: Int -> Char -> T.Text -> QueryPart+taggedQueryPart t k v = (T.cons k . T.pack . show $ t, Just v)++termQuery :: FieldType b => Int -> Field a -> T.Text -> b -> [QueryPart]+termQuery t f o v = [taggedQueryPart t 'f' (searchFieldName f),+                     taggedQueryPart t 'o' o,+                     taggedQueryPart t 'v' (fvAsText v)]++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+  where+    evalExprGroup :: Int -> [SearchExpression] -> (Int, [QueryPart])+    evalExprGroup t es =+      let (subExprT, subExprQs) = foldl' evalSubExpr (t + 1, []) es+          qs = taggedQueryPart t 'f' "OP" :+               taggedQueryPart subExprT 'f' "CP" :+               subExprQs+      in (subExprT + 1, qs)++    evalSubExpr :: (Int, [QueryPart]) -> SearchExpression -> (Int, [QueryPart])+    evalSubExpr (t, qs) expr = let (nextT, qs') = evalSearchExpr' t expr+                               in  (nextT, qs ++ qs')++    evalSearchExpr' :: Int -> SearchExpression -> (Int, [QueryPart])+    evalSearchExpr' t (And es) = evalExprGroup t es++    evalSearchExpr' t (Or es) =+      let (groupT, groupQs) = evalExprGroup t es+          qs = taggedQueryPart t 'j' "OR" : groupQs+      in (groupT + 1, qs)++    evalSearchExpr' t (Not es) =+      let (groupT, groupQs) = evalSearchExpr' t es+          qs = taggedQueryPart t 'n' "1" : groupQs+      in (groupT + 1, qs)++    evalSearchExpr' t (Term term) = (t + 1, evalSearchTerm t term)

@@ -0,0 +1,747 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++module Web.RedHatBugzilla.Internal.Types+( BugId+, AttachmentId+, CommentId+, UserId+, EventId+, FlagId+, FlagType+, UserEmail+, Field (..)+, User (..)+, UserList (..)+, Flag (..)+, ExternalType (..)+, ExternalBug (..)+, Bug (..)+, BugList (..)+, BugIdList (..)+, Attachment (..)+, AttachmentList (..)+, Comment (..)+, CommentList (..)+, History (..)+, HistoryEvent (..)+, Change (..)+, Modification (..)+, fieldName+, searchFieldName+) where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative (pure, (<$>), (<*>))+#endif+import Control.Monad (mzero)+import Data.Aeson+#if MIN_VERSION_aeson(1,0,0)+import Data.Aeson.Text+#else+import Data.Aeson.Encode+#endif+import Data.Aeson.Types+#if MIN_VERSION_aeson(2,0,0)+import Data.Aeson.Key+import qualified Data.Aeson.KeyMap as M+#else+import qualified Data.HashMap.Strict as M+#endif+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TLB+import qualified Data.Text.Read as TR+import qualified Data.Vector as V+import Data.Time.Clock (UTCTime(..))++type BugId        = Int+type AttachmentId = Int+type CommentId    = Int+type UserId       = Int+type EventId      = Int+type FlagId       = Int+type FlagType     = Int+type UserEmail    = T.Text++-- | A field which you can search by using 'Web.Bugzilla.searchBugs' or track+--   changes to using 'Web.Bugzilla.getHistory'. To get a human-readable name for+--   a field, use 'fieldName'.+data Field a where+  AliasField                    :: Field [T.Text]         -- Alias+  AssignedToField               :: Field UserEmail        -- Assignee+  AttachmentCreatorField        :: Field UserEmail        -- Attachment creator+  AttachmentDataField           :: Field T.Text           -- Attachment data+  AttachmentDescriptionField    :: Field T.Text           -- Attachment description+  AttachmentFilenameField       :: Field T.Text           -- Attachment filename+  AttachmentIsObsoleteField     :: Field Bool             -- Attachment is obsolete+  AttachmentIsPatchField        :: Field Bool             -- Attachment is patch+  AttachmentIsPrivateField      :: Field Bool             -- Attachment is private+  AttachmentMimetypeField       :: Field T.Text           -- Attachment mime type+  BlocksField                   :: Field Int              -- Blocks+  BugIdField                    :: Field Int              -- Bug ID+  CcField                       :: Field UserEmail        -- CC+  CcListAccessibleField         :: Field Bool             -- CC list accessible+  ClassificationField           :: Field T.Text           -- Classification+  CommentField                  :: Field T.Text           -- Comment+  CommentIsPrivateField         :: Field T.Text           -- Comment is private+  CommentTagsField              :: Field T.Text           -- Comment Tags+  CommenterField                :: Field UserEmail        -- Commenter+  ComponentField                :: Field [T.Text]         -- Component+  ContentField                  :: Field T.Text           -- Content+  CreationDateField             :: Field UTCTime          -- Creation date+  DaysElapsedField              :: Field Int              -- Days since bug changed+  DependsOnField                :: Field Int              -- Depends on+  EverConfirmedField            :: Field Bool             -- Ever confirmed+  FlagRequesteeField            :: Field UserEmail        -- Flag Requestee+  FlagSetterField               :: Field UserEmail        -- Flag Setter+  FlagsField                    :: Field T.Text           -- Flags+  GroupField                    :: Field T.Text           -- Group+  KeywordsField                 :: Field [T.Text]         -- Keywords+  ChangedField                  :: Field UTCTime          -- Changed+  CommentCountField             :: Field Int              -- Number of Comments+  OperatingSystemField          :: Field T.Text           -- OS+  HardwareField                 :: Field T.Text           -- Hardware+  PriorityField                 :: Field T.Text           -- Priority+  ProductField                  :: Field T.Text           -- Product+  QaContactField                :: Field UserEmail        -- QA Contact+  ReporterField                 :: Field UserEmail        -- Reporter+  ReporterAccessibleField       :: Field Bool             -- Reporter accessible+  ResolutionField               :: Field T.Text           -- Resolution+  RestrictCommentsField         :: Field Bool             -- Restrict Comments+  SeeAlsoField                  :: Field T.Text           -- See Also+  SeverityField                 :: Field T.Text           -- Severity+  StatusField                   :: Field T.Text           -- Status+  WhiteboardField               :: Field T.Text           -- Whiteboard+  SummaryField                  :: Field T.Text           -- Summary+  TagsField                     :: Field T.Text           -- Tags+  TargetMilestoneField          :: Field T.Text           -- Target Milestone+  TimeSinceAssigneeTouchedField :: Field Int              -- Time Since Assignee Touched+  BugURLField                   :: Field T.Text           -- URL+  VersionField                  :: Field T.Text           -- Version+  VotesField                    :: Field T.Text           -- Votes+  CustomField                   :: T.Text -> Field T.Text -- (Custom fields)++instance Eq (Field a) where+  (CustomField a) == (CustomField b) = a == b+  (CustomField _) == _               = False+  _ == (CustomField _)               = False+  a == b                             = searchFieldName a == searchFieldName b++instance Show (Field a) where+  show AliasField                    = "AliasField"+  show AssignedToField               = "AssignedToField"+  show AttachmentCreatorField        = "AttachmentCreatorField"+  show AttachmentDataField           = "AttachmentDataField"+  show AttachmentDescriptionField    = "AttachmentDescriptionField"+  show AttachmentFilenameField       = "AttachmentFilenameField"+  show AttachmentIsObsoleteField     = "AttachmentIsObsoleteField"+  show AttachmentIsPatchField        = "AttachmentIsPatchField"+  show AttachmentIsPrivateField      = "AttachmentIsPrivateField"+  show AttachmentMimetypeField       = "AttachmentMimetypeField"+  show BlocksField                   = "BlocksField"+  show BugIdField                    = "BugIdField"+  show CcField                       = "CcField"+  show CcListAccessibleField         = "CcListAccessibleField"+  show ClassificationField           = "ClassificationField"+  show CommentField                  = "CommentField"+  show CommentIsPrivateField         = "CommentIsPrivateField"+  show CommentTagsField              = "CommentTagsField"+  show CommenterField                = "CommenterField"+  show ComponentField                = "ComponentField"+  show ContentField                  = "ContentField"+  show CreationDateField             = "CreationDateField"+  show DaysElapsedField              = "DaysElapsedField"+  show DependsOnField                = "DependsOnField"+  show EverConfirmedField            = "EverConfirmedField"+  show FlagRequesteeField            = "FlagRequesteeField"+  show FlagSetterField               = "FlagSetterField"+  show FlagsField                    = "FlagsField"+  show GroupField                    = "GroupField"+  show KeywordsField                 = "KeywordsField"+  show ChangedField                  = "ChangedField"+  show CommentCountField             = "CommentCountField"+  show OperatingSystemField          = "OperatingSystemField"+  show HardwareField                 = "HardwareField"+  show PriorityField                 = "PriorityField"+  show ProductField                  = "ProductField"+  show QaContactField                = "QaContactField"+  show ReporterField                 = "ReporterField"+  show ReporterAccessibleField       = "ReporterAccessibleField"+  show ResolutionField               = "ResolutionField"+  show RestrictCommentsField         = "RestrictCommentsField"+  show SeeAlsoField                  = "SeeAlsoField"+  show SeverityField                 = "SeverityField"+  show StatusField                   = "StatusField"+  show WhiteboardField               = "WhiteboardField"+  show SummaryField                  = "SummaryField"+  show TagsField                     = "TagsField"+  show TargetMilestoneField          = "TargetMilestoneField"+  show TimeSinceAssigneeTouchedField = "TimeSinceAssigneeTouchedField"+  show BugURLField                   = "BugURLField"+  show VersionField                  = "VersionField"+  show VotesField                    = "VotesField"+  show (CustomField name)            = "CustomField " ++ show name++-- | Provides a human-readable name for a 'Field'.+fieldName :: Field a -> T.Text+fieldName AliasField                    = "Alias"+fieldName AssignedToField               = "Assigned to"+fieldName AttachmentCreatorField        = "Attachment creator"+fieldName AttachmentDataField           = "Attachment data"+fieldName AttachmentDescriptionField    = "Attachment description"+fieldName AttachmentFilenameField       = "Attachment filename"+fieldName AttachmentIsObsoleteField     = "Attachment is obsolete"+fieldName AttachmentIsPatchField        = "Attachment is patch"+fieldName AttachmentIsPrivateField      = "Attachment is private"+fieldName AttachmentMimetypeField       = "Attachment MIME type"+fieldName BlocksField                   = "Blocks"+fieldName BugIdField                    = "BugId"+fieldName CcField                       = "CC"+fieldName CcListAccessibleField         = "CC list is accessible"+fieldName ClassificationField           = "Classification"+fieldName CommentField                  = "Comment"+fieldName CommentIsPrivateField         = "Comment is private"+fieldName CommentTagsField              = "Comment tags"+fieldName CommenterField                = "Commenter"+fieldName ComponentField                = "Component"+fieldName ContentField                  = "Content"+fieldName CreationDateField             = "Creation date"+fieldName DaysElapsedField              = "Days elapsed"+fieldName DependsOnField                = "Depends on"+fieldName EverConfirmedField            = "Ever confirmed"+fieldName FlagRequesteeField            = "Flag requestee"+fieldName FlagSetterField               = "Flag setter"+fieldName FlagsField                    = "Flags"+fieldName GroupField                    = "Group"+fieldName KeywordsField                 = "Keywords"+fieldName ChangedField                  = "Changed"+fieldName CommentCountField             = "Comment count"+fieldName OperatingSystemField          = "Operating system"+fieldName HardwareField                 = "Hardware"+fieldName PriorityField                 = "Priority"+fieldName ProductField                  = "Product"+fieldName QaContactField                = "QA contact"+fieldName ReporterField                 = "Reporter"+fieldName ReporterAccessibleField       = "Reporter accessible"+fieldName ResolutionField               = "Resolution"+fieldName RestrictCommentsField         = "Restrict comments"+fieldName SeeAlsoField                  = "See also"+fieldName SeverityField                 = "Severity"+fieldName StatusField                   = "Status"+fieldName WhiteboardField               = "Whiteboard"+fieldName SummaryField                  = "Summary"+fieldName TagsField                     = "Tags"+fieldName TargetMilestoneField          = "Target milestone"+fieldName TimeSinceAssigneeTouchedField = "Time since assignee touched"+fieldName BugURLField                   = "Bug URL"+fieldName VersionField                  = "Version"+fieldName VotesField                    = "Votes"+fieldName (CustomField name)            = T.concat ["Custom field \"", T.pack (show name), "\""]++searchFieldName :: Field a -> T.Text+searchFieldName AliasField                    = "alias"+searchFieldName AssignedToField               = "assigned_to"+searchFieldName AttachmentCreatorField        = "attachments.submitter"+searchFieldName AttachmentDataField           = "attach_data.thedata"+searchFieldName AttachmentDescriptionField    = "attachments.description"+searchFieldName AttachmentFilenameField       = "attachments.filename"+searchFieldName AttachmentIsObsoleteField     = "attachments.isobsolete"+searchFieldName AttachmentIsPatchField        = "attachments.ispatch"+searchFieldName AttachmentIsPrivateField      = "attachments.isprivate"+searchFieldName AttachmentMimetypeField       = "attachments.mimetype"+searchFieldName BlocksField                   = "blocked"+searchFieldName BugIdField                    = "bug_id"+searchFieldName CcField                       = "cc"+searchFieldName CcListAccessibleField         = "cclist_accessible"+searchFieldName ClassificationField           = "classification"+searchFieldName CommentField                  = "longdesc"+searchFieldName CommentIsPrivateField         = "longdescs.isprivate"+searchFieldName CommentTagsField              = "comment_tag"+searchFieldName CommenterField                = "commenter"+searchFieldName ComponentField                = "component"+searchFieldName ContentField                  = "content"+searchFieldName CreationDateField             = "creation_ts"+searchFieldName DaysElapsedField              = "days_elapsed"+searchFieldName DependsOnField                = "dependson"+searchFieldName EverConfirmedField            = "everconfirmed"+searchFieldName FlagRequesteeField            = "requestees.login_name"+searchFieldName FlagSetterField               = "setters.login_name"+searchFieldName FlagsField                    = "flagtypes.name"+searchFieldName GroupField                    = "bug_group"+searchFieldName KeywordsField                 = "keywords"+searchFieldName ChangedField                  = "delta_ts"+searchFieldName CommentCountField             = "longdescs.count"+searchFieldName OperatingSystemField          = "op_sys"+searchFieldName HardwareField                 = "rep_platform"+searchFieldName PriorityField                 = "priority"+searchFieldName ProductField                  = "product"+searchFieldName QaContactField                = "qa_contact"+searchFieldName ReporterField                 = "reporter"+searchFieldName ReporterAccessibleField       = "reporter_accessible"+searchFieldName ResolutionField               = "resolution"+searchFieldName RestrictCommentsField         = "restrict_comments"+searchFieldName SeeAlsoField                  = "see_also"+searchFieldName SeverityField                 = "bug_severity"+searchFieldName StatusField                   = "bug_status"+searchFieldName WhiteboardField               = "status_whiteboard"+searchFieldName SummaryField                  = "short_desc"+searchFieldName TagsField                     = "tag"+searchFieldName TargetMilestoneField          = "target_milestone"+searchFieldName TimeSinceAssigneeTouchedField = "owner_idle_time"+searchFieldName BugURLField                   = "bug_file_loc"+searchFieldName VersionField                  = "version"+searchFieldName VotesField                    = "votes"+searchFieldName (CustomField name)            = name++-- | A Bugzilla user.+data User = User+  { userId       :: !UserId+  , userEmail    :: Maybe UserEmail+  , userName     :: T.Text+  , userRealName :: T.Text+  } deriving (Eq, Ord, Show)++instance FromJSON User where+  parseJSON (Object v) =+    User <$> v .: "id"+         <*> v .:? "email"+         <*> v .: "name"+         <*> v .: "real_name"+  parseJSON _ = mzero++newtype UserList = UserList [User]+                deriving (Eq, Show)++instance FromJSON UserList where+  parseJSON (Object v) = UserList <$> v .: "users"+  parseJSON _          = mzero++-- | Flags, which may be set on an attachment or on a bug directly.+data Flag = Flag+  { flagId               :: !FlagId+  , flagTypeId           :: !FlagType+  , flagName             :: T.Text+  , flagSetter           :: UserEmail+  , flagStatus           :: T.Text+  , flagCreationDate     :: UTCTime+  , flagModificationDate :: UTCTime+  , flagRequestee        :: Maybe UserEmail+  } deriving (Eq, Ord, Show)++instance FromJSON Flag where+  parseJSON (Object v) =+    Flag <$> v .: "id"+         <*> v .: "type_id"+         <*> v .: "name"+         <*> v .: "setter"+         <*> v .: "status"+         <*> v .: "creation_date"+         <*> v .: "modification_date"+         <*> 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+  , bugAlias               :: Maybe [T.Text]+  , bugAssignedTo          :: UserEmail+  , bugAssignedToDetail    :: User+  , bugBlocks              :: [BugId]+  , bugCc                  :: [UserEmail]+  , bugCcDetail            :: [User]+  , bugClassification      :: T.Text+  , bugComponent           :: [T.Text]+  , bugCreationTime        :: UTCTime+  , bugCreator             :: UserEmail+  , bugCreatorDetail       :: User+  , bugDependsOn           :: [BugId]+  , bugDupeOf              :: Maybe BugId+  , bugFlags               :: Maybe [Flag]+  , bugGroups              :: [T.Text]+  , bugIsCcAccessible      :: Bool+  , bugIsConfirmed         :: Bool+  , bugIsCreatorAccessible :: Bool+  , bugIsOpen              :: Bool+  , bugKeywords            :: [T.Text]+  , bugLastChangeTime      :: UTCTime+  , bugOpSys               :: T.Text+  , bugPlatform            :: T.Text+  , bugPriority            :: T.Text+  , bugProduct             :: T.Text+  , bugQaContact           :: UserEmail+  , bugResolution          :: T.Text+  , bugSeeAlso             :: [T.Text]+  , bugSeverity            :: T.Text+  , bugStatus              :: T.Text+  , bugSummary             :: T.Text+  , bugTargetMilestone     :: T.Text+  , bugUrl                 :: T.Text+  , bugVersion             :: [T.Text]+  , bugWhiteboard          :: T.Text+  , bugCustomFields        ::+#if MIN_VERSION_aeson(2,0,0)+                              M.KeyMap T.Text+#else+                              M.HashMap T.Text T.Text+#endif+, bugExternalBugs        :: Maybe [ExternalBug]+  } deriving (Eq, Show)++instance FromJSON Bug where+  parseJSON (Object v) =+      Bug <$> v .: "id"+          <*> v .:? "alias"+          <*> v .: "assigned_to"+          <*> v .: "assigned_to_detail"+          <*> v .: "blocks"+          <*> v .: "cc"+          <*> v .: "cc_detail"+          <*> v .: "classification"+          <*> v .: "component"+          <*> v .: "creation_time"+          <*> v .: "creator"+          <*> v .: "creator_detail"+          <*> v .: "depends_on"+          <*> v .:? "dupe_of"+          <*> v .:? "flags"+          <*> v .: "groups"+          <*> v .: "is_cc_accessible"+          <*> v .: "is_confirmed"+          <*> v .: "is_creator_accessible"+          <*> v .: "is_open"+          <*> v .: "keywords"+          <*> v .: "last_change_time"+          <*> v .: "op_sys"+          <*> v .: "platform"+          <*> v .: "priority"+          <*> v .: "product"+          <*> v .: "qa_contact"+          <*> v .: "resolution"+          <*> v .: "see_also"+          <*> v .: "severity"+          <*> v .: "status"+          <*> v .: "summary"+          <*> v .: "target_milestone"+          <*> v .: "url"+          <*> v .: "version"+          <*> v .: "whiteboard"+          <*> pure (customFields v)+          <*> v .:? "external_bugs"+  parseJSON _ = mzero++customFields :: Object ->+#if MIN_VERSION_aeson(2,0,0)+                M.KeyMap T.Text+#else+                M.HashMap T.Text T.Text+#endif+customFields = M.map stringifyCustomFields+             . M.filterWithKey filterCustomFields+  where+    stringifyCustomFields :: Value -> T.Text+    stringifyCustomFields (String t) = t+    stringifyCustomFields v          = T.concat+                                     . TL.toChunks+                                     . TLB.toLazyText+                                     . encodeToTextBuilder+                                     . toJSON+                                     $ v++    filterCustomFields k _ = "cf_" `T.isPrefixOf` toText k+#if !MIN_VERSION_aeson(2,0,0)+      where toText = id+#endif++newtype BugList = BugList [Bug]+               deriving (Eq, Show)++instance FromJSON BugList where+  parseJSON (Object v) = BugList <$> v .: "bugs"+  parseJSON _          = mzero++newtype BugIdList = BugIdList [BugId]+                 deriving (Eq, Show)++instance FromJSON BugIdList where+  parseJSON (Object v) = do+    bugs <- v .: "bugs"+    bugIds <- mapM (.: "id") bugs+    return $ BugIdList bugIds+  parseJSON _          = mzero++-- | An attachment to a bug.+data Attachment = Attachment+  { attachmentId             :: !AttachmentId+  , attachmentBugId          :: !BugId+  , attachmentFileName       :: T.Text+  , attachmentSummary        :: T.Text+  , attachmentCreator        :: UserEmail+  , attachmentIsPrivate      :: Bool+  , attachmentIsObsolete     :: Bool+  , attachmentIsPatch        :: Bool+  , attachmentFlags          :: [Flag]+  , attachmentCreationTime   :: UTCTime+  , attachmentLastChangeTime :: UTCTime+  , attachmentContentType    :: T.Text+  , attachmentSize           :: !Int+  , attachmentData           :: T.Text+  } deriving (Eq, Show)++instance FromJSON Attachment where+  parseJSON (Object v) =+    Attachment <$> v .: "id"+               <*> v .: "bug_id"+               <*> v .: "file_name"+               <*> v .: "summary"+               <*> v .: "creator"+               <*> (fromNumericBool <$> v .: "is_private")+               <*> (fromNumericBool <$> v .: "is_obsolete")+               <*> (fromNumericBool <$> v .: "is_patch")+               <*> v .: "flags"+               <*> v .: "creation_time"+               <*> v .: "last_change_time"+               <*> v .: "content_type"+               <*> v .: "size"+               <*> v .: "data"+  parseJSON _ = mzero++fromNumericBool :: Int -> Bool+fromNumericBool 0 = False+fromNumericBool _ = True++newtype AttachmentList = AttachmentList [Attachment]+                      deriving (Eq, Show)++instance FromJSON AttachmentList where+  parseJSON (Object v) = do+    attachmentsVal <- v .: "attachments"+    bugsVal <- v .: "bugs"+    case (attachmentsVal, bugsVal) of+      (Object (M.toList -> [(_, as)]), _) -> AttachmentList . (:[]) <$> parseJSON as+      (_, Object (M.toList -> [(_, as)])) -> AttachmentList <$> parseJSON as+      _                                   -> mzero+  parseJSON _ = mzero++-- | A bug comment. To display these the way Bugzilla does, you'll+-- need to call 'getUser' and use the 'userRealName' for each user.+data Comment = Comment+  { commentId           :: !CommentId+  , commentBugId        :: !BugId+  , commentAttachmentId :: Maybe AttachmentId+  , commentCount        :: !Int+  , commentText         :: T.Text+  , commentCreator      :: UserEmail+  , commentCreationTime :: UTCTime+  , commentIsPrivate    :: Bool+  } deriving (Eq, Show)++instance FromJSON Comment where+  parseJSON (Object v) =+    Comment <$> v .: "id"+            <*> v .: "bug_id"+            <*> v .: "attachment_id"+            <*> v .: "count"+            <*> v .: "text"+            <*> v .: "creator"+            <*> v .: "creation_time"+            <*> v .: "is_private"+  parseJSON _ = mzero++newtype CommentList = CommentList [Comment]+                   deriving (Eq, Show)++instance FromJSON CommentList where+  parseJSON (Object v) = do+    bugsVal <- v .: "bugs"+    case bugsVal of+      Object (M.toList -> [(_, cs)]) ->+        do comments <- withObject "comments" (.: "comments") cs+           withArray "comment list" (\a -> CommentList <$> parseJSON (addCount a)) comments+      _ -> mzero+  parseJSON _ = mzero++-- Note that we make the (possibly unwise) assumption that Bugzilla+-- returns the comments in order. If it turns out that's not true, we+-- can always sort by their 'id' to ensure correct results.+addCount :: V.Vector Value -> Value+addCount vs = Array $ V.zipWith addCount' (V.enumFromN 0 $ V.length vs) vs+ where+   addCount' :: Int -> Value -> Value+   addCount' c (Object v) = Object $ M.insert "count" (Number $ fromIntegral c) v+   addCount' _ v          = v++-- | History information for a bug.+data History = History+  { historyBugId   :: !BugId+  , historyEvents  :: [HistoryEvent]+  } deriving (Eq, Show)++instance FromJSON History where+  parseJSON (Object v) = do+    bugsVal <- v .: "bugs"+    case bugsVal of+      Array (V.toList -> [history]) ->+        withObject "history"+                   (\h -> History <$> h .: "id"+                                  <*> parseHistoryEvents h)+                   history+      _ -> mzero+  parseJSON _ = mzero++parseHistoryEvents :: Object -> Parser [HistoryEvent]+parseHistoryEvents h = do+  events <- h .: "history"+  withArray "event list" (parseJSON . addCount) events++-- | An event in a bug's history.+data HistoryEvent = HistoryEvent+  { historyEventId      :: EventId   -- ^ A sequential event id.+  , historyEventTime    :: UTCTime   -- ^ When the event occurred.+  , historyEventUser    :: UserEmail -- ^ Which user was responsible.+  , historyEventChanges :: [Change]  -- ^ All the changes which are+                                     --   part of this event.+  } deriving (Eq, Show)++instance FromJSON HistoryEvent where+  parseJSON (Object v) =+    HistoryEvent <$> v .: "count"+                 <*> v .: "when"+                 <*> v .: "who"+                 <*> v .: "changes"+  parseJSON _ = mzero++-- | A single change which is part of an event. Different constructors+--   are used according to the type of the field. The 'Modification'+--   describes the value of the field before and after the change.+data Change+  = TextFieldChange (Field T.Text) (Modification T.Text)+  | ListFieldChange (Field [T.Text]) (Modification [T.Text])+  | IntFieldChange (Field Int) (Modification Int)+  | TimeFieldChange (Field UTCTime) (Modification UTCTime)+  | BoolFieldChange (Field Bool) (Modification Bool)+    deriving (Eq, Show)++instance FromJSON Change where+  parseJSON (Object v) = do+    changedField <- v .: "field_name"+    case changedField of+      "alias"                  -> ListFieldChange AliasField <$> parseModification v+      "assigned_to"            -> TextFieldChange AssignedToField <$> parseModification v+      "attachments.submitter"  -> TextFieldChange AttachmentCreatorField <$> parseModification v+      "attach_data.thedata"    -> TextFieldChange AttachmentDataField <$> parseModification v+      "attachments.description"-> TextFieldChange AttachmentDescriptionField <$> parseModification v+      "attachments.filename"   -> TextFieldChange AttachmentFilenameField <$> parseModification v+      "attachments.isobsolete" -> BoolFieldChange AttachmentIsObsoleteField <$> parseModification v+      "attachments.ispatch"    -> BoolFieldChange AttachmentIsPatchField <$> parseModification v+      "attachments.isprivate"  -> BoolFieldChange AttachmentIsPrivateField <$> parseModification v+      "attachments.mimetype"   -> TextFieldChange AttachmentMimetypeField <$> parseModification v+      "blocks"                 -> IntFieldChange BlocksField <$> parseModification v+      "bug_id"                 -> IntFieldChange BugIdField <$> parseModification v+      "cc"                     -> TextFieldChange CcField <$> parseModification v+      "is_cc_accessible"       -> BoolFieldChange CcListAccessibleField <$> parseModification v+      "classification"         -> TextFieldChange ClassificationField <$> parseModification v+      "component"              -> ListFieldChange ComponentField <$> parseModification v+      "content"                -> TextFieldChange ContentField <$> parseModification v+      "creation_time"          -> TimeFieldChange CreationDateField <$> parseModification v+      "days_elapsed"           -> IntFieldChange DaysElapsedField <$> parseModification v+      "depends_on"             -> IntFieldChange DependsOnField <$> parseModification v+      "everconfirmed"          -> BoolFieldChange EverConfirmedField <$> parseModification v+      "flagtypes.name"         -> TextFieldChange FlagsField <$> parseModification v+      "bug_group"              -> TextFieldChange GroupField <$> parseModification v+      "keywords"               -> ListFieldChange KeywordsField <$> parseModification v+      "op_sys"                 -> TextFieldChange OperatingSystemField <$> parseModification v+      "platform"               -> TextFieldChange HardwareField <$> parseModification v+      "priority"               -> TextFieldChange PriorityField <$> parseModification v+      "product"                -> TextFieldChange ProductField <$> parseModification v+      "qa_contact"             -> TextFieldChange QaContactField <$> parseModification v+      "reporter"               -> TextFieldChange ReporterField <$> parseModification v+      "reporter_accessible"    -> BoolFieldChange ReporterAccessibleField <$> parseModification v+      "resolution"             -> TextFieldChange ResolutionField <$> parseModification v+      "restrict_comments"      -> BoolFieldChange RestrictCommentsField <$> parseModification v+      "see_also"               -> TextFieldChange SeeAlsoField <$> parseModification v+      "severity"               -> TextFieldChange SeverityField <$> parseModification v+      "status"                 -> TextFieldChange StatusField <$> parseModification v+      "whiteboard"             -> TextFieldChange WhiteboardField <$> parseModification v+      "summary"                -> TextFieldChange SummaryField <$> parseModification v+      "tag"                    -> TextFieldChange TagsField <$> parseModification v+      "target_milestone"       -> TextFieldChange TargetMilestoneField <$> parseModification v+      "url"                    -> TextFieldChange BugURLField <$> parseModification v+      "version"                -> TextFieldChange VersionField <$> parseModification v+      "votes"                  -> TextFieldChange VotesField <$> parseModification v+      name                     -> TextFieldChange (CustomField name) <$> parseModification v+  parseJSON _ = mzero++-- | A description of how a field changed during a 'HistoryEvent'.+data (Eq a, Show a) => Modification a = Modification+  { modRemoved      :: Maybe a+  , modAdded        :: Maybe a+  , modAttachmentId :: Maybe AttachmentId+  } deriving (Eq, Show)++parseModification :: (FromJSON a, Eq b, Show b, ToModification a b) => Object -> Parser (Modification b)+parseModification v = Modification <$> (toMod =<< v .: "removed")+                                   <*> (toMod =<< v .: "added")+                                   <*> v .:? "attachment_id"++class ToModification a b | b -> a where toMod :: a -> Parser (Maybe b)+instance ToModification T.Text T.Text where toMod = return . Just+instance ToModification UTCTime UTCTime where toMod = return . Just++instance ToModification T.Text Int where+  toMod v | v == "" = return Nothing+          | otherwise = case TR.decimal v of+                          Left _       -> mzero+                          Right (i, _) -> return $ Just i++instance ToModification T.Text Bool where+  toMod v | v == "0"  = return $ Just False+          | v == "1"  = return $ Just True+          | otherwise = mzero++instance ToModification T.Text [T.Text] where+  toMod v = return . Just $ T.splitOn ", " v

@@ -0,0 +1,146 @@+{-# LANGUAGE OverloadedStrings #-}++-- | A modified version of Web.Bugzilla.Search to support+--   the list fields in Red Hat's modified bugzilla API.++module Web.RedHatBugzilla.Search+(+  -- * Search operators+  (.==.)+, (./=.)+, (.<.)+, (.<=.)+, (.>.)+, (.>=.)+, (.=~.)+, (./=~.)+, equalsAny+, contains+, containsCase+, containsAny+, containsAll+, changedBefore+, changedAfter+, changedSince+, changedUntil+, changedRange+, changedFrom+, changedTo+, changedBy+, contentMatches+, isEmpty+, isNotEmpty+, (.&&.)+, (.||.)+, not'++  -- * Search expressions+, Field (..)+, SearchExpression+, evalSearchExpr+) where++import qualified Data.Text as T+import Data.Time.Clock (UTCTime(..))++import Web.RedHatBugzilla.Internal.Search+import Web.RedHatBugzilla.Internal.Types++(.==.) :: FieldType a => Field a -> a -> SearchExpression+(.==.) = (Term .) . BinaryOp "equals"+infix 4 .==.++(./=.) :: FieldType a => Field a -> a -> SearchExpression+(./=.) = (Term .) . BinaryOp "notequals"+infix 4 ./=.++(.<.) :: FieldType a => Field a -> a -> SearchExpression+(.<.) = (Term .) . BinaryOp "lessthan"+infix 4 .<.++(.<=.) :: FieldType a => Field a -> a -> SearchExpression+(.<=.) = (Term .) . BinaryOp "lessthaneq"+infix 4 .<=.++(.>.) :: FieldType a => Field a -> a -> SearchExpression+(.>.) = (Term .) . BinaryOp "greaterthan"+infix 4 .>.++(.>=.) :: FieldType a => Field a -> a -> SearchExpression+(.>=.) = (Term .) . BinaryOp "greaterthaneq"+infix 4 .>=.++(.=~.) :: FieldType a => Field a -> a -> SearchExpression+(.=~.) = (Term .) . BinaryOp "regexp"++(./=~.) :: FieldType a => Field a -> a -> SearchExpression+(./=~.) = (Term .) . BinaryOp "notregexp"++equalsAny :: FieldType a => Field a -> [a] -> SearchExpression+equalsAny = (Term .) . BinaryOp "anyexact"++contains :: Field T.Text -> T.Text -> SearchExpression+contains = (Term .) . BinaryOp "substring"++containsCase :: Field T.Text -> T.Text -> SearchExpression+containsCase = (Term .) . BinaryOp "casesubstring"++containsAny :: Field T.Text -> [T.Text] -> SearchExpression+containsAny = (Term .) . BinaryOp "anywordssubstr"++containsAll :: Field T.Text -> [T.Text] -> SearchExpression+containsAll = (Term .) . BinaryOp "allwordssubstr"++changedBefore :: FieldType a => Field a -> UTCTime -> SearchExpression+changedBefore = (Term .) . BinaryOp "changedbefore"++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"++changedTo :: FieldType a => Field a -> a -> SearchExpression+changedTo = (Term .) . BinaryOp "changedto"++changedBy :: FieldType a => Field a -> UserEmail -> SearchExpression+changedBy = (Term .) . BinaryOp "changedby"++contentMatches :: T.Text -> SearchExpression+contentMatches = Term . BinaryOp "matches" ContentField++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)+(.&&.) (And as) a = And (as ++ [a])+(.&&.) a (And as) = And (a:as)+(.&&.) a b        = And [a, b]+infixr 3 .&&.++(.||.) :: SearchExpression -> SearchExpression -> SearchExpression+(.||.) (Or as) (Or bs) = Or (as ++ bs)+(.||.) a (Or as) = Or (a:as)+(.||.) (Or as) a = Or (as ++ [a])+(.||.) a b       = Or [a, b]+infixr 2 .||.++not' :: SearchExpression -> SearchExpression+not' (Not a) = a+not' a       = Not a

@@ -4,7 +4,7 @@ module Main (main) where  import Test.Hspec-import Web.Bugzilla.RedHat.Search+import Web.RedHatBugzilla.Search  main :: IO () main = hspec spec