packages feed

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 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