{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Utils.ThankYouStars.GitHub (
      Token(..)
    , GitHubRepo(..)
    , readToken
    , starRepo
    ) where

import           Control.Exception     ( catch, throwIO )
import           Data.Aeson
import           Data.ByteString       ( ByteString )
import qualified Data.ByteString.Lazy  as BSL
import           Data.String           ( fromString )
import           Data.Text.Encoding    ( encodeUtf8 )
import           Data.Version          ( showVersion )
import           Network.HTTP.Req
import           Paths_thank_you_stars ( version )

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

instance FromJSON Token where
    parseJSON :: Value -> Parser Token
parseJSON (Object Object
v) = ByteString -> Token
Token (ByteString -> Token) -> (Text -> ByteString) -> Text -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> Token) -> Parser Text -> Parser Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"token"
    parseJSON Value
_          = String -> Parser Token
forall a. HasCallStack => String -> a
error String
"invalid format"

readToken :: FilePath -> IO (Either String Token)
readToken :: String -> IO (Either String Token)
readToken String
fp = ByteString -> Either String Token
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String Token)
-> IO ByteString -> IO (Either String Token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BSL.readFile String
fp

data GitHubRepo = GitHubRepo {
      GitHubRepo -> String
owner :: String
    , GitHubRepo -> String
repo  :: String
    } deriving ( GitHubRepo -> GitHubRepo -> Bool
(GitHubRepo -> GitHubRepo -> Bool)
-> (GitHubRepo -> GitHubRepo -> Bool) -> Eq GitHubRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitHubRepo -> GitHubRepo -> Bool
$c/= :: GitHubRepo -> GitHubRepo -> Bool
== :: GitHubRepo -> GitHubRepo -> Bool
$c== :: GitHubRepo -> GitHubRepo -> Bool
Eq, Eq GitHubRepo
Eq GitHubRepo
-> (GitHubRepo -> GitHubRepo -> Ordering)
-> (GitHubRepo -> GitHubRepo -> Bool)
-> (GitHubRepo -> GitHubRepo -> Bool)
-> (GitHubRepo -> GitHubRepo -> Bool)
-> (GitHubRepo -> GitHubRepo -> Bool)
-> (GitHubRepo -> GitHubRepo -> GitHubRepo)
-> (GitHubRepo -> GitHubRepo -> GitHubRepo)
-> Ord GitHubRepo
GitHubRepo -> GitHubRepo -> Bool
GitHubRepo -> GitHubRepo -> Ordering
GitHubRepo -> GitHubRepo -> GitHubRepo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GitHubRepo -> GitHubRepo -> GitHubRepo
$cmin :: GitHubRepo -> GitHubRepo -> GitHubRepo
max :: GitHubRepo -> GitHubRepo -> GitHubRepo
$cmax :: GitHubRepo -> GitHubRepo -> GitHubRepo
>= :: GitHubRepo -> GitHubRepo -> Bool
$c>= :: GitHubRepo -> GitHubRepo -> Bool
> :: GitHubRepo -> GitHubRepo -> Bool
$c> :: GitHubRepo -> GitHubRepo -> Bool
<= :: GitHubRepo -> GitHubRepo -> Bool
$c<= :: GitHubRepo -> GitHubRepo -> Bool
< :: GitHubRepo -> GitHubRepo -> Bool
$c< :: GitHubRepo -> GitHubRepo -> Bool
compare :: GitHubRepo -> GitHubRepo -> Ordering
$ccompare :: GitHubRepo -> GitHubRepo -> Ordering
$cp1Ord :: Eq GitHubRepo
Ord )

instance Show GitHubRepo where
    show :: GitHubRepo -> String
show GitHubRepo
ghr = String
"https://github.com/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ GitHubRepo -> String
owner GitHubRepo
ghr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ GitHubRepo -> String
repo GitHubRepo
ghr

starringUrl :: GitHubRepo -> Url 'Https
starringUrl :: GitHubRepo -> Url 'Https
starringUrl GitHubRepo
ghr =
    Text -> Url 'Https
https Text
"api.github.com" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"user" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"starred" Url 'Https -> String -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GitHubRepo -> String
owner GitHubRepo
ghr Url 'Https -> String -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GitHubRepo -> String
repo GitHubRepo
ghr

userAgent :: Option scheme
userAgent :: Option scheme
userAgent = ByteString -> ByteString -> Option scheme
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"User-Agent" ByteString
agent
    where
        agent :: ByteString
agent = ByteString
"thank-you-stars/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Version -> String
showVersion Version
version)

-- Warning suppressed by a GHC option
instance MonadHttp IO where
    handleHttpException :: HttpException -> IO a
handleHttpException = HttpException -> IO a
forall e a. Exception e => e -> IO a
throwIO

starRepo :: Token -> GitHubRepo -> IO (Either HttpException ())
starRepo :: Token -> GitHubRepo -> IO (Either HttpException ())
starRepo Token
token GitHubRepo
ghr =
    (do
            let headers :: Option 'Https
headers = ByteString -> Option 'Https
oAuth2Token (Token -> ByteString
unToken Token
token) Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Option 'Https
forall (scheme :: Scheme). Option scheme
userAgent
            IgnoreResponse
_ <- PUT
-> Url 'Https
-> NoReqBody
-> Proxy IgnoreResponse
-> Option 'Https
-> IO IgnoreResponse
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpResponse response,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req PUT
PUT (GitHubRepo -> Url 'Https
starringUrl GitHubRepo
ghr) NoReqBody
NoReqBody Proxy IgnoreResponse
ignoreResponse Option 'Https
headers
            Either HttpException () -> IO (Either HttpException ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HttpException () -> IO (Either HttpException ()))
-> Either HttpException () -> IO (Either HttpException ())
forall a b. (a -> b) -> a -> b
$ () -> Either HttpException ()
forall a b. b -> Either a b
Right ()
        ) IO (Either HttpException ())
-> (HttpException -> IO (Either HttpException ()))
-> IO (Either HttpException ())
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(HttpException
e :: HttpException) -> do
            Either HttpException () -> IO (Either HttpException ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HttpException () -> IO (Either HttpException ()))
-> Either HttpException () -> IO (Either HttpException ())
forall a b. (a -> b) -> a -> b
$ HttpException -> Either HttpException ()
forall a b. a -> Either a b
Left HttpException
e
        )