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
)