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

{- |
Module      :  GitHub.REST.Auth
Maintainer  :  Brandon Chinn <brandon@leapyear.io>
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 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

-- | 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
(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)

fromToken :: Token -> ByteString
fromToken :: Token -> ByteString
fromToken = \case
  AccessToken ByteString
t -> ByteString
"token " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
t
  BearerToken ByteString
t -> ByteString
"bearer " ByteString -> ByteString -> ByteString
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 :: JWT.Signer -> AppId -> IO Token
getJWTToken :: Signer -> Int -> IO Token
getJWTToken Signer
signer Int
appId = UTCTime -> Token
mkToken (UTCTime -> Token) -> IO UTCTime -> IO Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getNow
  where
#if MIN_VERSION_jwt(0,10,0)
    signToken :: Signer -> JWTClaimsSet -> Text
signToken = (Signer -> JOSEHeader -> JWTClaimsSet -> Text)
-> JOSEHeader -> Signer -> JWTClaimsSet -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Signer -> JOSEHeader -> JWTClaimsSet -> Text
JWT.encodeSigned JOSEHeader
forall a. Monoid a => a
mempty
#else
    signToken = JWT.encodeSigned
#endif
    mkToken :: UTCTime -> Token
mkToken UTCTime
now =
      let claims :: JWTClaimsSet
claims =
            JWTClaimsSet
forall a. Monoid a => a
mempty
              { iat :: Maybe IntDate
JWT.iat = NominalDiffTime -> Maybe IntDate
JWT.numericDate (NominalDiffTime -> Maybe IntDate)
-> NominalDiffTime -> Maybe IntDate
forall a b. (a -> b) -> a -> b
$ UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds UTCTime
now
              , exp :: Maybe IntDate
JWT.exp = NominalDiffTime -> Maybe IntDate
JWT.numericDate (NominalDiffTime -> Maybe IntDate)
-> NominalDiffTime -> Maybe IntDate
forall a b. (a -> b) -> a -> b
$ UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds UTCTime
now NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ (NominalDiffTime
10 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
60)
              , iss :: Maybe StringOrURI
JWT.iss = Text -> Maybe StringOrURI
JWT.stringOrURI (Text -> Maybe StringOrURI) -> Text -> Maybe StringOrURI
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
appId
              }
       in ByteString -> Token
BearerToken (ByteString -> Token) -> (Text -> ByteString) -> Text -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ Signer -> JWTClaimsSet -> Text
signToken Signer
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) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime

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