{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} 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.Monoid ((<>)) 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 { unToken :: ByteString } deriving ( Eq, Show ) instance FromJSON Token where parseJSON (Object v) = Token . encodeUtf8 <$> v .: "token" readToken :: FilePath -> IO (Either String Token) readToken fp = eitherDecode <$> BSL.readFile fp data GitHubRepo = GitHubRepo { owner :: String , repo :: String } deriving ( Eq, Ord ) instance Show GitHubRepo where show ghr = "https://github.com/" ++ owner ghr ++ "/" ++ repo ghr starringUrl :: GitHubRepo -> Url 'Https starringUrl ghr = https "api.github.com" /: "user" /: "starred" /~ owner ghr /~ repo ghr userAgent :: Option scheme userAgent = header "User-Agent" agent where agent = "thank-you-stars/" <> fromString (showVersion version) instance MonadHttp IO where handleHttpException = throwIO starRepo :: Token -> GitHubRepo -> IO (Either HttpException ()) starRepo token ghr = (do let headers = oAuth2Token (unToken token) <> userAgent _ <- req PUT (starringUrl ghr) NoReqBody ignoreResponse headers return $ Right () ) `catch` (\(e :: HttpException) -> do return $ Left e )