module Crypto.JOSE.JWK
(
JWK(..)
, JWKSet(..)
, module JWA.JWK
) where
import Control.Applicative
import Control.Arrow
import Data.Maybe (catMaybes)
import Data.Aeson
import Crypto.JOSE.Classes
import qualified Crypto.JOSE.JWA.JWE.Alg as JWA.JWE
import Crypto.JOSE.JWA.JWK as 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 :: JWA.JWK.KeyMaterial
, jwkUse :: Maybe KeyUse
, jwkKeyOps :: Maybe [KeyOp]
, jwkAlg :: Maybe Alg
, jwkKid :: Maybe String
, jwkX5u :: Maybe Types.URI
, jwkX5c :: Maybe [Types.Base64X509]
, jwkX5t :: Maybe Types.Base64SHA1
, jwkX5tS256 :: Maybe Types.Base64SHA256
}
deriving (Eq, Show)
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)
instance Key JWK where
type KeyGenParam JWK = JWA.JWK.KeyMaterialGenParam
type KeyContent JWK = JWA.JWK.KeyMaterial
gen p = first fromKeyContent . gen p
fromKeyContent k = JWK k z z z z z z z z where z = Nothing
sign h k = sign h $ jwkMaterial k
verify h k = verify h $ jwkMaterial k
newtype JWKSet = JWKSet [JWK] deriving (Eq, Show)
instance FromJSON JWKSet where
parseJSON = withObject "JWKSet" (\o -> JWKSet <$> o .: "keys")