jose 0.2.38.1 → 0.3.38.0
raw patch · 11 files changed
+226/−80 lines, 11 filesdep +ghc-primdep +integer-gmpdep +safePVP ok
version bump matches the API change (PVP)
Dependencies added: ghc-prim, integer-gmp, safe
API changes (from Hackage documentation)
- Crypto.JOSE.Legacy: data JWK'
- Crypto.JOSE.Types: URI :: URI -> URI
- Crypto.JOSE.Types: instance Eq URI
- Crypto.JOSE.Types: instance FromJSON URI
- Crypto.JOSE.Types: instance Show URI
- Crypto.JOSE.Types: instance ToJSON URI
- Crypto.JOSE.Types: newtype URI
- Crypto.JWT: Arbitrary :: Text -> StringOrURI
- Crypto.JWT: OrURI :: URI -> StringOrURI
+ Crypto.JOSE.Classes: public :: Key k => k -> Maybe k
+ Crypto.JOSE.JWK: EC :: EC
+ Crypto.JOSE.JWK: ECGenParam :: Crv -> KeyMaterialGenParam
+ Crypto.JOSE.JWK: ECKeyMaterial :: ECKeyParameters -> KeyMaterial
+ Crypto.JOSE.JWK: ECKeyParameters :: EC -> Crv -> SizedBase64Integer -> SizedBase64Integer -> Maybe SizedBase64Integer -> ECKeyParameters
+ Crypto.JOSE.JWK: Oct :: Oct
+ Crypto.JOSE.JWK: OctGenParam :: Int -> KeyMaterialGenParam
+ Crypto.JOSE.JWK: OctKeyMaterial :: OctKeyParameters -> KeyMaterial
+ Crypto.JOSE.JWK: OctKeyParameters :: Oct -> Base64Octets -> OctKeyParameters
+ Crypto.JOSE.JWK: RSA :: RSA
+ Crypto.JOSE.JWK: RSAGenParam :: Int -> KeyMaterialGenParam
+ Crypto.JOSE.JWK: RSAKeyMaterial :: RSAKeyParameters -> KeyMaterial
+ Crypto.JOSE.JWK: RSAKeyParameters :: RSA -> SizedBase64Integer -> Base64Integer -> Maybe RSAPrivateKeyParameters -> RSAKeyParameters
+ Crypto.JOSE.JWK: RSAPrivateKeyOptionalParameters :: Base64Integer -> Base64Integer -> Base64Integer -> Base64Integer -> Base64Integer -> Maybe (NonEmpty RSAPrivateKeyOthElem) -> RSAPrivateKeyOptionalParameters
+ Crypto.JOSE.JWK: RSAPrivateKeyOthElem :: Base64Integer -> Base64Integer -> Base64Integer -> RSAPrivateKeyOthElem
+ Crypto.JOSE.JWK: RSAPrivateKeyParameters :: Base64Integer -> Maybe RSAPrivateKeyOptionalParameters -> RSAPrivateKeyParameters
+ Crypto.JOSE.JWK: dOth :: RSAPrivateKeyOthElem -> Base64Integer
+ Crypto.JOSE.JWK: data EC
+ Crypto.JOSE.JWK: data ECKeyParameters
+ Crypto.JOSE.JWK: data KeyMaterial
+ Crypto.JOSE.JWK: data KeyMaterialGenParam
+ Crypto.JOSE.JWK: data Oct
+ Crypto.JOSE.JWK: data OctKeyParameters
+ Crypto.JOSE.JWK: data RSA
+ Crypto.JOSE.JWK: data RSAKeyParameters
+ Crypto.JOSE.JWK: data RSAPrivateKeyOptionalParameters
+ Crypto.JOSE.JWK: data RSAPrivateKeyOthElem
+ Crypto.JOSE.JWK: data RSAPrivateKeyParameters
+ Crypto.JOSE.JWK: ecCrv :: ECKeyParameters -> Crv
+ Crypto.JOSE.JWK: ecD :: ECKeyParameters -> Maybe SizedBase64Integer
+ Crypto.JOSE.JWK: ecKty :: ECKeyParameters -> EC
+ Crypto.JOSE.JWK: ecX :: ECKeyParameters -> SizedBase64Integer
+ Crypto.JOSE.JWK: ecY :: ECKeyParameters -> SizedBase64Integer
+ Crypto.JOSE.JWK: octK :: OctKeyParameters -> Base64Octets
+ Crypto.JOSE.JWK: octKty :: OctKeyParameters -> Oct
+ Crypto.JOSE.JWK: rOth :: RSAPrivateKeyOthElem -> Base64Integer
+ Crypto.JOSE.JWK: rsaD :: RSAPrivateKeyParameters -> Base64Integer
+ Crypto.JOSE.JWK: rsaDp :: RSAPrivateKeyOptionalParameters -> Base64Integer
+ Crypto.JOSE.JWK: rsaDq :: RSAPrivateKeyOptionalParameters -> Base64Integer
+ Crypto.JOSE.JWK: rsaE :: Lens' RSAKeyParameters Base64Integer
+ Crypto.JOSE.JWK: rsaKty :: Lens' RSAKeyParameters RSA
+ Crypto.JOSE.JWK: rsaN :: Lens' RSAKeyParameters SizedBase64Integer
+ Crypto.JOSE.JWK: rsaOptionalParameters :: RSAPrivateKeyParameters -> Maybe RSAPrivateKeyOptionalParameters
+ Crypto.JOSE.JWK: rsaOth :: RSAPrivateKeyOptionalParameters -> Maybe (NonEmpty RSAPrivateKeyOthElem)
+ Crypto.JOSE.JWK: rsaP :: RSAPrivateKeyOptionalParameters -> Base64Integer
+ Crypto.JOSE.JWK: rsaPrivateKeyParameters :: Lens' RSAKeyParameters (Maybe RSAPrivateKeyParameters)
+ Crypto.JOSE.JWK: rsaQ :: RSAPrivateKeyOptionalParameters -> Base64Integer
+ Crypto.JOSE.JWK: rsaQi :: RSAPrivateKeyOptionalParameters -> Base64Integer
+ Crypto.JOSE.JWK: tOth :: RSAPrivateKeyOthElem -> Base64Integer
+ Crypto.JOSE.JWS: ES256 :: Alg
+ Crypto.JOSE.JWS: ES384 :: Alg
+ Crypto.JOSE.JWS: ES512 :: Alg
+ Crypto.JOSE.JWS: HS256 :: Alg
+ Crypto.JOSE.JWS: HS384 :: Alg
+ Crypto.JOSE.JWS: HS512 :: Alg
+ Crypto.JOSE.JWS: None :: Alg
+ Crypto.JOSE.JWS: PS256 :: Alg
+ Crypto.JOSE.JWS: PS384 :: Alg
+ Crypto.JOSE.JWS: PS512 :: Alg
+ Crypto.JOSE.JWS: RS256 :: Alg
+ Crypto.JOSE.JWS: RS384 :: Alg
+ Crypto.JOSE.JWS: RS512 :: Alg
+ Crypto.JOSE.JWS: data Alg
+ Crypto.JOSE.Legacy: JWK' :: RSKeyParameters -> JWK'
+ Crypto.JOSE.Legacy: _rsKeyParameters :: JWK' -> RSKeyParameters
+ Crypto.JOSE.Legacy: data RSKeyParameters
+ Crypto.JOSE.Legacy: instance FromJSON StringifiedInteger
+ Crypto.JOSE.Legacy: instance ToJSON StringifiedInteger
+ Crypto.JOSE.Legacy: newtype JWK'
+ Crypto.JOSE.Legacy: rsaKeyParameters :: Iso' RSKeyParameters RSAKeyParameters
+ Crypto.JOSE.Legacy: toJWK :: JWK' -> JWK
+ Crypto.JOSE.Types: data URI :: *
+ Crypto.JWT: _claimAud :: ClaimsSet -> Maybe Audience
+ Crypto.JWT: _claimExp :: ClaimsSet -> Maybe NumericDate
+ Crypto.JWT: _claimIat :: ClaimsSet -> Maybe NumericDate
+ Crypto.JWT: _claimIss :: ClaimsSet -> Maybe StringOrURI
+ Crypto.JWT: _claimJti :: ClaimsSet -> Maybe Text
+ Crypto.JWT: _claimNbf :: ClaimsSet -> Maybe NumericDate
+ Crypto.JWT: _claimSub :: ClaimsSet -> Maybe StringOrURI
+ Crypto.JWT: _unregisteredClaims :: ClaimsSet -> HashMap Text Value
+ Crypto.JWT: addClaim :: Text -> Value -> ClaimsSet -> ClaimsSet
+ Crypto.JWT: fromString :: Text -> StringOrURI
+ Crypto.JWT: fromURI :: URI -> StringOrURI
+ Crypto.JWT: getString :: StringOrURI -> Maybe Text
+ Crypto.JWT: getURI :: StringOrURI -> Maybe URI
- Crypto.JOSE.JWK: jwkAlg :: JWK -> Maybe Alg
+ Crypto.JOSE.JWK: jwkAlg :: Lens' JWK (Maybe Alg)
- Crypto.JOSE.JWK: jwkKeyOps :: JWK -> Maybe [KeyOp]
+ Crypto.JOSE.JWK: jwkKeyOps :: Lens' JWK (Maybe [KeyOp])
- Crypto.JOSE.JWK: jwkKid :: JWK -> Maybe String
+ Crypto.JOSE.JWK: jwkKid :: Lens' JWK (Maybe String)
- Crypto.JOSE.JWK: jwkMaterial :: JWK -> KeyMaterial
+ Crypto.JOSE.JWK: jwkMaterial :: Lens' JWK KeyMaterial
- Crypto.JOSE.JWK: jwkUse :: JWK -> Maybe KeyUse
+ Crypto.JOSE.JWK: jwkUse :: Lens' JWK (Maybe KeyUse)
- Crypto.JOSE.JWK: jwkX5c :: JWK -> Maybe [Base64X509]
+ Crypto.JOSE.JWK: jwkX5c :: Lens' JWK (Maybe [Base64X509])
- Crypto.JOSE.JWK: jwkX5t :: JWK -> Maybe Base64SHA1
+ Crypto.JOSE.JWK: jwkX5t :: Lens' JWK (Maybe Base64SHA1)
- Crypto.JOSE.JWK: jwkX5tS256 :: JWK -> Maybe Base64SHA256
+ Crypto.JOSE.JWK: jwkX5tS256 :: Lens' JWK (Maybe Base64SHA256)
- Crypto.JOSE.JWK: jwkX5u :: JWK -> Maybe URI
+ Crypto.JOSE.JWK: jwkX5u :: Lens' JWK (Maybe URI)
- Crypto.JWT: claimAud :: ClaimsSet -> Maybe Audience
+ Crypto.JWT: claimAud :: Lens' ClaimsSet (Maybe Audience)
- Crypto.JWT: claimExp :: ClaimsSet -> Maybe NumericDate
+ Crypto.JWT: claimExp :: Lens' ClaimsSet (Maybe NumericDate)
- Crypto.JWT: claimIat :: ClaimsSet -> Maybe NumericDate
+ Crypto.JWT: claimIat :: Lens' ClaimsSet (Maybe NumericDate)
- Crypto.JWT: claimIss :: ClaimsSet -> Maybe StringOrURI
+ Crypto.JWT: claimIss :: Lens' ClaimsSet (Maybe StringOrURI)
- Crypto.JWT: claimJti :: ClaimsSet -> Maybe Text
+ Crypto.JWT: claimJti :: Lens' ClaimsSet (Maybe Text)
- Crypto.JWT: claimNbf :: ClaimsSet -> Maybe NumericDate
+ Crypto.JWT: claimNbf :: Lens' ClaimsSet (Maybe NumericDate)
- Crypto.JWT: claimSub :: ClaimsSet -> Maybe StringOrURI
+ Crypto.JWT: claimSub :: Lens' ClaimsSet (Maybe StringOrURI)
- Crypto.JWT: unregisteredClaims :: ClaimsSet -> HashMap Text Value
+ Crypto.JWT: unregisteredClaims :: Lens' ClaimsSet (HashMap Text Value)
Files
- jose.cabal +10/−1
- src/Crypto/JOSE/Classes.hs +4/−0
- src/Crypto/JOSE/Error.hs +2/−5
- src/Crypto/JOSE/JWA/JWK.hs +23/−9
- src/Crypto/JOSE/JWK.hs +37/−25
- src/Crypto/JOSE/JWS.hs +4/−1
- src/Crypto/JOSE/Legacy.hs +62/−12
- src/Crypto/JOSE/Types.hs +12/−15
- src/Crypto/JOSE/Types/Armour.hs +4/−0
- src/Crypto/JOSE/Types/Orphans.hs +16/−3
- src/Crypto/JWT.hs +52/−9
jose.cabal view
@@ -1,5 +1,5 @@ name: jose-version: 0.2.38.1+version: 0.3.38.0 synopsis: Javascript Object Signing and Encryption and JSON Web Token library description:@@ -14,6 +14,11 @@ vulnerable to timing attacks and should therefore only be used for JWS verification. .+ The 'Crypto.JOSE.Legacy' module is provided for working with the+ Mozilla Persona (formerly BrowserID) key format. Only RSA keys+ are supported - DSA keys cannot be used and must be handled as+ opaque objects.+ . The version number tracks the IETF jose working group draft revisions. For now, expect breaking API changes on any version change except for the final (fourth) part being incremented.@@ -56,6 +61,8 @@ build-depends: base == 4.*+ , ghc-prim+ , integer-gmp , attoparsec , base64-bytestring == 1.0.* , bifunctors >= 4.0@@ -67,6 +74,7 @@ , data-default-class , lens >= 4.3 , template-haskell >= 2.4+ , safe >= 0.3 , semigroups >= 0.15 , aeson >= 0.7 && < 0.9 , unordered-containers == 0.2.*@@ -103,6 +111,7 @@ , lens , old-locale , template-haskell+ , safe , semigroups , aeson , unordered-containers
src/Crypto/JOSE/Classes.hs view
@@ -55,3 +55,7 @@ -> B.ByteString -> B.ByteString -> Either Error Bool++ -- | Remove secrets from a key+ --+ public :: k -> Maybe k
src/Crypto/JOSE/Error.hs view
@@ -24,10 +24,7 @@ import qualified Crypto.PubKey.RSA as RSA --- | All the errors that can occur, with the notable exception of--- 'Data.Aeson' decoding functions. Aeson decoding errors that--- occur in 'decodeCompact' are, however, lifted into this type--- via the 'JSONDecodeError' constructor.+-- | All the errors that can occur. -- data Error = AlgorithmNotImplemented -- ^ A requested algorithm is not implemented@@ -38,7 +35,7 @@ | RSAError RSA.Error -- ^ RSA encryption, decryption or signing error | CompactEncodeError String -- ^ Cannot produce compact representation of data | CompactDecodeError String -- ^ Cannot decode compact representation- | JSONDecodeError String -- ^ Cannot decode JSON data+ | JSONDecodeError String -- ^ JSON (Aeson) decoding error | JWSMissingHeader | JWSMissingAlg | JWSCritUnprotected
src/Crypto/JOSE/JWA/JWK.hs view
@@ -36,7 +36,11 @@ , RSAPrivateKeyOthElem(..) , RSAPrivateKeyOptionalParameters(..) , RSAPrivateKeyParameters(..)- , RSAKeyParameters(..)+ , RSAKeyParameters(RSAKeyParameters)+ , rsaE+ , rsaKty+ , rsaN+ , rsaPrivateKeyParameters -- * Parameters for Symmetric Keys , OctKeyParameters(..)@@ -49,6 +53,7 @@ import Data.Bifunctor import Data.Maybe +import Control.Lens hiding ((.=)) import Crypto.Hash import Crypto.PubKey.HashDescr import qualified Crypto.PubKey.ECC.ECDSA as ECDSA@@ -200,6 +205,7 @@ verify JWA.JWS.ES512 = verifyEC hashDescrSHA512 verify h = \_ _ _ -> Left $ AlgorithmMismatch $ show h ++ "cannot be used with EC key"+ public k = Just k { ecD = Nothing } signEC :: CPRG g@@ -244,12 +250,13 @@ -- | Parameters for RSA Keys -- data RSAKeyParameters = RSAKeyParameters- { rsaKty :: RSA- , rsaN :: Types.SizedBase64Integer- , rsaE :: Types.Base64Integer- , rsaPrivateKeyParameters :: Maybe RSAPrivateKeyParameters+ { _rsaKty :: RSA+ , _rsaN :: Types.SizedBase64Integer+ , _rsaE :: Types.Base64Integer+ , _rsaPrivateKeyParameters :: Maybe RSAPrivateKeyParameters } deriving (Eq, Show)+makeLenses ''RSAKeyParameters instance FromJSON RSAKeyParameters where parseJSON = withObject "RSA" $ \o ->@@ -263,10 +270,10 @@ instance ToJSON RSAKeyParameters where toJSON RSAKeyParameters {..} = object $- ("kty" .= rsaKty)- : ("n" .= rsaN)- : ("e" .= rsaE)- : maybe [] (Types.objectPairs . toJSON) rsaPrivateKeyParameters+ ("kty" .= _rsaKty)+ : ("n" .= _rsaN)+ : ("e" .= _rsaE)+ : maybe [] (Types.objectPairs . toJSON) _rsaPrivateKeyParameters instance Key RSAKeyParameters where type KeyGenParam RSAKeyParameters = Int@@ -289,6 +296,7 @@ (i p) (i q) (i dp) (i dq) (i qi) Nothing)))) , g') fromKeyContent (n, e, p) = RSAKeyParameters RSA n e p+ public = Just . set rsaPrivateKeyParameters Nothing sign JWA.JWS.RS256 = signPKCS15 hashDescrSHA256 sign JWA.JWS.RS384 = signPKCS15 hashDescrSHA384 sign JWA.JWS.RS512 = signPKCS15 hashDescrSHA512@@ -389,6 +397,7 @@ type KeyContent OctKeyParameters = Types.Base64Octets gen = undefined -- TODO implement fromKeyContent = OctKeyParameters Oct+ public = const Nothing sign JWA.JWS.HS256 k g = first Right . (,g) . signOct SHA256 k sign JWA.JWS.HS384 k g = first Right . (,g) . signOct SHA384 k sign JWA.JWS.HS512 k g = first Right . (,g) . signOct SHA512 k@@ -425,6 +434,8 @@ toJSON (RSAKeyMaterial p) = object $ Types.objectPairs (toJSON p) toJSON (OctKeyMaterial p) = object $ Types.objectPairs (toJSON p) +-- | Keygen parameters.+-- data KeyMaterialGenParam = ECGenParam Crv | RSAGenParam Int@@ -437,6 +448,9 @@ gen (RSAGenParam a) = first RSAKeyMaterial . gen a gen (OctGenParam a) = first OctKeyMaterial . gen a fromKeyContent = id+ public (ECKeyMaterial k) = ECKeyMaterial <$> public k+ public (RSAKeyMaterial k) = RSAKeyMaterial <$> public k+ public (OctKeyMaterial k) = OctKeyMaterial <$> public k sign JWA.JWS.None _ = \g _ -> (Right "", g) sign h (ECKeyMaterial k) = sign h k sign h (RSAKeyMaterial k) = sign h k
src/Crypto/JOSE/JWK.hs view
@@ -27,22 +27,32 @@ -} module Crypto.JOSE.JWK (- JWK(..)+ JWK(JWK)+ , jwkMaterial+ , jwkUse+ , jwkKeyOps+ , jwkAlg+ , jwkKid+ , jwkX5u+ , jwkX5c+ , jwkX5t+ , jwkX5tS256 , JWKSet(..) - , module JWA.JWK+ , module Crypto.JOSE.JWA.JWK ) where import Control.Applicative import Data.Bifunctor import Data.Maybe (catMaybes) +import Control.Lens hiding ((.=)) 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 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@@ -79,17 +89,18 @@ -- 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+ _jwkMaterial :: Crypto.JOSE.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)+makeLenses ''JWK instance FromJSON JWK where parseJSON = withObject "JWK" $ \o -> JWK@@ -105,24 +116,25 @@ 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+ [ 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)+ ++ Types.objectPairs (toJSON _jwkMaterial) instance Key JWK where- type KeyGenParam JWK = JWA.JWK.KeyMaterialGenParam- type KeyContent JWK = JWA.JWK.KeyMaterial+ type KeyGenParam JWK = Crypto.JOSE.JWA.JWK.KeyMaterialGenParam+ type KeyContent JWK = Crypto.JOSE.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+ public = jwkMaterial public+ sign h k = sign h $ k ^. jwkMaterial+ verify h k = verify h $ k ^. jwkMaterial -- | JWK §4. JSON Web Key Set (JWK Set) Format
src/Crypto/JOSE/JWS.hs view
@@ -21,8 +21,10 @@ -} module Crypto.JOSE.JWS (- JWSHeader(..)+ Alg(..) + , JWSHeader(..)+ , JWS(..) , jwsPayload , signJWS@@ -32,4 +34,5 @@ , verifyJWS ) where +import Crypto.JOSE.JWA.JWS import Crypto.JOSE.JWS.Internal
src/Crypto/JOSE/Legacy.hs view
@@ -1,4 +1,4 @@--- Copyright (C) 2013 Fraser Tweedale+-- Copyright (C) 2013, 2014 Fraser Tweedale -- -- Licensed under the Apache License, Version 2.0 (the "License"); -- you may not use this file except in compliance with the License.@@ -12,6 +12,7 @@ -- See the License for the specific language governing permissions and -- limitations under the License. +{-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}@@ -24,63 +25,112 @@ -} module Crypto.JOSE.Legacy (- JWK'+ JWK'(..)+ , toJWK+ , RSKeyParameters()+ , rsaKeyParameters ) where import Control.Applicative import Data.Bifunctor+import GHC.Types (Int(I#))+import GHC.Integer.Logarithms (integerLog2#) +import Control.Lens hiding ((.=)) import Data.Aeson import Data.Aeson.Types+import qualified Data.Text as T+import Safe (readMay) import Crypto.JOSE.Classes import Crypto.JOSE.JWA.JWK+import Crypto.JOSE.JWK import qualified Crypto.JOSE.Types.Internal as Types+import Crypto.JOSE.Types import Crypto.JOSE.TH +newtype StringifiedInteger = StringifiedInteger { _unString :: Integer }+makeLenses ''StringifiedInteger++instance FromJSON StringifiedInteger where+ parseJSON = withText "StringifiedInteger" $+ maybe (fail "not an stringy integer") (pure . StringifiedInteger)+ . readMay+ . T.unpack++instance ToJSON StringifiedInteger where+ toJSON (StringifiedInteger n) = toJSON $ show n++b64Iso :: Iso' StringifiedInteger Base64Integer+b64Iso = iso+ (Base64Integer . view unString)+ (\(Base64Integer n) -> StringifiedInteger n)++sizedB64Iso :: Iso' StringifiedInteger SizedBase64Integer+sizedB64Iso = iso+ ((\n -> SizedBase64Integer (size n) n) . view unString)+ (\(SizedBase64Integer _ n) -> StringifiedInteger n)+ where+ size n =+ let (bytes, bits) = (I# (integerLog2# n) + 1) `divMod` 8+ in bytes + signum bits++ $(Crypto.JOSE.TH.deriveJOSEType "RS" ["RS"]) -newtype RSKeyParameters = RSKeyParameters RSAKeyParameters+newtype RSKeyParameters = RSKeyParameters { _rsaKeyParameters :: RSAKeyParameters } deriving (Eq, Show)+makeLenses ''RSKeyParameters instance FromJSON RSKeyParameters where parseJSON = withObject "RS" $ \o -> fmap RSKeyParameters $ RSAKeyParameters <$> ((o .: "algorithm" :: Parser RS) *> pure RSA)- <*> o .: "modulus"- <*> o .: "exponent"- <*> (fmap (`RSAPrivateKeyParameters` Nothing) <$> (o .:? "secretExponent"))+ <*> (view sizedB64Iso <$> o .: "n")+ <*> (view b64Iso <$> o .: "e")+ <*> (fmap ((`RSAPrivateKeyParameters` Nothing) . view b64Iso) <$> (o .:? "d")) instance ToJSON RSKeyParameters where- toJSON (RSKeyParameters (RSAKeyParameters _ n e priv))- = object $ ["algorithm" .= RS, "modulus" .= n ,"exponent" .= e]- ++ maybe [] (\p -> ["secretExponent" .= rsaD p]) priv+ toJSON (RSKeyParameters k)+ = object $+ [ "algorithm" .= RS+ , "n" .= (k ^. rsaN . from sizedB64Iso)+ , "e" .= (k ^. rsaE . from b64Iso)+ ]+ ++ maybe [] (\p -> ["d" .= (rsaD p ^. from b64Iso)])+ (k ^. rsaPrivateKeyParameters) instance Key RSKeyParameters where type KeyGenParam RSKeyParameters = Int type KeyContent RSKeyParameters = RSAKeyParameters gen p = first fromKeyContent . gen p fromKeyContent = RSKeyParameters+ public = rsaKeyParameters public sign h (RSKeyParameters k) = sign h k verify h (RSKeyParameters k) = verify h k -- | Legacy JSON Web Key data type. ---newtype JWK' = JWK' RSKeyParameters deriving (Eq, Show)+newtype JWK' = JWK' { _rsKeyParameters :: RSKeyParameters }+ deriving (Eq, Show)+makeLenses ''JWK' instance FromJSON JWK' where parseJSON = withObject "JWK'" $ \o -> JWK' <$> parseJSON (Object o) instance ToJSON JWK' where- toJSON (JWK' k) = object $- "version" .= ("2012.08.15" :: String) : Types.objectPairs (toJSON k)+ toJSON (JWK' k) = object $ Types.objectPairs (toJSON k) instance Key JWK' where type KeyGenParam JWK' = Int type KeyContent JWK' = RSKeyParameters gen p g = first JWK' $ gen p g fromKeyContent = JWK'+ public = rsKeyParameters public sign h (JWK' k) = sign h k verify h (JWK' k) = verify h k++toJWK :: JWK' -> JWK+toJWK (JWK' (RSKeyParameters k)) = fromKeyContent $ RSAKeyMaterial k
src/Crypto/JOSE/Types.hs view
@@ -19,7 +19,17 @@ Data types for the JOSE library. -}-module Crypto.JOSE.Types where+module Crypto.JOSE.Types+ (+ Base64Integer(..)+ , SizedBase64Integer(..)+ , Base64UrlString(..)+ , Base64Octets(..)+ , Base64SHA1(..)+ , Base64SHA256(..)+ , Base64X509(..)+ , URI+ ) where import Control.Applicative @@ -29,8 +39,7 @@ import qualified Data.ByteString.Base64.URL as B64U import qualified Data.ByteString.Lazy as L import Data.Certificate.X509-import qualified Data.Text as T-import qualified Network.URI+import Network.URI (URI) import Crypto.JOSE.Types.Internal import Crypto.JOSE.Types.Orphans ()@@ -134,15 +143,3 @@ instance ToJSON Base64X509 where toJSON (Base64X509 x509) = encodeB64 $ L.toStrict $ encodeCertificate x509----- | A URI. Used for X.509 certificate and JWK Set URLs.----newtype URI = URI Network.URI.URI deriving (Eq, Show)--instance FromJSON URI where- parseJSON = withText "URI" $- maybe (fail "not a URI") (pure . URI) . Network.URI.parseURI . T.unpack--instance ToJSON URI where- toJSON (URI uri) = String $ T.pack $ show uri
src/Crypto/JOSE/Types/Armour.hs view
@@ -67,10 +67,14 @@ armour = to (\case Armoured a _ -> a ; Unarmoured b -> toArmour b) +-- | Decoding from armoured representation.+-- class FromArmour a e b | a b -> e where parseArmour :: a -> Either e b +-- | Serialising to armoured representation.+-- class ToArmour a b where toArmour :: b -> a
src/Crypto/JOSE/Types/Orphans.hs view
@@ -16,17 +16,30 @@ module Crypto.JOSE.Types.Orphans where -import qualified Data.Traversable as T+import Prelude hiding (mapM)++import Data.Traversable+ import Data.List.NonEmpty (NonEmpty(..), toList)+import qualified Data.Text as T+import qualified Data.Vector as V+import Network.URI (URI, parseURI) import Data.Aeson -import qualified Data.Vector as V instance FromJSON a => FromJSON (NonEmpty a) where parseJSON = withArray "NonEmpty [a]" $ \v -> case V.toList v of [] -> fail "Non-empty list required"- (x:xs) -> T.mapM parseJSON (x :| xs)+ (x:xs) -> mapM parseJSON (x :| xs) instance ToJSON a => ToJSON (NonEmpty a) where toJSON = Array . V.fromList . map toJSON . toList+++instance FromJSON URI where+ parseJSON = withText "URI" $+ maybe (fail "not a URI") return . parseURI . T.unpack++instance ToJSON URI where+ toJSON = String . T.pack . show
src/Crypto/JWT.hs view
@@ -13,6 +13,7 @@ -- limitations under the License. {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} {-| @@ -22,6 +23,16 @@ module Crypto.JWT ( JWT(..)+ , claimAud+ , claimExp+ , claimIat+ , claimIss+ , claimJti+ , claimNbf+ , claimSub+ , unregisteredClaims+ , addClaim+ , createJWSJWT , validateJWSJWT @@ -30,7 +41,12 @@ , Audience(..) - , StringOrURI(..)+ , StringOrURI+ , fromString+ , fromURI+ , getString+ , getURI+ , NumericDate(..) ) where @@ -39,12 +55,14 @@ import Data.Bifunctor import Data.Maybe +import Control.Lens hiding ((.=)) import Data.Aeson import qualified Data.ByteString.Lazy as BSL import qualified Data.HashMap.Strict as M import qualified Data.Text as T import Data.Time import Data.Time.Clock.POSIX+import Network.URI (parseURI) import Crypto.JOSE import Crypto.JOSE.Types@@ -58,6 +76,27 @@ -- data StringOrURI = Arbitrary T.Text | OrURI URI deriving (Eq, Show) +-- | Construct a 'StringOrURI' from text+--+fromString :: T.Text -> StringOrURI+fromString s = maybe (Arbitrary s) OrURI $ parseURI $ T.unpack s++-- | Construct a 'StringOrURI' from a URI+--+fromURI :: URI -> StringOrURI+fromURI = OrURI++-- | Get the +getString :: StringOrURI -> Maybe T.Text+getString (Arbitrary a) = Just a+getString (OrURI _) = Nothing++-- | Get the uri from a 'StringOrURI'+--+getURI :: StringOrURI -> Maybe URI+getURI (Arbitrary _) = Nothing+getURI (OrURI a) = Just a+ instance FromJSON StringOrURI where parseJSON = withText "StringOrURI" (\s -> if T.any (== ':') s@@ -103,58 +142,62 @@ -- the claims conveyed by the JWT. -- data ClaimsSet = ClaimsSet- { claimIss :: Maybe StringOrURI+ { _claimIss :: Maybe StringOrURI -- ^ The issuer claim identifies the principal that issued the -- JWT. The processing of this claim is generally application -- specific.- , claimSub :: Maybe StringOrURI+ , _claimSub :: Maybe StringOrURI -- ^ The subject claim identifies the principal that is the -- subject of the JWT. The Claims in a JWT are normally -- statements about the subject. The subject value MAY be scoped -- to be locally unique in the context of the issuer or MAY be -- globally unique. The processing of this claim is generally -- application specific.- , claimAud :: Maybe Audience+ , _claimAud :: Maybe Audience -- ^ The audience claim identifies the recipients that the JWT is -- intended for. Each principal intended to process the JWT MUST -- identify itself with a value in the audience claim. If the -- principal processing the claim does not identify itself with a -- value in the /aud/ claim when this claim is present, then the -- JWT MUST be rejected.- , claimExp :: Maybe NumericDate+ , _claimExp :: Maybe NumericDate -- ^ The expiration time claim identifies the expiration time on -- or after which the JWT MUST NOT be accepted for processing. -- The processing of /exp/ claim requires that the current -- date\/time MUST be before expiration date\/time listed in the -- /exp/ claim. Implementers MAY provide for some small leeway, -- usually no more than a few minutes, to account for clock skew.- , claimNbf :: Maybe NumericDate+ , _claimNbf :: Maybe NumericDate -- ^ The not before claim identifies the time before which the JWT -- MUST NOT be accepted for processing. The processing of the -- /nbf/ claim requires that the current date\/time MUST be after -- or equal to the not-before date\/time listed in the /nbf/ -- claim. Implementers MAY provide for some small leeway, usually -- no more than a few minutes, to account for clock skew.- , claimIat :: Maybe NumericDate+ , _claimIat :: Maybe NumericDate -- ^ The issued at claim identifies the time at which the JWT was -- issued. This claim can be used to determine the age of the -- JWT.- , claimJti :: Maybe T.Text+ , _claimJti :: Maybe T.Text -- ^ The JWT ID claim provides a unique identifier for the JWT. -- The identifier value MUST be assigned in a manner that ensures -- that there is a negligible probability that the same value will -- be accidentally assigned to a different data object. The /jti/ -- claim can be used to prevent the JWT from being replayed. The -- /jti/ value is a case-sensitive string.- , unregisteredClaims :: M.HashMap T.Text Value+ , _unregisteredClaims :: M.HashMap T.Text Value -- ^ Claim Names can be defined at will by those using JWTs. } deriving (Eq, Show)+makeLenses ''ClaimsSet -- | Return an empty claims set. -- emptyClaimsSet :: ClaimsSet emptyClaimsSet = ClaimsSet n n n n n n n M.empty where n = Nothing++addClaim :: T.Text -> Value -> ClaimsSet -> ClaimsSet+addClaim k v = over unregisteredClaims (M.insert k v) filterUnregistered :: M.HashMap T.Text Value -> M.HashMap T.Text Value filterUnregistered = M.filterWithKey (\k _ -> k `notElem` registered) where