module Crypto.JOSE.JWK
(
JWK(JWK)
, jwkMaterial
, jwkUse
, jwkKeyOps
, jwkAlg
, jwkKid
, jwkX5u
, jwkX5c
, jwkX5t
, jwkX5tS256
, fromKeyMaterial
, genJWK
, JWKSet(..)
, module Crypto.JOSE.JWA.JWK
) where
import Control.Applicative
import Data.Maybe (catMaybes)
import Control.Lens hiding ((.=))
import Data.Aeson
import Data.List.NonEmpty
import Test.QuickCheck
import qualified Crypto.JOSE.JWA.JWE.Alg as JWA.JWE
import Crypto.JOSE.JWA.JWK
import qualified Crypto.JOSE.JWA.JWS as JWA.JWS
import qualified Crypto.JOSE.TH
import qualified Crypto.JOSE.Types as Types
import qualified Crypto.JOSE.Types.Internal as Types
data Alg = JWSAlg JWA.JWS.Alg | JWEAlg JWA.JWE.Alg
deriving (Eq, Show)
instance FromJSON Alg where
parseJSON v = (JWSAlg <$> parseJSON v) <|> (JWEAlg <$> parseJSON v)
instance ToJSON Alg where
toJSON (JWSAlg alg) = toJSON alg
toJSON (JWEAlg alg) = toJSON alg
$(Crypto.JOSE.TH.deriveJOSEType "KeyOp"
[ "sign", "verify", "encrypt", "decrypt"
, "wrapKey", "unwrapKey", "deriveKey", "deriveBits"
])
$(Crypto.JOSE.TH.deriveJOSEType "KeyUse" ["sig", "enc"])
data JWK = JWK
{
_jwkMaterial :: Crypto.JOSE.JWA.JWK.KeyMaterial
, _jwkUse :: Maybe KeyUse
, _jwkKeyOps :: Maybe [KeyOp]
, _jwkAlg :: Maybe Alg
, _jwkKid :: Maybe String
, _jwkX5u :: Maybe Types.URI
, _jwkX5c :: Maybe (NonEmpty Types.Base64X509)
, _jwkX5t :: Maybe Types.Base64SHA1
, _jwkX5tS256 :: Maybe Types.Base64SHA256
}
deriving (Eq, Show)
makeLenses ''JWK
instance FromJSON JWK where
parseJSON = withObject "JWK" $ \o -> JWK
<$> parseJSON (Object o)
<*> o .:? "use"
<*> o .:? "key_ops"
<*> o .:? "alg"
<*> o .:? "kid"
<*> o .:? "x5u"
<*> o .:? "x5c"
<*> o .:? "x5t"
<*> o .:? "x5t#S256"
instance ToJSON JWK where
toJSON (JWK {..}) = object $ catMaybes
[ fmap ("alg" .=) _jwkAlg
, fmap ("use" .=) _jwkUse
, fmap ("key_ops" .=) _jwkKeyOps
, fmap ("kid" .=) _jwkKid
, fmap ("x5u" .=) _jwkX5u
, fmap ("x5c" .=) _jwkX5c
, fmap ("x5t" .=) _jwkX5t
, fmap ("x5t#S256" .=) _jwkX5tS256
]
++ Types.objectPairs (toJSON _jwkMaterial)
genJWK :: MonadRandom m => KeyMaterialGenParam -> m JWK
genJWK p = fromKeyMaterial <$> genKeyMaterial p
instance Arbitrary JWK where
arbitrary = JWK
<$> arbitrary
<*> pure Nothing
<*> pure Nothing
<*> pure Nothing
<*> arbitrary
<*> pure Nothing
<*> pure Nothing
<*> arbitrary
<*> arbitrary
fromKeyMaterial :: KeyMaterial -> JWK
fromKeyMaterial k = JWK k z z z z z z z z where z = Nothing
instance AsPublicKey JWK where
asPublicKey = prism' id (jwkMaterial (preview asPublicKey))
newtype JWKSet = JWKSet [JWK] deriving (Eq, Show)
instance FromJSON JWKSet where
parseJSON = withObject "JWKSet" (\o -> JWKSet <$> o .: "keys")