{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module GitHub.REST.Auth (
Token (..),
fromToken,
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
data Token
=
AccessToken ByteString
|
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
type AppId = Int
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
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
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