{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{-|
Module      :  GitHub.REST.Auth
Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com>
Stability   :  experimental
Portability :  portable

Definitions for handling authentication with the GitHub REST API.
-}
module GitHub.REST.Auth (
  Token (..),
  fromToken,

  -- * Helpers for using JWT tokens with the GitHub API
  getJWTToken,
  loadSigner,
) where

import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString

#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Time (addUTCTime, getCurrentTime)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import qualified Web.JWT as JWT

#if MIN_VERSION_jwt(0,11,0)
type EncodeSigner = JWT.EncodeSigner
#else
type EncodeSigner = JWT.Signer
#endif

-- | The token to use to authenticate with GitHub.
data Token
  = -- | https://developer.github.com/v3/#authentication
    AccessToken ByteString
  | -- | https://developer.github.com/apps/building-github-apps/authenticating-with-github-apps/#authenticating-as-a-github-app
    BearerToken ByteString
  deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
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)

fromToken :: Token -> ByteString
fromToken :: Token -> ByteString
fromToken = \case
  AccessToken ByteString
t -> ByteString
"token " forall a. Semigroup a => a -> a -> a
<> ByteString
t
  BearerToken ByteString
t -> ByteString
"bearer " forall a. Semigroup a => a -> a -> a
<> ByteString
t

-- | The ID of your GitHub application
type AppId = Int

-- | Create a JWT token that expires in 10 minutes.
getJWTToken :: EncodeSigner -> AppId -> IO Token
getJWTToken :: EncodeSigner -> Int -> IO Token
getJWTToken EncodeSigner
signer Int
appId = UTCTime -> Token
mkToken forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getNow
  where
    mkToken :: UTCTime -> Token
mkToken UTCTime
now =
      let claims :: JWTClaimsSet
claims =
            forall a. Monoid a => a
mempty
              { iat :: Maybe IntDate
JWT.iat = NominalDiffTime -> Maybe IntDate
JWT.numericDate forall a b. (a -> b) -> a -> b
$ UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds UTCTime
now
              , exp :: Maybe IntDate
JWT.exp = NominalDiffTime -> Maybe IntDate
JWT.numericDate forall a b. (a -> b) -> a -> b
$ UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds UTCTime
now forall a. Num a => a -> a -> a
+ (NominalDiffTime
10 forall a. Num a => a -> a -> a
* NominalDiffTime
60)
              , iss :: Maybe StringOrURI
JWT.iss = Text -> Maybe StringOrURI
JWT.stringOrURI forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
appId
              }
       in ByteString -> Token
BearerToken forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 forall a b. (a -> b) -> a -> b
$ EncodeSigner -> JWTClaimsSet -> Text
signToken EncodeSigner
signer JWTClaimsSet
claims
    -- lose a second in the case of rounding
    -- https://github.community/t5/GitHub-API-Development-and/quot-Expiration-time-claim-exp-is-too-far-in-the-future-quot/m-p/20457/highlight/true#M1127
    getNow :: IO UTCTime
getNow = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime

signToken :: EncodeSigner -> JWT.JWTClaimsSet -> Text
#if MIN_VERSION_jwt(0,10,0)
signToken :: EncodeSigner -> JWTClaimsSet -> Text
signToken = forall a b c. (a -> b -> c) -> b -> a -> c
flip EncodeSigner -> JOSEHeader -> JWTClaimsSet -> Text
JWT.encodeSigned forall a. Monoid a => a
mempty
#else
signToken = JWT.encodeSigned
#endif

-- | Load a RSA private key as a Signer from the given file path.
loadSigner :: FilePath -> IO EncodeSigner
loadSigner :: String -> IO EncodeSigner
loadSigner String
file = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. IO a
badSigner forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe EncodeSigner
readSigner forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ByteString
ByteString.readFile String
file
  where
    badSigner :: IO a
badSigner = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Not a valid RSA private key file: " forall a. [a] -> [a] -> [a]
++ String
file
    readSigner :: ByteString -> Maybe EncodeSigner
readSigner = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrivateKey -> EncodeSigner
toEncodeRSAPrivateKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe PrivateKey
JWT.readRsaSecret

#if MIN_VERSION_jwt(0,11,0)
    toEncodeRSAPrivateKey :: PrivateKey -> EncodeSigner
toEncodeRSAPrivateKey = PrivateKey -> EncodeSigner
JWT.EncodeRSAPrivateKey
#else
    toEncodeRSAPrivateKey = JWT.RSAPrivateKey
#endif