{-# 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 :: BugzillaSession -> BugzillaServer
bzServer (AnonymousSession BugzillaServer
svr) = BugzillaServer
svr
bzServer (ApiKeySession BugzillaServer
svr BugzillaApiKey
_)   = BugzillaServer
svr

data BugzillaException
  = BugzillaJSONParseError String
  | BugzillaAPIError Int String
  | BugzillaUnexpectedValue String
  deriving (Int -> BugzillaException -> ShowS
[BugzillaException] -> ShowS
BugzillaException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BugzillaException] -> ShowS
$cshowList :: [BugzillaException] -> ShowS
show :: BugzillaException -> String
$cshow :: BugzillaException -> String
showsPrec :: Int -> BugzillaException -> ShowS
$cshowsPrec :: Int -> BugzillaException -> ShowS
Show, Typeable)

instance Exception BugzillaException

type QueryPart = (T.Text, Maybe T.Text)

requestUrl :: Request -> B.ByteString
requestUrl :: Request -> ByteString
requestUrl Request
req = ByteString
"https://" forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
host Request
req forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
path Request
req forall a. Semigroup a => a -> a -> a
<> Request -> ByteString
queryString Request
req

sslRequest :: Request
sslRequest :: Request
sslRequest =
  Request
defaultRequest {
    secure :: Bool
secure = Bool
True,
    port :: Int
port   = Int
443
  }

newBzRequest :: BugzillaSession -> [T.Text] -> QueryText -> Request
newBzRequest :: BugzillaSession -> [BugzillaServer] -> QueryText -> Request
newBzRequest BugzillaSession
session [BugzillaServer]
methodParts QueryText
query =
    let req :: Request
req =
          Request
baseRequest {
          path :: ByteString
path = Builder -> ByteString
toByteString forall a b. (a -> b) -> a -> b
$ [BugzillaServer] -> Builder
encodePathSegments forall a b. (a -> b) -> a -> b
$ BugzillaServer
"rest" forall a. a -> [a] -> [a]
: [BugzillaServer]
methodParts,
          queryString :: ByteString
queryString = Builder -> ByteString
toByteString forall a b. (a -> b) -> a -> b
$ Bool -> QueryText -> Builder
renderQueryText Bool
True QueryText
query
          }
    in case BugzillaSession
session of
         ApiKeySession BugzillaServer
_ (BugzillaApiKey BugzillaServer
key) ->
           Request
req { requestHeaders :: RequestHeaders
requestHeaders = [(HeaderName
"Authorization",
                                    ByteString
"Bearer " forall a. Semigroup a => a -> a -> a
<> BugzillaServer -> ByteString
TE.encodeUtf8 BugzillaServer
key)] }
         BugzillaSession
_ -> Request
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 :: Request
baseRequest = forall a. a -> Maybe a -> a
fromMaybe (Request
sslRequest { host :: ByteString
host = ByteString
serverBytes }) (forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
serverStr)
    serverBytes :: ByteString
serverBytes = BugzillaServer -> ByteString
TE.encodeUtf8 BugzillaServer
serverTxt
    serverStr :: String
serverStr = BugzillaServer -> String
T.unpack BugzillaServer
serverTxt
    serverTxt :: BugzillaServer
serverTxt = BugzillaSession -> BugzillaServer
bzServer BugzillaSession
session

data BzError = BzError Int String
               deriving (BzError -> BzError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BzError -> BzError -> Bool
$c/= :: BzError -> BzError -> Bool
== :: BzError -> BzError -> Bool
$c== :: BzError -> BzError -> Bool
Eq, Int -> BzError -> ShowS
[BzError] -> ShowS
BzError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BzError] -> ShowS
$cshowList :: [BzError] -> ShowS
show :: BzError -> String
$cshow :: BzError -> String
showsPrec :: Int -> BzError -> ShowS
$cshowsPrec :: Int -> BzError -> ShowS
Show)

instance FromJSON BzError where
  parseJSON :: Value -> Parser BzError
parseJSON (Object Object
v) = Int -> String -> BzError
BzError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
  parseJSON Value
_          = forall (m :: * -> *) a. MonadPlus m => m a
mzero

handleError :: String -> BL.ByteString -> IO b
handleError :: forall b. String -> ByteString -> IO b
handleError String
parseError ByteString
body = do
  let mError :: Either String BzError
mError = forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body
  case Either String BzError
mError of
    Left String
_                   -> forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ String -> BugzillaException
BugzillaJSONParseError String
parseError
    Right (BzError Int
code String
msg) -> forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ Int -> String -> BugzillaException
BugzillaAPIError Int
code String
msg

sendBzRequest :: FromJSON a => Request -> IO a
sendBzRequest :: forall a. FromJSON a => Request -> IO a
sendBzRequest Request
req = forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ do
  Response ByteString
response <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLBS Request
req
  let mResult :: Either String a
mResult = forall a. FromJSON a => ByteString -> Either String a
eitherDecode forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
responseBody Response ByteString
response
  case Either String a
mResult of
    Left String
msg      -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall b. String -> ByteString -> IO b
handleError String
msg (forall body. Response body -> body
responseBody Response ByteString
response)
    Right a
decoded -> forall (m :: * -> *) a. Monad m => a -> m a
return a
decoded