module OpenID.Connect.Provider.Key
(
newJWK
, newSigningJWK
, newEncryptionJWK
) where
import Control.Lens ((^.), (?~), re)
import Crypto.Hash (Digest, SHA256)
import Crypto.JOSE (JWK, KeyUse(..))
import qualified Crypto.JOSE as JOSE
import qualified Crypto.JOSE.JWA.JWE.Alg as JOSE
import Crypto.Random (MonadRandom)
import Data.Function ((&))
import Data.Text (Text)
import Data.Text.Strict.Lens (utf8)
newJWK :: MonadRandom m => KeyUse -> m (JWK, Text)
newJWK :: forall (m :: * -> *). MonadRandom m => KeyUse -> m (JWK, Text)
newJWK KeyUse
keyuse = do
JWK
jwk <- forall (m :: * -> *). MonadRandom m => KeyMaterialGenParam -> m JWK
JOSE.genJWK (Int -> KeyMaterialGenParam
JOSE.RSAGenParam (Int
4096 forall a. Integral a => a -> a -> a
`div` Int
8))
let h :: Digest SHA256
h = JWK
jwk forall s a. s -> Getting a s a -> a
^. forall a. HashAlgorithm a => Getter JWK (Digest a)
JOSE.thumbprint :: Digest SHA256
kid :: Text
kid = Digest SHA256
h forall s a. s -> Getting a s a -> a
^. (forall t b. AReview t b -> Getter b t
re (forall s1 s2.
(AsEmpty s1, AsEmpty s2, Cons s1 s1 Word8 Word8,
Cons s2 s2 Word8 Word8) =>
Prism' s1 s2
JOSE.base64url forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => Prism' ByteString (Digest a)
JOSE.digest) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' ByteString Text
utf8)
final :: JWK
final = JWK
jwk
forall a b. a -> (a -> b) -> b
& Lens' JWK (Maybe Text)
JOSE.jwkKid forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
kid
forall a b. a -> (a -> b) -> b
& Lens' JWK (Maybe KeyUse)
JOSE.jwkUse forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ KeyUse
keyuse
forall a b. a -> (a -> b) -> b
& Lens' JWK (Maybe JWKAlg)
JOSE.jwkAlg forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ KeyUse -> JWKAlg
alg KeyUse
keyuse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JWK
final, Text
kid)
where
alg :: KeyUse -> JOSE.JWKAlg
alg :: KeyUse -> JWKAlg
alg = \case
KeyUse
Sig -> Alg -> JWKAlg
JOSE.JWSAlg Alg
JOSE.RS256
KeyUse
Enc -> Alg -> JWKAlg
JOSE.JWEAlg Alg
JOSE.A256KW
newSigningJWK :: MonadRandom m => m JWK
newSigningJWK :: forall (m :: * -> *). MonadRandom m => m JWK
newSigningJWK = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadRandom m => KeyUse -> m (JWK, Text)
newJWK KeyUse
Sig
newEncryptionJWK :: MonadRandom m => m JWK
newEncryptionJWK :: forall (m :: * -> *). MonadRandom m => m JWK
newEncryptionJWK = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadRandom m => KeyUse -> m (JWK, Text)
newJWK KeyUse
Enc