{-# LANGUAGE OverloadedStrings #-}
module Network.Google.OAuth2.JWT
(
SignedJWT
, Email
, Scope
, getSignedJWT
, fromPEMString
, fromPEMFile
) where
import Codec.Crypto.RSA.Pure
import Control.Monad (unless)
import qualified Data.ByteString as B
import Data.ByteString.Base64.URL (encode)
import Data.ByteString.Lazy (fromStrict, toStrict)
import Data.ByteString.Char8 (unpack)
import Data.Maybe (fromMaybe, fromJust)
import Data.Monoid ((<>))
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.UnixTime (getUnixTime, utSeconds)
import Foreign.C.Types
import OpenSSL.EVP.PKey (toKeyPair)
import OpenSSL.PEM (PemPasswordSupply (PwNone),
readPrivateKey)
import OpenSSL.RSA
newtype SignedJWT =
SignedJWT B.ByteString
deriving (Eq)
instance Show SignedJWT where
show (SignedJWT t) = unpack t
type Email = T.Text
type Scope = T.Text
fromPEMFile :: FilePath -> IO PrivateKey
fromPEMFile f = readFile f >>= fromPEMString
fromPEMString :: String -> IO PrivateKey
fromPEMString s =
fromJust . toKeyPair <$> readPrivateKey s PwNone >>=
\k -> return
PrivateKey
{ private_pub =
PublicKey
{ public_size = rsaSize k
, public_n = rsaN k
, public_e = rsaE k
}
, private_d = rsaD k
, private_p = rsaP k
, private_q = rsaQ k
, private_dP = 0
, private_dQ = 0
, private_qinv = 0
}
getSignedJWT
:: Email
-> Maybe Email
-> [Scope]
-> Maybe Int
-> PrivateKey
-> IO (Either String SignedJWT)
getSignedJWT iss msub scs mxt pk = do
let xt = fromIntegral (fromMaybe 3600 mxt)
unless (xt >= 1 && xt <= 3600) (fail "Bad expiration time")
t <- getUnixTime
let i = header <> "." <> toB64 ("{\"iss\":\"" <> iss <> "\","
<> maybe T.empty (\e -> "\"sub\":\"" <> e <> "\",") msub
<> "\"scope\":\"" <> T.intercalate " " scs <> "\",\"aud\
\\":\"https://www.googleapis.com/oauth2/v4/token\",\"ex\
\p\":" <> toT (utSeconds t + CTime xt) <> ",\"iat\":"
<> toT (utSeconds t) <> "}")
return $
either
(fail "RSAError")
(\s -> return $ SignedJWT $ i <> "." <> encode (toStrict s))
(rsassa_pkcs1_v1_5_sign hashSHA256 pk $ fromStrict i)
where
toT = T.pack . show
toB64 = encode . encodeUtf8
header = toB64 "{\"alg\":\"RS256\",\"typ\":\"JWT\"}"