{-# 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 "bugzilla.example.org"
-- >   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
, anonymousSession

, BugzillaServer
, BugzillaContext
, BugzillaSession (..)
, BugzillaToken (..)

  -- * Querying Bugzilla
, searchBugs
, searchBugs'
, searchBugsWithLimit
, searchBugsWithLimit'
, getBug
, getAttachment
, getAttachments
, getComments
, getHistory
, searchUsers
, getUser
, getUserById
, newBzRequest
, sendBzRequest
, intAsText

, BugId
, AttachmentId
, CommentId
, UserId
, EventId
, FlagId
, FlagType
, UserEmail
, Field (..)
, User (..)
, Flag (..)
, Bug (..)
, Attachment (..)
, Comment (..)
, History (..)
, HistoryEvent (..)
, Change (..)
, Modification (..)
, fieldName

, BugzillaException (..)
) where

import Control.Exception (throw, try)
import Control.Monad.IO.Class (liftIO)
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 :: BugzillaServer -> IO BugzillaContext
newBugzillaContext server :: BugzillaServer
server = do
  let settings :: ManagerSettings
settings = TLSSettings -> Maybe SockSettings -> ManagerSettings
mkManagerSettings (Bool -> Bool -> Bool -> TLSSettings
TLSSettingsSimple Bool
True Bool
False Bool
False) Maybe SockSettings
forall a. Maybe a
Nothing
  Manager
manager <- IO Manager -> IO Manager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Manager -> IO Manager) -> IO Manager -> IO Manager
forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
newManager ManagerSettings
settings
  BugzillaContext -> IO BugzillaContext
forall (m :: * -> *) a. Monad m => a -> m a
return (BugzillaContext -> IO BugzillaContext)
-> BugzillaContext -> IO BugzillaContext
forall a b. (a -> b) -> a -> b
$ BugzillaServer -> Manager -> BugzillaContext
BugzillaContext BugzillaServer
server Manager
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 :: BugzillaContext
-> BugzillaServer -> BugzillaServer -> IO (Maybe BugzillaSession)
loginSession ctx :: BugzillaContext
ctx user :: BugzillaServer
user password :: BugzillaServer
password = do
  let loginQuery :: [(BugzillaServer, Maybe BugzillaServer)]
loginQuery = [("login", BugzillaServer -> Maybe BugzillaServer
forall a. a -> Maybe a
Just BugzillaServer
user),
                    ("password", BugzillaServer -> Maybe BugzillaServer
forall a. a -> Maybe a
Just BugzillaServer
password)]
      session :: BugzillaSession
session = BugzillaContext -> BugzillaSession
anonymousSession BugzillaContext
ctx
      req :: Request
req = BugzillaSession
-> [BugzillaServer]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> Request
newBzRequest BugzillaSession
session ["login"] [(BugzillaServer, Maybe BugzillaServer)]
loginQuery
  Either BugzillaException BugzillaToken
eToken <- IO BugzillaToken -> IO (Either BugzillaException BugzillaToken)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO BugzillaToken -> IO (Either BugzillaException BugzillaToken))
-> IO BugzillaToken -> IO (Either BugzillaException BugzillaToken)
forall a b. (a -> b) -> a -> b
$ BugzillaSession -> Request -> IO BugzillaToken
forall a. FromJSON a => BugzillaSession -> Request -> IO a
sendBzRequest BugzillaSession
session Request
req
  Maybe BugzillaSession -> IO (Maybe BugzillaSession)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BugzillaSession -> IO (Maybe BugzillaSession))
-> Maybe BugzillaSession -> IO (Maybe BugzillaSession)
forall a b. (a -> b) -> a -> b
$ case Either BugzillaException BugzillaToken
eToken of
             Left (BugzillaAPIError 300 _) -> Maybe BugzillaSession
forall a. Maybe a
Nothing
             Left e :: BugzillaException
e                        -> BugzillaException -> Maybe BugzillaSession
forall a e. Exception e => e -> a
throw BugzillaException
e
             Right token :: BugzillaToken
token                   -> BugzillaSession -> Maybe BugzillaSession
forall a. a -> Maybe a
Just (BugzillaSession -> Maybe BugzillaSession)
-> BugzillaSession -> Maybe BugzillaSession
forall a b. (a -> b) -> a -> b
$ BugzillaContext -> BugzillaToken -> BugzillaSession
LoginSession BugzillaContext
ctx BugzillaToken
token

-- | Creates an anonymous 'BugzillaSession'. Note that some content
--   will be hidden by Bugzilla when you make queries in this state.
anonymousSession :: BugzillaContext -> BugzillaSession
anonymousSession :: BugzillaContext -> BugzillaSession
anonymousSession = BugzillaContext -> BugzillaSession
AnonymousSession

intAsText :: Int -> T.Text
intAsText :: Int -> BugzillaServer
intAsText = String -> BugzillaServer
T.pack (String -> BugzillaServer)
-> (Int -> String) -> Int -> BugzillaServer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
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 :: BugzillaSession -> SearchExpression -> IO [Bug]
searchBugs session :: BugzillaSession
session search :: SearchExpression
search = do
  let searchQuery :: [(BugzillaServer, Maybe BugzillaServer)]
searchQuery = SearchExpression -> [(BugzillaServer, Maybe BugzillaServer)]
evalSearchExpr SearchExpression
search
      req :: Request
req = BugzillaSession
-> [BugzillaServer]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> Request
newBzRequest BugzillaSession
session ["bug"] [(BugzillaServer, Maybe BugzillaServer)]
searchQuery
  (BugList bugs :: [Bug]
bugs) <- BugzillaSession -> Request -> IO BugList
forall a. FromJSON a => BugzillaSession -> Request -> IO a
sendBzRequest BugzillaSession
session Request
req
  [Bug] -> IO [Bug]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bug]
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' :: BugzillaSession -> SearchExpression -> IO [Int]
searchBugs' session :: BugzillaSession
session search :: SearchExpression
search = do
  let fieldsQuery :: [(BugzillaServer, Maybe BugzillaServer)]
fieldsQuery = [("include_fields", BugzillaServer -> Maybe BugzillaServer
forall a. a -> Maybe a
Just "id")]
      searchQuery :: [(BugzillaServer, Maybe BugzillaServer)]
searchQuery = SearchExpression -> [(BugzillaServer, Maybe BugzillaServer)]
evalSearchExpr SearchExpression
search
      req :: Request
req = BugzillaSession
-> [BugzillaServer]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> Request
newBzRequest BugzillaSession
session ["bug"] ([(BugzillaServer, Maybe BugzillaServer)]
fieldsQuery [(BugzillaServer, Maybe BugzillaServer)]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> [(BugzillaServer, Maybe BugzillaServer)]
forall a. [a] -> [a] -> [a]
++ [(BugzillaServer, Maybe BugzillaServer)]
searchQuery)
  (BugIdList bugs :: [Int]
bugs) <- BugzillaSession -> Request -> IO BugIdList
forall a. FromJSON a => BugzillaSession -> Request -> IO a
sendBzRequest BugzillaSession
session Request
req
  [Int] -> IO [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
bugs

-- | 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 :: BugzillaSession -> Int -> Int -> SearchExpression -> IO [Bug]
searchBugsWithLimit session :: BugzillaSession
session limit :: Int
limit offset :: Int
offset search :: SearchExpression
search = do
  let limitQuery :: [(BugzillaServer, Maybe BugzillaServer)]
limitQuery = [("limit", BugzillaServer -> Maybe BugzillaServer
forall a. a -> Maybe a
Just (BugzillaServer -> Maybe BugzillaServer)
-> BugzillaServer -> Maybe BugzillaServer
forall a b. (a -> b) -> a -> b
$ Int -> BugzillaServer
intAsText Int
limit),
                    ("offset", BugzillaServer -> Maybe BugzillaServer
forall a. a -> Maybe a
Just (BugzillaServer -> Maybe BugzillaServer)
-> BugzillaServer -> Maybe BugzillaServer
forall a b. (a -> b) -> a -> b
$ Int -> BugzillaServer
intAsText Int
offset)]
      searchQuery :: [(BugzillaServer, Maybe BugzillaServer)]
searchQuery = SearchExpression -> [(BugzillaServer, Maybe BugzillaServer)]
evalSearchExpr SearchExpression
search
      req :: Request
req = BugzillaSession
-> [BugzillaServer]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> Request
newBzRequest BugzillaSession
session ["bug"] ([(BugzillaServer, Maybe BugzillaServer)]
limitQuery [(BugzillaServer, Maybe BugzillaServer)]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> [(BugzillaServer, Maybe BugzillaServer)]
forall a. [a] -> [a] -> [a]
++ [(BugzillaServer, Maybe BugzillaServer)]
searchQuery)
  (BugList bugs :: [Bug]
bugs) <- BugzillaSession -> Request -> IO BugList
forall a. FromJSON a => BugzillaSession -> Request -> IO a
sendBzRequest BugzillaSession
session Request
req
  [Bug] -> IO [Bug]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bug]
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' :: BugzillaSession -> Int -> Int -> SearchExpression -> IO [Int]
searchBugsWithLimit' session :: BugzillaSession
session limit :: Int
limit offset :: Int
offset search :: SearchExpression
search = do
  let fieldsQuery :: [(BugzillaServer, Maybe BugzillaServer)]
fieldsQuery = [("include_fields", BugzillaServer -> Maybe BugzillaServer
forall a. a -> Maybe a
Just "id")]
      limitQuery :: [(BugzillaServer, Maybe BugzillaServer)]
limitQuery = [("limit", BugzillaServer -> Maybe BugzillaServer
forall a. a -> Maybe a
Just (BugzillaServer -> Maybe BugzillaServer)
-> BugzillaServer -> Maybe BugzillaServer
forall a b. (a -> b) -> a -> b
$ Int -> BugzillaServer
intAsText Int
limit),
                    ("offset", BugzillaServer -> Maybe BugzillaServer
forall a. a -> Maybe a
Just (BugzillaServer -> Maybe BugzillaServer)
-> BugzillaServer -> Maybe BugzillaServer
forall a b. (a -> b) -> a -> b
$ Int -> BugzillaServer
intAsText Int
offset)]
      searchQuery :: [(BugzillaServer, Maybe BugzillaServer)]
searchQuery = SearchExpression -> [(BugzillaServer, Maybe BugzillaServer)]
evalSearchExpr SearchExpression
search
      req :: Request
req = BugzillaSession
-> [BugzillaServer]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> Request
newBzRequest BugzillaSession
session ["bug"] ([(BugzillaServer, Maybe BugzillaServer)]
fieldsQuery [(BugzillaServer, Maybe BugzillaServer)]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> [(BugzillaServer, Maybe BugzillaServer)]
forall a. [a] -> [a] -> [a]
++ [(BugzillaServer, Maybe BugzillaServer)]
limitQuery [(BugzillaServer, Maybe BugzillaServer)]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> [(BugzillaServer, Maybe BugzillaServer)]
forall a. [a] -> [a] -> [a]
++ [(BugzillaServer, Maybe BugzillaServer)]
searchQuery)
  (BugIdList bugs :: [Int]
bugs) <- BugzillaSession -> Request -> IO BugIdList
forall a. FromJSON a => BugzillaSession -> Request -> IO a
sendBzRequest BugzillaSession
session Request
req
  [Int] -> IO [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
bugs

-- | Retrieve a bug by bug number.
getBug :: BugzillaSession -> BugId -> IO (Maybe Bug)
getBug :: BugzillaSession -> Int -> IO (Maybe Bug)
getBug session :: BugzillaSession
session bid :: Int
bid = do
  let req :: Request
req = BugzillaSession
-> [BugzillaServer]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> Request
newBzRequest BugzillaSession
session ["bug", Int -> BugzillaServer
intAsText Int
bid] []
  (BugList bugs :: [Bug]
bugs) <- BugzillaSession -> Request -> IO BugList
forall a. FromJSON a => BugzillaSession -> Request -> IO a
sendBzRequest BugzillaSession
session Request
req
  case [Bug]
bugs of
    [bug :: Bug
bug] -> Maybe Bug -> IO (Maybe Bug)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bug -> IO (Maybe Bug)) -> Maybe Bug -> IO (Maybe Bug)
forall a b. (a -> b) -> a -> b
$ Bug -> Maybe Bug
forall a. a -> Maybe a
Just Bug
bug
    []    -> Maybe Bug -> IO (Maybe Bug)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bug
forall a. Maybe a
Nothing
    _     -> BugzillaException -> IO (Maybe Bug)
forall a e. Exception e => e -> a
throw (BugzillaException -> IO (Maybe Bug))
-> BugzillaException -> IO (Maybe Bug)
forall a b. (a -> b) -> a -> b
$ String -> BugzillaException
BugzillaUnexpectedValue
                     "Request for a single bug returned multiple bugs"

-- | Retrieve a bug by attachment number.
getAttachment :: BugzillaSession -> AttachmentId -> IO (Maybe Attachment)
getAttachment :: BugzillaSession -> Int -> IO (Maybe Attachment)
getAttachment session :: BugzillaSession
session aid :: Int
aid = do
  let req :: Request
req = BugzillaSession
-> [BugzillaServer]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> Request
newBzRequest BugzillaSession
session ["bug", "attachment", Int -> BugzillaServer
intAsText Int
aid] []
  (AttachmentList as :: [Attachment]
as) <- BugzillaSession -> Request -> IO AttachmentList
forall a. FromJSON a => BugzillaSession -> Request -> IO a
sendBzRequest BugzillaSession
session Request
req
  case [Attachment]
as of
    [a :: Attachment
a] -> Maybe Attachment -> IO (Maybe Attachment)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Attachment -> IO (Maybe Attachment))
-> Maybe Attachment -> IO (Maybe Attachment)
forall a b. (a -> b) -> a -> b
$ Attachment -> Maybe Attachment
forall a. a -> Maybe a
Just Attachment
a
    []  -> Maybe Attachment -> IO (Maybe Attachment)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Attachment
forall a. Maybe a
Nothing
    _   -> BugzillaException -> IO (Maybe Attachment)
forall a e. Exception e => e -> a
throw (BugzillaException -> IO (Maybe Attachment))
-> BugzillaException -> IO (Maybe Attachment)
forall a b. (a -> b) -> a -> b
$ String -> BugzillaException
BugzillaUnexpectedValue
                   "Request for a single attachment returned multiple attachments"

-- | Get all attachments for a bug.
getAttachments :: BugzillaSession -> BugId -> IO [Attachment]
getAttachments :: BugzillaSession -> Int -> IO [Attachment]
getAttachments session :: BugzillaSession
session bid :: Int
bid = do
  let req :: Request
req = BugzillaSession
-> [BugzillaServer]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> Request
newBzRequest BugzillaSession
session ["bug", Int -> BugzillaServer
intAsText Int
bid, "attachment"] []
  (AttachmentList as :: [Attachment]
as) <- BugzillaSession -> Request -> IO AttachmentList
forall a. FromJSON a => BugzillaSession -> Request -> IO a
sendBzRequest BugzillaSession
session Request
req
  [Attachment] -> IO [Attachment]
forall (m :: * -> *) a. Monad m => a -> m a
return [Attachment]
as

-- | Get all comments for a bug.
getComments :: BugzillaSession -> BugId -> IO [Comment]
getComments :: BugzillaSession -> Int -> IO [Comment]
getComments session :: BugzillaSession
session bid :: Int
bid = do
  let req :: Request
req = BugzillaSession
-> [BugzillaServer]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> Request
newBzRequest BugzillaSession
session ["bug", Int -> BugzillaServer
intAsText Int
bid, "comment"] []
  (CommentList as :: [Comment]
as) <- BugzillaSession -> Request -> IO CommentList
forall a. FromJSON a => BugzillaSession -> Request -> IO a
sendBzRequest BugzillaSession
session Request
req
  [Comment] -> IO [Comment]
forall (m :: * -> *) a. Monad m => a -> m a
return [Comment]
as

-- | Get the history for a bug.
getHistory :: BugzillaSession -> BugId -> IO History
getHistory :: BugzillaSession -> Int -> IO History
getHistory session :: BugzillaSession
session bid :: Int
bid = do
  let req :: Request
req = BugzillaSession
-> [BugzillaServer]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> Request
newBzRequest BugzillaSession
session ["bug", Int -> BugzillaServer
intAsText Int
bid, "history"] []
  BugzillaSession -> Request -> IO History
forall a. FromJSON a => BugzillaSession -> Request -> IO a
sendBzRequest BugzillaSession
session Request
req

-- | Search user names and emails using a substring search.
searchUsers :: BugzillaSession -> T.Text -> IO [User]
searchUsers :: BugzillaSession -> BugzillaServer -> IO [User]
searchUsers session :: BugzillaSession
session text :: BugzillaServer
text = do
  let req :: Request
req = BugzillaSession
-> [BugzillaServer]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> Request
newBzRequest BugzillaSession
session ["user"] [("match", BugzillaServer -> Maybe BugzillaServer
forall a. a -> Maybe a
Just BugzillaServer
text)]
  (UserList users :: [User]
users) <- BugzillaSession -> Request -> IO UserList
forall a. FromJSON a => BugzillaSession -> Request -> IO a
sendBzRequest BugzillaSession
session Request
req
  [User] -> IO [User]
forall (m :: * -> *) a. Monad m => a -> m a
return [User]
users

-- | Get a user by email.
getUser :: BugzillaSession -> UserEmail -> IO (Maybe User)
getUser :: BugzillaSession -> BugzillaServer -> IO (Maybe User)
getUser session :: BugzillaSession
session user :: BugzillaServer
user = do
  let req :: Request
req = BugzillaSession
-> [BugzillaServer]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> Request
newBzRequest BugzillaSession
session ["user", BugzillaServer
user] []
  (UserList users :: [User]
users) <- BugzillaSession -> Request -> IO UserList
forall a. FromJSON a => BugzillaSession -> Request -> IO a
sendBzRequest BugzillaSession
session Request
req
  case [User]
users of
    [u :: User
u] -> Maybe User -> IO (Maybe User)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe User -> IO (Maybe User)) -> Maybe User -> IO (Maybe User)
forall a b. (a -> b) -> a -> b
$ User -> Maybe User
forall a. a -> Maybe a
Just User
u
    []  -> Maybe User -> IO (Maybe User)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe User
forall a. Maybe a
Nothing
    _   -> BugzillaException -> IO (Maybe User)
forall a e. Exception e => e -> a
throw (BugzillaException -> IO (Maybe User))
-> BugzillaException -> IO (Maybe User)
forall a b. (a -> b) -> a -> b
$ String -> BugzillaException
BugzillaUnexpectedValue
                   "Request for a single user returned multiple users"

-- | Get a user by user ID.
getUserById :: BugzillaSession -> UserId -> IO (Maybe User)
getUserById :: BugzillaSession -> Int -> IO (Maybe User)
getUserById session :: BugzillaSession
session uid :: Int
uid = do
  let req :: Request
req = BugzillaSession
-> [BugzillaServer]
-> [(BugzillaServer, Maybe BugzillaServer)]
-> Request
newBzRequest BugzillaSession
session ["user", Int -> BugzillaServer
intAsText Int
uid] []
  (UserList users :: [User]
users) <- BugzillaSession -> Request -> IO UserList
forall a. FromJSON a => BugzillaSession -> Request -> IO a
sendBzRequest BugzillaSession
session Request
req
  case [User]
users of
    [u :: User
u] -> Maybe User -> IO (Maybe User)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe User -> IO (Maybe User)) -> Maybe User -> IO (Maybe User)
forall a b. (a -> b) -> a -> b
$ User -> Maybe User
forall a. a -> Maybe a
Just User
u
    []  -> Maybe User -> IO (Maybe User)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe User
forall a. Maybe a
Nothing
    _   -> BugzillaException -> IO (Maybe User)
forall a e. Exception e => e -> a
throw (BugzillaException -> IO (Maybe User))
-> BugzillaException -> IO (Maybe User)
forall a b. (a -> b) -> a -> b
$ String -> BugzillaException
BugzillaUnexpectedValue
                   "Request for a single user returned multiple users"