{-# LANGUAGE CPP #-}

{-|
Module      :  GitHub.REST
Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com>
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)

#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.Key (fromText)
#endif

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 :: forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either Value a)
githubTry = 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' :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Status -> m a -> m (Either Value a)
githubTry' Status
status = forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust forall {a}. FromJSON a => HttpException -> Maybe a
statusException (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right
  where
    statusException :: HttpException -> Maybe a
statusException (HttpExceptionRequest Request
_ (StatusCodeException Response ()
r ByteString
body))
      | forall body. Response body -> Status
responseStatus Response ()
r forall a. Eq a => a -> a -> Bool
== Status
status = forall a. FromJSON a => ByteString -> Maybe a
decode forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
ByteStringL.fromStrict ByteString
body
    statusException HttpException
_ = 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
.: :: forall a. FromJSON a => Value -> Text -> a
(.:) Value
v Text
key = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => [Char] -> a
error forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Parser b) -> a -> Either [Char] b
parseEither Value -> Parser a
parseObject Value
v
  where
    parseObject :: Value -> Parser a
parseObject = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"parseObject" (forall a. FromJSON a => Object -> Key -> Parser a
`parseField` Text -> Key
fromText Text
key)

#if !MIN_VERSION_aeson(2,0,0)
fromText :: Text -> Text
fromText = id
#endif