{- |
Module      :  GitHub.REST
Maintainer  :  Brandon Chinn <brandon@leapyear.io>
Stability   :  experimental
Portability :  portable

Definitions for querying the GitHub REST API. See README.md for an example.
-}
module GitHub.REST (
  -- * Monad transformer and type-class for querying the GitHub REST API
  MonadGitHubREST (..),
  GitHubT,
  GitHubSettings (..),
  runGitHubT,

  -- * GitHub authentication
  Token (..),

  -- * GitHub Endpoints
  GHEndpoint (..),
  GitHubData,
  EndpointVals,

  -- * KeyValue pairs
  KeyValue (..),

  -- * Helpers
  githubTry,
  githubTry',
  (.:),

  -- * Re-exports
  StdMethod (..),
) where

import Control.Monad.IO.Unlift (MonadUnliftIO)
import Data.Aeson (FromJSON, Value (..), decode, withObject)
import Data.Aeson.Types (parseEither, parseField)
import qualified Data.ByteString.Lazy as ByteStringL
import Data.Text (Text)
import Network.HTTP.Client (
  HttpException (..),
  HttpExceptionContent (..),
  Response (..),
 )
import Network.HTTP.Types (Status, StdMethod (..), status422)
import UnliftIO.Exception (handleJust)

import GitHub.REST.Auth
import GitHub.REST.Endpoint
import GitHub.REST.KeyValue
import GitHub.REST.Monad

{- HTTP exception handling -}

{- | Handle 422 exceptions thrown by the GitHub REST API.

 Most client errors are 422, since we should always be sending valid JSON. If an endpoint
 throws different error codes, use githubTry'.

 https://developer.github.com/v3/#client-errors
-}
githubTry :: MonadUnliftIO m => m a -> m (Either Value a)
githubTry :: m a -> m (Either Value a)
githubTry = Status -> m a -> m (Either Value a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Status -> m a -> m (Either Value a)
githubTry' Status
status422

-- | Handle the given exception thrown by the GitHub REST API.
githubTry' :: MonadUnliftIO m => Status -> m a -> m (Either Value a)
githubTry' :: Status -> m a -> m (Either Value a)
githubTry' Status
status = (HttpException -> Maybe Value)
-> (Value -> m (Either Value a))
-> m (Either Value a)
-> m (Either Value a)
forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust HttpException -> Maybe Value
forall a. FromJSON a => HttpException -> Maybe a
statusException (Either Value a -> m (Either Value a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Value a -> m (Either Value a))
-> (Value -> Either Value a) -> Value -> m (Either Value a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either Value a
forall a b. a -> Either a b
Left) (m (Either Value a) -> m (Either Value a))
-> (m a -> m (Either Value a)) -> m a -> m (Either Value a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either Value a) -> m a -> m (Either Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either Value a
forall a b. b -> Either a b
Right
  where
    statusException :: HttpException -> Maybe a
statusException (HttpExceptionRequest Request
_ (StatusCodeException Response ()
r ByteString
body))
      | Response () -> Status
forall body. Response body -> Status
responseStatus Response ()
r Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status = ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe a) -> ByteString -> Maybe a
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
ByteStringL.fromStrict ByteString
body
    statusException HttpException
_ = Maybe a
forall a. Maybe a
Nothing

{- Aeson helpers -}

-- | Get the given key from the Value, erroring if it doesn't exist.
(.:) :: FromJSON a => Value -> Text -> a
.: :: Value -> Text -> a
(.:) Value
v Text
key = ([Char] -> a) -> (a -> a) -> Either [Char] a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> a
forall a. HasCallStack => [Char] -> a
error a -> a
forall a. a -> a
id (Either [Char] a -> a) -> Either [Char] a -> a
forall a b. (a -> b) -> a -> b
$ (Value -> Parser a) -> Value -> Either [Char] a
forall a b. (a -> Parser b) -> a -> Either [Char] b
parseEither Value -> Parser a
parseObject Value
v
  where
    parseObject :: Value -> Parser a
parseObject = [Char] -> (Object -> Parser a) -> Value -> Parser a
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"parseObject" (Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
`parseField` Text
key)