jose (empty) → 0.1.26.0
raw patch · 18 files changed
+1745/−0 lines, 18 filesdep +aesondep +attoparsecdep +basesetup-changed
Dependencies added: aeson, attoparsec, base, base64-bytestring, byteable, bytestring, certificate, crypto-pubkey, crypto-random, cryptohash, hspec, jose, network, template-haskell, text, unordered-containers, vector
Files
- LICENSE +202/−0
- README.md +6/−0
- Setup.hs +2/−0
- jose.cabal +85/−0
- src/Crypto/JOSE/Classes.hs +31/−0
- src/Crypto/JOSE/Compact.hs +48/−0
- src/Crypto/JOSE/JWA/JWE.hs +65/−0
- src/Crypto/JOSE/JWA/JWE/Alg.hs +52/−0
- src/Crypto/JOSE/JWA/JWK.hs +310/−0
- src/Crypto/JOSE/JWA/JWS.hs +44/−0
- src/Crypto/JOSE/JWK.hs +135/−0
- src/Crypto/JOSE/JWS.hs +32/−0
- src/Crypto/JOSE/JWS/Internal.hs +294/−0
- src/Crypto/JOSE/Legacy.hs +106/−0
- src/Crypto/JOSE/TH.hs +101/−0
- src/Crypto/JOSE/Types.hs +126/−0
- src/Crypto/JOSE/Types/Internal.hs +81/−0
- test/Test.hs +25/−0
+ LICENSE view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
@@ -0,0 +1,6 @@+# jose - Javascript Object Signing and Encryption++jose is a Haskell implementation of [Javascript Object Signing and+Encryption](https://datatracker.ietf.org/wg/jose/).++The library is in its infancy. Contributions are welcome.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ jose.cabal view
@@ -0,0 +1,85 @@+name: jose+version: 0.1.26.0+synopsis: Javascript Object Signing and Encryption+description:+ .+ An implementation of the Javascript Object Signing and Encryption+ (jose) formats.+ .+ Currently, only JSON Web Key (JWK) and JSON Web Signature (JWS)+ are implemented, and only the RSA algorithms.+ .+ 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 part being incremented.++homepage: https://github.com/frasertweedale/hs-jose+bug-reports: https://github.com/frasertweedale/hs-jose/issues+license: Apache-2.0+license-file: LICENSE+extra-source-files:+ README.md+author: Fraser Tweedale+maintainer: frase@frase.id.au+copyright: Copyright (C) 2013 Fraser Tweedale+category: Cryptography+build-type: Simple+cabal-version: >= 1.8++library+ exposed-modules:+ Crypto.JOSE.Classes+ Crypto.JOSE.Compact+ Crypto.JOSE.Types+ Crypto.JOSE.JWA.JWK+ Crypto.JOSE.JWA.JWS+ Crypto.JOSE.JWK+ Crypto.JOSE.JWS+ Crypto.JOSE.Legacy++ other-modules:+ Crypto.JOSE.JWA.JWE+ Crypto.JOSE.JWA.JWE.Alg+ Crypto.JOSE.JWS.Internal+ Crypto.JOSE.TH+ Crypto.JOSE.Types.Internal++ build-depends:+ base == 4.*,+ attoparsec,+ base64-bytestring == 1.0.*,+ byteable == 0.1.*,+ crypto-pubkey == 0.2.*,+ crypto-random == 0.0.7.*,+ cryptohash == 0.11.*,+ template-haskell >= 2.4,+ aeson == 0.7.*,+ unordered-containers == 0.2.*,+ bytestring == 0.10.*,+ text == 1.1.*,+ network >= 2.4,+ certificate == 1.3.*,+ vector++ ghc-options: -Wall+ hs-source-dirs: src++source-repository head+ type: git+ location: https://github.com/frasertweedale/hs-jose.git++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Test.hs++ build-depends:+ base,+ base64-bytestring,+ bytestring,+ network,+ unordered-containers,+ attoparsec,+ hspec,+ aeson,+ jose
+ src/Crypto/JOSE/Classes.hs view
@@ -0,0 +1,31 @@+-- Copyright (C) 2013 Fraser Tweedale+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++{-|++Type classes for use with the JOSE modules.++-}+module Crypto.JOSE.Classes where++import qualified Data.ByteString as B++import qualified Crypto.JOSE.JWA.JWS as JWA.JWS++-- | A Key that can sign messages and validate signatures according+-- to a given 'Alg'.+--+class Key k where+ sign :: JWA.JWS.Alg -> k -> B.ByteString -> B.ByteString+ verify :: JWA.JWS.Alg -> k -> B.ByteString -> B.ByteString -> Bool
+ src/Crypto/JOSE/Compact.hs view
@@ -0,0 +1,48 @@+-- Copyright (C) 2013 Fraser Tweedale+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++{-# LANGUAGE OverloadedStrings #-}++{-|++JWS, JWE and some related specifications provide for "compact"+representations of certain types. This module defines classes and+functions for working with such data.++-}+module Crypto.JOSE.Compact where++import qualified Data.ByteString.Lazy as L+++-- | Data that can be parsed from a compact representation.+--+class FromCompact a where+ fromCompact :: [L.ByteString] -> Either String a++-- | Decode a compact representation.+--+decodeCompact :: FromCompact a => L.ByteString -> Either String a+decodeCompact = fromCompact . L.split 46+++-- | Data that can be converted to a compact representation.+--+class ToCompact a where+ toCompact :: a -> Either String [L.ByteString]++-- | Encode data to a compact representation.+--+encodeCompact :: ToCompact a => a -> Either String L.ByteString+encodeCompact = fmap (L.intercalate ".") . toCompact
+ src/Crypto/JOSE/JWA/JWE.hs view
@@ -0,0 +1,65 @@+-- Copyright (C) 2013 Fraser Tweedale+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++{-|++JSON Web Encryption data types specified under JSON Web Algorithms.++-}+module Crypto.JOSE.JWA.JWE where++import Crypto.JOSE.JWK+import Crypto.JOSE.TH+import Crypto.JOSE.Types+++--+-- JWA §4. Cryptographic Algorithms for Encryption+--++-- | JWA 4.1. "alg" (Algorithms) Header Parameter Values for JWE+--+data JWEAlgHeaderParameters =+ -- JWA §4.7.1. Header Parameters Used for ECDH Key Agreement+ ECDHParameters {+ epk :: JWK, -- Ephemeral Public Key ; a JWK PUBLIC key+ apu :: Maybe Base64UrlString, -- Agreement PartyUInfo+ apv :: Maybe Base64UrlString -- Agreement PartyVInfo+ }+ -- JWA §4.8.1. Header Parameters Used for AES GCM Key Encryption+ | AESGCMParameters {+ iv :: Base64Octets, -- Initialization Vector+ tag :: Base64Octets -- Authentication Tag+ }+ -- JWA §4.9.1. Header Parameters Used for PBES2 Key Encryption+ | PBES2Parameters {+ p2s :: Base64Octets, -- PBKDF2 salt value+ p2c :: Int -- PBKDF2 iteration count ; POSITIVE integer+ }+ deriving (Show)+++-- | JWA §4.2. "enc" (Encryption Method) Header Parameters Values for JWE+--+$(deriveJOSEType "Enc" [+ "A128CBC-HS256" -- AES HMAC SHA authenticated encryption Required+ , "A192CBC-HS384" -- AES HMAC SHA authenticated encryption Optional+ , "A256CBC-HS512" -- AES HMAC SHA authenticated encryption Required+ , "A128GCM" -- AES in Galois/Counter Mode Recommended+ , "A192GCM" -- AES in Galois/Counter Mode Optional+ , "A256GCM" -- AES in Galois/Counter Mode Recommended+ ])
+ src/Crypto/JOSE/JWA/JWE/Alg.hs view
@@ -0,0 +1,52 @@+-- 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.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++{-|++JSON Web Encryption algorithms.++-}+module Crypto.JOSE.JWA.JWE.Alg where++import qualified Crypto.JOSE.TH+++-- | JWA §4.1. "alg" (Algorithm) Header Parameter Values for JWE+--+-- This section is shuffled off into its own module to avoid+-- circular import via Crypto.JOSE.JWK, which needs Alg.+--+$(Crypto.JOSE.TH.deriveJOSEType "Alg" [+ "RSA1_5" -- RSAES-PKCS1-V1_5 Required+ , "RSA-OAEP" -- RSAES OAEP using default parameters Optional+ , "RSA-OAEP-256" -- RSAES OAEP using SHA-256 and MGF1+ -- with SHA-256 Optional+ , "A128KW" -- AES Key Wrap Recommended+ , "A192KW" -- AES Key Wrap Optional+ , "A256KW" -- AES Key Wrap Recommended+ , "dir" -- direct use of symmetric key Recommended+ , "ECDH-ES" -- ECDH Ephemeral Static Recommended++ , "ECDH-ES+A128KW" -- Recommended+ , "ECDH-ES+A192KW" -- Optional+ , "ECDH-ES+A256KW" -- Recommended+ , "A128GCMKW" -- AES in Galois/Counter Mode Optional+ , "A192GCMKW" -- AES in Galois/Counter Mode Optional+ , "A256GCMKW" -- AES in Galois/Counter Mode Optional+ , "PBES2-HS256+A128KW" -- PBES2 with HMAC SHA and AES Key Wrap Optional+ , "PBES2-HS384+A128KW" -- PBES2 with HMAC SHA and AES Key Wrap Optional+ , "PBES2-HS512+A128KW" -- PBES2 with HMAC SHA and AES Key Wrap Optional+ ])
+ src/Crypto/JOSE/JWA/JWK.hs view
@@ -0,0 +1,310 @@+-- Copyright (C) 2013 Fraser Tweedale+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++{-|++Cryptographic Algorithms for Keys.++-}+module Crypto.JOSE.JWA.JWK (+ -- * \"kty\" (Key Type) Parameter Values+ EC(..)+ , RSA(..)+ , Oct(..)++ -- * Parameters for Elliptic Curve Keys+ , ECKeyParameters(..)++ -- * Parameters for RSA Keys+ , RSAPrivateKeyOthElem(..)+ , RSAPrivateKeyOptionalParameters(..)+ , RSAKeyParameters(..)+ , genRSAParams+ , genRSA++ -- * Parameters for Symmetric Keys+ , OctKeyParameters(..)++ , KeyMaterial(..)+ ) where++import Control.Applicative+import Control.Arrow++import Crypto.Hash+import Crypto.PubKey.HashDescr+import Crypto.PubKey.RSA+import qualified Crypto.PubKey.RSA.PKCS15+import Crypto.Random+import Data.Aeson+import Data.Byteable+import qualified Data.ByteString as B+import qualified Data.HashMap.Strict as M++import Crypto.JOSE.Classes+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+++-- | Elliptic Curve key type (Recommeded+)+$(Crypto.JOSE.TH.deriveJOSEType "EC" ["EC"])+-- | RSA key type (Required)+$(Crypto.JOSE.TH.deriveJOSEType "RSA" ["RSA"])+-- | Octet sequence (symmetric key) key type (Required)+$(Crypto.JOSE.TH.deriveJOSEType "Oct" ["oct"])+++-- | \"crv\" (Curve) Parameter+--+$(Crypto.JOSE.TH.deriveJOSEType "Crv" ["P-256", "P-384", "P-521"])+++-- | \"oth\" (Other Primes Info) Parameter+--+data RSAPrivateKeyOthElem = RSAPrivateKeyOthElem {+ rOth :: Types.Base64Integer,+ dOth :: Types.Base64Integer,+ tOth :: Types.Base64Integer+ }+ deriving (Eq, Show)++instance FromJSON RSAPrivateKeyOthElem where+ parseJSON = withObject "oth" (\o -> RSAPrivateKeyOthElem <$>+ o .: "r" <*>+ o .: "d" <*>+ o .: "t")++instance ToJSON RSAPrivateKeyOthElem where+ toJSON (RSAPrivateKeyOthElem r d t) = object ["r" .= r, "d" .= d, "t" .= t]+++-- | Optional parameters for RSA private keys+--+data RSAPrivateKeyOptionalParameters = RSAPrivateKeyOptionalParameters {+ rsaP :: Types.Base64Integer+ , rsaQ :: Types.Base64Integer+ , rsaDp :: Types.Base64Integer+ , rsaDq :: Types.Base64Integer+ , rsaQi :: Types.Base64Integer+ , rsaOth :: Maybe [RSAPrivateKeyOthElem] -- TODO oth must not be empty array+ }+ deriving (Eq, Show)++instance FromJSON RSAPrivateKeyOptionalParameters where+ parseJSON = withObject "RSA" (\o -> RSAPrivateKeyOptionalParameters <$>+ o .: "p" <*>+ o .: "q" <*>+ o .: "dp" <*>+ o .: "dq" <*>+ o .: "qi" <*>+ o .:? "oth")++instance ToJSON RSAPrivateKeyOptionalParameters where+ toJSON (RSAPrivateKeyOptionalParameters {..}) = object $ [+ "p" .= rsaP+ , "q" .= rsaQ+ , "dp" .= rsaDp+ , "dq" .= rsaDq+ , "dq" .= rsaQi+ ] ++ maybe [] ((:[]) . ("oth" .=)) rsaOth+++-- | Parameters for Elliptic Curve Keys+--+data ECKeyParameters =+ ECPrivateKeyParameters {+ ecD :: Types.SizedBase64Integer+ }+ | ECPublicKeyParameters {+ ecCrv :: Crv,+ ecX :: Types.SizedBase64Integer,+ ecY :: Types.SizedBase64Integer+ }+ deriving (Eq, Show)++instance FromJSON ECKeyParameters where+ parseJSON = withObject "EC" (\o ->+ ECPrivateKeyParameters <$> o .: "d"+ <|> ECPublicKeyParameters <$> o .: "crv" <*> o .: "x" <*> o .: "y")++instance ToJSON ECKeyParameters where+ toJSON (ECPrivateKeyParameters d) = object ["d" .= d]+ toJSON (ECPublicKeyParameters {..}) = object [+ "crv" .= ecCrv+ , "x" .= ecX+ , "y" .= ecY+ ]++instance Key ECKeyParameters where+ sign = error "elliptic curve algorithms not implemented"+ verify = error "elliptic curve algorithms not implemented"+++-- | Parameters for RSA Keys+--+data RSAKeyParameters =+ RSAPrivateKeyParameters {+ rsaN :: Types.SizedBase64Integer+ , rsaE :: Types.Base64Integer+ , rsaD :: Types.Base64Integer+ , rsaOptionalParameters :: Maybe RSAPrivateKeyOptionalParameters+ }+ | RSAPublicKeyParameters {+ rsaN' :: Types.SizedBase64Integer+ , rsaE' :: Types.Base64Integer+ }+ deriving (Eq, Show)++instance FromJSON RSAKeyParameters where+ parseJSON = withObject "RSA" (\o ->+ RSAPrivateKeyParameters+ <$> o .: "n"+ <*> o .: "e"+ <*> o .: "d"+ <*> (if any (`M.member` o) ["p", "q", "dp", "dq", "qi", "oth"]+ then Just <$> parseJSON (Object o)+ else pure Nothing)+ <|> RSAPublicKeyParameters <$> o .: "n" <*> o .: "e")++instance ToJSON RSAKeyParameters where+ toJSON (RSAPrivateKeyParameters {..}) = object $+ ("n" .= rsaN)+ : ("e" .= rsaE)+ : ("d" .= rsaD)+ : maybe [] (Types.objectPairs . toJSON) rsaOptionalParameters+ toJSON (RSAPublicKeyParameters n e) = object ["n" .= n, "e" .= e]++instance Key RSAKeyParameters where+ sign JWA.JWS.RS256 = signRSA hashDescrSHA256+ sign JWA.JWS.RS384 = signRSA hashDescrSHA384+ sign JWA.JWS.RS512 = signRSA hashDescrSHA512+ sign h = error $ "alg/key mismatch: " ++ show h ++ "/RSA"+ verify JWA.JWS.RS256 = verifyRSA hashDescrSHA256+ verify JWA.JWS.RS384 = verifyRSA hashDescrSHA384+ verify JWA.JWS.RS512 = verifyRSA hashDescrSHA512+ verify h = error $ "alg/key mismatch: " ++ show h ++ "/RSA"++signRSA :: HashDescr -> RSAKeyParameters -> B.ByteString -> B.ByteString+signRSA h k m = either (error . show) id $+ Crypto.PubKey.RSA.PKCS15.sign Nothing h (privateKey k) m where+ privateKey (RSAPrivateKeyParameters+ (Types.SizedBase64Integer size n)+ (Types.Base64Integer e)+ (Types.Base64Integer d)+ _) = PrivateKey (PublicKey size n e) d 0 0 0 0 0+ privateKey _ = error "not an RSA private key"++verifyRSA+ :: HashDescr+ -> RSAKeyParameters+ -> B.ByteString+ -> B.ByteString+ -> Bool+verifyRSA h k = Crypto.PubKey.RSA.PKCS15.verify h (publicKey k) where+ publicKey (RSAPrivateKeyParameters+ (Types.SizedBase64Integer size n)+ (Types.Base64Integer e)+ _+ _+ ) = PublicKey size n e+ publicKey (RSAPublicKeyParameters+ (Types.SizedBase64Integer size n)+ (Types.Base64Integer e)+ ) = PublicKey size n e++-- | Generate RSA public and private key parameters.+--+genRSAParams :: Int -> IO (RSAKeyParameters, RSAKeyParameters)+genRSAParams size =+ let+ i = Types.Base64Integer+ si = Types.SizedBase64Integer+ in do+ ent <- createEntropyPool+ ((PublicKey s n e, PrivateKey _ d p q dp dq qi), _) <-+ return $ generate (cprgCreate ent :: SystemRNG) size 65537+ return+ ( RSAPublicKeyParameters (si s n) (i e)+ , RSAPrivateKeyParameters (si s n) (i e) (i d)+ (Just (RSAPrivateKeyOptionalParameters+ (i p) (i q) (i dp) (i dq) (i qi) Nothing))+ )++-- | Generate RSA public and private key material.+--+genRSA :: Int -> IO (KeyMaterial, KeyMaterial)+genRSA = fmap (RSAKeyMaterial RSA *** RSAKeyMaterial RSA) . genRSAParams+++-- | Symmetric key parameters data.+--+newtype OctKeyParameters = OctKeyParameters Types.Base64Octets+ deriving (Eq, Show)++instance FromJSON OctKeyParameters where+ parseJSON = (OctKeyParameters <$>) . parseJSON++instance ToJSON OctKeyParameters where+ toJSON (OctKeyParameters k) = toJSON k++instance Key OctKeyParameters where+ sign JWA.JWS.HS256 = signOct SHA256+ sign JWA.JWS.HS384 = signOct SHA384+ sign JWA.JWS.HS512 = signOct SHA512+ sign h = error $ "alg/key mismatch: " ++ show h ++ "/Oct"+ verify h k m s = sign h k m == s++signOct+ :: HashAlgorithm a+ => a+ -> OctKeyParameters+ -> B.ByteString+ -> B.ByteString+signOct a (OctKeyParameters (Types.Base64Octets k)) m = toBytes $ hmacAlg a k m+++-- | Key material sum type.+--+data KeyMaterial =+ ECKeyMaterial EC ECKeyParameters+ | RSAKeyMaterial RSA RSAKeyParameters+ | OctKeyMaterial Oct OctKeyParameters+ deriving (Eq, Show)++instance FromJSON KeyMaterial where+ parseJSON = withObject "KeyMaterial" (\o ->+ ECKeyMaterial <$> o .: "kty" <*> parseJSON (Object o)+ <|> RSAKeyMaterial <$> o .: "kty" <*> parseJSON (Object o)+ <|> OctKeyMaterial <$> o .: "kty" <*> o .: "k")++instance ToJSON KeyMaterial where+ toJSON (ECKeyMaterial k p) = object $ ("kty" .= k) : Types.objectPairs (toJSON p)+ toJSON (RSAKeyMaterial k p) = object $ ("kty" .= k) : Types.objectPairs (toJSON p)+ toJSON (OctKeyMaterial k i) = object ["kty" .= k, "k" .= i]++instance Key KeyMaterial where+ sign JWA.JWS.None _ = const ""+ sign h (ECKeyMaterial _ k) = sign h k+ sign h (RSAKeyMaterial _ k) = sign h k+ sign h (OctKeyMaterial _ k) = sign h k+ verify JWA.JWS.None _ = \_ s -> s == ""+ verify h (ECKeyMaterial _ k) = verify h k+ verify h (RSAKeyMaterial _ k) = verify h k+ verify h (OctKeyMaterial _ k) = verify h k
+ src/Crypto/JOSE/JWA/JWS.hs view
@@ -0,0 +1,44 @@+-- Copyright (C) 2013 Fraser Tweedale+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++{-|++JSON Web Signature algorithms.++-}+module Crypto.JOSE.JWA.JWS where++import qualified Crypto.JOSE.TH+++-- | JWA §3.1. "alg" (Algorithm) Header Parameters for JWS+--+$(Crypto.JOSE.TH.deriveJOSEType "Alg" [+ "HS256" -- HMAC SHA ; REQUIRED+ , "HS384" -- HMAC SHA ; OPTIONAL+ , "HS512" -- HMAC SHA ; OPTIONAL+ , "RS256" -- RSASSA-PKCS-v1_5 SHA ; RECOMMENDED+ , "RS384" -- RSASSA-PKCS-v1_5 SHA ; OPTIONAL+ , "RS512" -- RSASSA-PKCS-v1_5 SHA ; OPTIONAL+ , "ES256" -- ECDSA P curve and SHA ; RECOMMENDED++ , "ES384" -- ECDSA P curve and SHA ; OPTIONAL+ , "ES512" -- ECDSA P curve and SHA ; OPTIONAL+ , "PS256" -- RSASSA-PSS SHA ; OPTIONAL+ , "PS384" -- RSASSA-PSS SHA ; OPTIONAL+ , "PS512" -- RSSSSA-PSS SHA ; OPTIONAL+ , "none" -- "none" No signature or MAC ; Optional+ ])
+ src/Crypto/JOSE/JWK.hs view
@@ -0,0 +1,135 @@+-- Copyright (C) 2013 Fraser Tweedale+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++{-|++A JSON Web Key (JWK) is a JavaScript Object Notation (JSON) data+structure that represents a cryptographic key. This module also+defines a JSON Web Key Set (JWK Set) JSON data structure for+representing a set of JWKs.++-}+module Crypto.JOSE.JWK+ (+ JWK(..)+ , materialJWK+ , genRSA++ , JWKSet(..)+ ) 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 qualified 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+++-- | JWK §3.3. "alg" (Algorithm) Parameter+--+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+++-- | JWK §3.3. "key_ops" (Key Operations) Parameter+--+$(Crypto.JOSE.TH.deriveJOSEType "KeyOp"+ [ "sign", "verify", "encrypt", "decrypt"+ , "wrapKey", "unwrapKey", "deriveKey", "deriveBits"+ ])+++-- | JWK §3.2. "use" (Public Key Use) Parameter+--+$(Crypto.JOSE.TH.deriveJOSEType "KeyUse" ["sig", "enc"])+++-- | JWK §3. JSON Web Key (JWK) Format+--+data JWK =+ JWK {+ jwkMaterial :: JWA.JWK.KeyMaterial,+ jwkUse :: Maybe KeyUse,+ jwkKeyOps :: Maybe [KeyOp],+ jwkAlg :: Maybe Alg,+ jwkKid :: Maybe String,+ jwkX5u :: Maybe Types.URI,+ jwkX5t :: Maybe Types.Base64SHA1,+ jwkX5c :: Maybe [Types.Base64X509]+ }+ 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 .:? "x5t" <*>+ o .:? "x5c")++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 ("x5t" .=) jwkX5t+ , fmap ("x5c" .=) jwkX5c+ ]+ ++ Types.objectPairs (toJSON jwkMaterial)++instance Key JWK where+ sign h k = sign h $ jwkMaterial k+ verify h k = verify h $ jwkMaterial k++-- | Construct a minimal JWK from key material.+--+materialJWK :: JWA.JWK.KeyMaterial -> JWK+materialJWK m = JWK m n n n n n n n where n = Nothing++-- | Generate a /(public, private)/ RSA keypair.+--+genRSA :: Int -> IO (JWK, JWK)+genRSA = fmap (materialJWK *** materialJWK) . JWA.JWK.genRSA+++-- | JWK §4. JSON Web Key Set (JWK Set) Format+--+data JWKSet = JWKSet [JWK]++instance FromJSON JWKSet where+ parseJSON = withObject "JWKSet" (\o -> JWKSet <$> o .: "keys")
+ src/Crypto/JOSE/JWS.hs view
@@ -0,0 +1,32 @@+-- Copyright (C) 2013 Fraser Tweedale+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++{-|++JSON Web Signature (JWS) represents content secured with digital+signatures or Message Authentication Codes (MACs) using JavaScript+Object Notation (JSON) based data structures.++-}+module Crypto.JOSE.JWS+ (+ Header(..)++ , JWS(..)+ , jwsPayload+ , signJWS+ , verifyJWS+ ) where++import Crypto.JOSE.JWS.Internal
+ src/Crypto/JOSE/JWS/Internal.hs view
@@ -0,0 +1,294 @@+-- Copyright (C) 2013 Fraser Tweedale+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types #-}+{-# OPTIONS_HADDOCK hide #-}++module Crypto.JOSE.JWS.Internal where++import Control.Applicative+import Data.Char+import Data.Maybe++import Data.Aeson+import Data.Aeson.Parser+import Data.Aeson.Types+import qualified Data.Attoparsec.ByteString.Lazy as A+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Base64.URL.Lazy as B64UL+import qualified Data.HashMap.Strict as M+import qualified Data.Text as T+import qualified Data.Text.Encoding as E+import Data.Traversable (sequenceA)+import qualified Data.Vector as V++import Crypto.JOSE.Classes+import Crypto.JOSE.Compact+import qualified Crypto.JOSE.JWA.JWS as JWA.JWS+import Crypto.JOSE.JWK+import qualified Crypto.JOSE.Types as Types+import qualified Crypto.JOSE.Types.Internal as Types+++critInvalidNames :: [T.Text]+critInvalidNames = [+ "alg"+ , "jku"+ , "jwk"+ , "x5u"+ , "x5t"+ , "x5c"+ , "kid"+ , "typ"+ , "cty"+ , "crit"+ ]++data CritParameters = CritParameters (M.HashMap T.Text Value)+ deriving (Eq, Show)++critObjectParser :: M.HashMap T.Text Value -> Value -> Parser (T.Text, Value)+critObjectParser o (String s)+ | s `elem` critInvalidNames = fail "crit key is reserved"+ | otherwise = (\v -> (s, v)) <$> o .: s+critObjectParser _ _ = fail "crit key is not text"++-- TODO implement array length >= 1 restriction+instance FromJSON CritParameters where+ parseJSON = withObject "crit" (\o ->+ case M.lookup "crit" o of+ Just (Array paramNames)+ | V.null paramNames -> fail "crit cannot be empty"+ | otherwise -> fmap (CritParameters . M.fromList)+ $ sequenceA+ $ map (critObjectParser o)+ $ V.toList paramNames+ _ -> fail "crit is not an array")++instance ToJSON CritParameters where+ toJSON (CritParameters m) = Object $ M.insert "crit" (toJSON $ M.keys m) m+++-- | JWS Header data type.+data Header = Header+ { headerAlg :: JWA.JWS.Alg+ , headerJku :: Maybe Types.URI -- ^ JWK Set URL+ , headerJwk :: Maybe JWK+ , headerKid :: Maybe String -- ^ interpretation unspecified+ , headerX5u :: Maybe Types.URI+ , headerX5t :: Maybe Types.Base64SHA1+ , headerX5c :: Maybe [Types.Base64X509] -- ^ TODO implement min len of 1+ , headerTyp :: Maybe String -- ^ Content Type (of object)+ , headerCty :: Maybe String -- ^ Content Type (of payload)+ , headerCrit :: Maybe CritParameters+ , headerRaw :: Maybe BS.ByteString -- ^ protected header, if known+ }+ deriving (Show)++instance Eq Header where+ a == b =+ let+ ignoreRaw (Header alg jku jwk kid x5u x5t x5c typ cty crit _)+ = (alg, jku, jwk, kid, x5u, x5t, x5c, typ, cty, crit)+ in+ ignoreRaw a == ignoreRaw b++parseHeaderWith+ :: (forall a. FromJSON a => T.Text -> Parser a)+ -> (forall a. FromJSON a => T.Text -> Parser (Maybe a))+ -> Parser (Maybe CritParameters)+ -> Parser Header+parseHeaderWith req opt crit = Header+ <$> req "alg"+ <*> opt "jku"+ <*> opt "jwk"+ <*> opt "kid"+ <*> opt "x5u"+ <*> opt "x5t"+ <*> opt "x5c"+ <*> opt "typ"+ <*> opt "cty"+ <*> crit+ <*> pure Nothing++parseCrit :: Object -> Parser (Maybe CritParameters)+parseCrit o = if M.member "crit" o+ then Just <$> parseJSON (Object o)+ else pure Nothing++instance FromJSON Header where+ parseJSON = withObject "JWS Header" (\o ->+ parseHeaderWith (o .:) (o .:?) (parseCrit o))++instance ToJSON Header where+ toJSON (Header alg jku jwk kid x5u x5t x5c typ cty crit _) = object $ catMaybes [+ Just ("alg" .= alg)+ , fmap ("jku" .=) jku+ , fmap ("jwk" .=) jwk+ , fmap ("kid" .=) kid+ , fmap ("x5u" .=) x5u+ , fmap ("x5t" .=) x5t+ , fmap ("x5c" .=) x5c+ , fmap ("typ" .=) typ+ , fmap ("cty" .=) cty+ ]+ ++ Types.objectPairs (toJSON crit)+++-- construct a minimal header with the given alg+algHeader :: JWA.JWS.Alg -> Header+algHeader alg = Header alg n n n n n n n n n n where n = Nothing+++(.::) :: (FromJSON a) => Object -> Object -> T.Text -> Parser a+(.::) o1 o2 k = case (M.lookup k o1, M.lookup k o2) of+ (Just _, Just _) -> fail $ "key " ++ show k ++ " cannot appear twice"+ (Just v, _) -> parseJSON v+ (_, Just v) -> parseJSON v+ _ -> fail $ "key " ++ show k ++ " now present"++(.::?) :: (FromJSON a) => Object -> Object -> T.Text -> Parser (Maybe a)+(.::?) o1 o2 k = case (M.lookup k o1, M.lookup k o2) of+ (Just _, Just _) -> fail $ "key " ++ show k ++ " cannot appear twice"+ (Just v, _) -> parseJSON v+ (_, Just v) -> parseJSON v+ _ -> pure Nothing+++data Signature = Signature Header Types.Base64Octets+ deriving (Eq, Show)++parseHeader :: Maybe Object -> Maybe Object -> Parser Header+parseHeader (Just p) (Just u) = parseHeaderWith ((.::) p u) ((.::?) p u) (parseCrit p)+parseHeader (Just p) _ = parseHeaderWith (p .:) (p .:?) (parseCrit p)+parseHeader _ (Just u) = parseHeaderWith (u .:) (u .:?) (if M.member "crit" u+ then fail "crit MUST occur only with the JWS Protected Header"+ else pure Nothing)+parseHeader _ _ = fail "no protected or unprotected header given"+++newtype JSONByteString = JSONByteString { bs :: BS.ByteString }++instance FromJSON JSONByteString where+ parseJSON = withText "JSON bytestring" (return . JSONByteString . E.encodeUtf8)++instance FromJSON Signature where+ parseJSON = withObject "signature" (\o -> Signature+ <$> do+ protectedEncoded <- o .:? "protected"+ protectedJSON <- maybe+ (pure Nothing)+ (withText "base64 encoded header"+ (Types.parseB64Url (return . Just . JSONByteString)))+ protectedEncoded+ protected <- maybe+ (pure Nothing)+ (return . decode . BSL.fromStrict)+ (fmap bs protectedJSON)+ unprotected <- o .:? "header"+ parseHeader protected unprotected+ <*> o .: "signature")++instance ToJSON Signature where+ toJSON (Signature h s) = object $ ("signature" .= s) : Types.objectPairs (toJSON h)+++-- | JSON Web Signature data type. Consists of a payload and a+-- (possibly empty) list of signatures.+--+data JWS = JWS Types.Base64Octets [Signature]+ deriving (Eq, Show)++instance FromJSON JWS where+ parseJSON = withObject "JWS JSON serialization" (\o -> JWS+ <$> o .: "payload"+ <*> o .: "signatures")++instance ToJSON JWS where+ toJSON (JWS p ss) = object ["payload" .= p, "signatures" .= ss]++-- | Payload of a JWS, as a lazy bytestring.+--+jwsPayload :: JWS -> BSL.ByteString+jwsPayload (JWS (Types.Base64Octets s) _) = BSL.fromStrict s+++encodeO :: ToJSON a => a -> BSL.ByteString+encodeO = BSL.reverse . BSL.dropWhile (== c) . BSL.reverse+ . B64UL.encode . encode+ where c = fromIntegral $ ord '='++decodeO :: FromJSON a => BSL.ByteString -> Either String a+decodeO s = B64UL.decode (pad s) >>= eitherDecode+ where+ pad t = t `BSL.append` BSL.replicate ((4 - BSL.length t `mod` 4) `mod` 4) c+ c = fromIntegral $ ord '='++encodeS :: ToJSON a => a -> BSL.ByteString+encodeS = BSL.init . BSL.tail . encode++decodeS :: FromJSON a => BSL.ByteString -> Maybe a+decodeS s = do+ v <- A.maybeResult $ A.parse value $ BSL.intercalate s ["\"", "\""]+ parseMaybe parseJSON v++signingInput :: Header -> Types.Base64Octets -> BSL.ByteString+signingInput h p = BSL.intercalate "."+ [maybe (encodeO h) BSL.fromStrict (headerRaw h), encodeS p]++-- Convert JWS to compact serialization.+--+-- The operation is defined only when there is exactly one+-- signature and returns Nothing otherwise+--+instance ToCompact JWS where+ toCompact (JWS p [Signature h s]) = Right [signingInput h p, encodeS s]+ toCompact (JWS _ xs) =+ Left $ "cannot compact serialize JWS with " ++ show (length xs) ++ " sigs"++instance FromCompact JWS where+ fromCompact [h, p, s] = do+ h' <- (\h' -> h' { headerRaw = Just $ BSL.toStrict h }) <$> decodeO h+ p' <- maybe (Left "payload decode failed") Right $ decodeS p+ s' <- maybe (Left "sig decode failed") Right $ decodeS s+ return $ JWS p' [Signature h' s']+ fromCompact xs = Left $ "expected 3 parts, got " ++ show (length xs)+++-- §5.1. Message Signing or MACing++-- | Create a new signature on a JWS.+--+signJWS+ :: JWS -- ^ JWS to sign+ -> Header -- ^ Header for signature+ -> JWK -- ^ Key with which to sign+ -> JWS -- ^ JWS with new signature appended+signJWS (JWS p sigs) h k = JWS p (sig:sigs) where+ sig = Signature h $ Types.Base64Octets $+ sign (headerAlg h) k (BSL.toStrict $ signingInput h p)++-- | Verify a JWS.+--+-- Verification succeeds if any signature on the JWS is successfully+-- validated with the given 'Key'.+--+verifyJWS :: JWK -> JWS -> Bool+verifyJWS k (JWS p sigs) = any (verifySig k p) sigs++verifySig :: JWK -> Types.Base64Octets -> Signature -> Bool+verifySig k m (Signature h (Types.Base64Octets s))+ = verify (headerAlg h) k (BSL.toStrict $ signingInput h m) s
+ src/Crypto/JOSE/Legacy.hs view
@@ -0,0 +1,106 @@+-- Copyright (C) 2013 Fraser Tweedale+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++{-|++Types to deal with the legacy JSON Web Key formats used with+Mozilla Persona.++-}+module Crypto.JOSE.Legacy+ (+ JWK'+ , genRSA'+ ) where++import Control.Applicative+import Control.Arrow++import Data.Aeson++import Crypto.JOSE.Classes+import Crypto.JOSE.JWA.JWK+import qualified Crypto.JOSE.Types.Internal as Types+import Crypto.JOSE.TH+++$(Crypto.JOSE.TH.deriveJOSEType "RS" ["RS"])+++newtype RSAKeyParameters' = RSAKeyParameters' RSAKeyParameters+ deriving (Eq, Show)++instance FromJSON RSAKeyParameters' where+ parseJSON = withObject "RSA" (\o ->+ RSAKeyParameters' <$> (RSAPrivateKeyParameters+ <$> o .: "modulus"+ <*> o .: "exponent"+ <*> o .: "secretExponent"+ <*> pure Nothing)+ <|> RSAKeyParameters' <$> (RSAPublicKeyParameters+ <$> o .: "modulus"+ <*> o .: "exponent")+ )++instance ToJSON RSAKeyParameters' where+ toJSON (RSAKeyParameters' (RSAPrivateKeyParameters n e d _)) = object+ ["modulus" .= n ,"exponent" .= e ,"secretExponent" .= d]+ toJSON (RSAKeyParameters' (RSAPublicKeyParameters n e))+ = object ["modulus" .= n, "exponent" .= e]++instance Key RSAKeyParameters' where+ sign h (RSAKeyParameters' k) = sign h k+ verify h (RSAKeyParameters' k) = verify h k+++data KeyMaterial' = RSAKeyMaterial' RS RSAKeyParameters' deriving (Eq, Show)++instance FromJSON KeyMaterial' where+ parseJSON = withObject "KeyMaterial'" (\o ->+ RSAKeyMaterial' <$> o .: "algorithm" <*> parseJSON (Object o))++instance ToJSON KeyMaterial' where+ toJSON (RSAKeyMaterial' a k)+ = object $ ("algorithm" .= a) : Types.objectPairs (toJSON k)++instance Key KeyMaterial' where+ sign h (RSAKeyMaterial' _ k) = sign h k+ verify h (RSAKeyMaterial' _ k) = verify h k+++-- | Legacy JSON Web Key data type.+--+newtype JWK' = JWK' KeyMaterial' deriving (Eq, Show)++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)++instance Key JWK' where+ sign h (JWK' k) = sign h k+ verify h (JWK' k) = verify h k+++-- | Generate a legacy RSA keypair.+--+genRSA' :: Int -> IO (JWK', JWK')+genRSA' =+ let f = JWK' . RSAKeyMaterial' RS . RSAKeyParameters'+ in fmap (f *** f) . genRSAParams
+ src/Crypto/JOSE/TH.hs view
@@ -0,0 +1,101 @@+-- 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.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++{-# LANGUAGE TemplateHaskell #-}++{-|++Template Haskell shorthand for deriving the /many/ nullary JOSE+data constructors and associated Aeson instances.++-}++module Crypto.JOSE.TH+ (+ deriveJOSEType+ ) where++import Control.Applicative+import Data.Aeson+import Data.Char+import Language.Haskell.TH.Lib+import Language.Haskell.TH.Syntax+++capitalize :: String -> String+capitalize (x:xs) = toUpper x:xs+capitalize s = s++sanitize :: String -> String+sanitize = map (\c -> if isAlphaNum c then c else '_')++conize :: String -> Name+conize = mkName . capitalize . sanitize++guardPred :: String -> ExpQ+guardPred s = [e| $(varE $ mkName "s") == s |]++guardExp :: String -> ExpQ+guardExp s = [e| pure $(conE $ conize s) |]++guard :: String -> Q (Guard, Exp)+guard s = normalGE (guardPred s) (guardExp s)++endGuardPred :: ExpQ+endGuardPred = [e| otherwise |]++endGuardExp :: ExpQ+endGuardExp = [e| fail "unrecognised value" |]++endGuard :: Q (Guard, Exp)+endGuard = normalGE endGuardPred endGuardExp++guardedBody :: [String] -> BodyQ+guardedBody vs = guardedB (map guard vs ++ [endGuard])++parseJSONClauseQ :: [String] -> ClauseQ+parseJSONClauseQ vs = clause [varP $ mkName "s"] (guardedBody vs) []++parseJSONFun :: [String] -> DecQ+parseJSONFun vs = funD 'parseJSON [parseJSONClauseQ vs]+++toJSONClause :: String -> ClauseQ+toJSONClause s = clause [conP (conize s) []] (normalB [| s |]) []++toJSONFun :: [String] -> DecQ+toJSONFun vs = funD 'toJSON (map toJSONClause vs)+++aesonInstance :: String -> Name -> TypeQ+aesonInstance s n = appT (conT n) (conT $ mkName s)++-- | Derive a JOSE sum type with nullary data constructors, along+-- with 'ToJSON' and 'FromJSON' instances+--+deriveJOSEType+ :: String+ -- ^ Type name.+ -> [String]+ -- ^ List of JSON string values. The corresponding constructor+ -- is derived by upper-casing the first letter and converting+ -- non-alpha-numeric characters are converted to underscores.+ -> Q [Dec]+deriveJOSEType s vs = sequenceQ [+ dataD (cxt []) (mkName s) [] (map conQ vs) (map mkName ["Eq", "Show"])+ , instanceD (cxt []) (aesonInstance s ''FromJSON) [parseJSONFun vs]+ , instanceD (cxt []) (aesonInstance s ''ToJSON) [toJSONFun vs]+ ]+ where+ conQ v = normalC (conize v) []
+ src/Crypto/JOSE/Types.hs view
@@ -0,0 +1,126 @@+-- Copyright (C) 2013 Fraser Tweedale+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++{-# LANGUAGE OverloadedStrings #-}++{-|++Data types for the JOSE library.++-}+module Crypto.JOSE.Types where++import Control.Applicative++import Data.Aeson+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import Data.Certificate.X509+import qualified Data.Text as T+import qualified Network.URI++import Crypto.JOSE.Types.Internal+++-- | A base64url encoded octet sequence interpreted as an integer.+--+newtype Base64Integer = Base64Integer Integer+ deriving (Eq, Show)++instance FromJSON Base64Integer where+ parseJSON = withText "base64url integer" $ parseB64Url $+ pure . Base64Integer . bsToInteger++instance ToJSON Base64Integer where+ toJSON (Base64Integer x) = encodeB64Url $ integerToBS x+++-- | A base64url encoded octet sequence interpreted as an integer+-- and where the number of octets carries explicit bit-length+-- information.+--+data SizedBase64Integer = SizedBase64Integer Int Integer+ deriving (Eq, Show)++instance FromJSON SizedBase64Integer where+ parseJSON = withText "full size base64url integer" $ parseB64Url (\bytes ->+ pure $ SizedBase64Integer (BS.length bytes) (bsToInteger bytes))++instance ToJSON SizedBase64Integer where+ toJSON (SizedBase64Integer s x) = encodeB64Url $ zeroPad $ integerToBS x+ where zeroPad xs = BS.replicate (s - BS.length xs) 0 `BS.append` xs+++-- | A base64url encoded string. This is used for the JWE+-- /Agreement PartyUInfo/ and /Agreement PartyVInfo/ fields.+--+newtype Base64UrlString = Base64UrlString BS.ByteString+ deriving (Eq, Show)++instance FromJSON Base64UrlString where+ parseJSON = withText "base64url string" $ parseB64Url $ pure . Base64UrlString+++-- | A base64url encoded octet sequence. Used for payloads,+-- signatures, symmetric keys, salts, initialisation vectors, etc.+--+newtype Base64Octets = Base64Octets BS.ByteString+ deriving (Eq, Show)++instance FromJSON Base64Octets where+ parseJSON = withText "Base64Octets" $ parseB64Url (pure . Base64Octets)++instance ToJSON Base64Octets where+ toJSON (Base64Octets bytes) = encodeB64Url bytes+++-- | A base64url encoded SHA-1 digest. Used for X.509 certificate+-- thumbprints.+--+newtype Base64SHA1 = Base64SHA1 BS.ByteString+ deriving (Eq, Show)++instance FromJSON Base64SHA1 where+ parseJSON = withText "base64url SHA-1" $ parseB64Url (\bytes ->+ case BS.length bytes of+ 20 -> pure $ Base64SHA1 bytes+ _ -> fail "incorrect number of bytes")++instance ToJSON Base64SHA1 where+ toJSON (Base64SHA1 bytes) = encodeB64Url bytes+++-- | A base64 encoded X.509 certificate.+--+newtype Base64X509 = Base64X509 X509+ deriving (Eq, Show)++instance FromJSON Base64X509 where+ parseJSON = withText "base64url X.509 certificate" $ parseB64 $+ either fail (pure . Base64X509) . decodeCertificate . BSL.fromStrict++instance ToJSON Base64X509 where+ toJSON (Base64X509 x509) = encodeB64 $ BSL.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/Internal.hs view
@@ -0,0 +1,81 @@+-- 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.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++{-# LANGUAGE OverloadedStrings #-}++{-|++Internal utility functions for encoding/decoding JOSE types.++-}+module Crypto.JOSE.Types.Internal where++import Data.Tuple (swap)++import Data.Aeson.Types+import qualified Data.ByteString as B+import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Base64.URL as B64U+import qualified Data.HashMap.Strict as M+import qualified Data.Text as T+import qualified Data.Text.Encoding as E++-- | Convert a JSON object into a list of pairs or the empty list+-- if the JSON value is not an object.+--+objectPairs :: Value -> [Pair]+objectPairs (Object o) = M.toList o+objectPairs _ = []++-- | Produce a parser of base64 encoded text from a bytestring parser.+--+parseB64 :: FromJSON a => (B.ByteString -> Parser a) -> T.Text -> Parser a+parseB64 f = either fail f . decodeB64+ where+ decodeB64 = B64.decode . E.encodeUtf8++-- | Convert a bytestring to a base64 encoded JSON 'String'+--+encodeB64 :: B.ByteString -> Value+encodeB64 = String . E.decodeUtf8 . B64.encode++-- | Produce a parser of base64url encoded text from a bytestring parser.+--+parseB64Url :: FromJSON a => (B.ByteString -> Parser a) -> T.Text -> Parser a+parseB64Url f = either fail f . decodeB64Url+ where+ decodeB64Url = B64U.decode . E.encodeUtf8 . pad+ pad s = s `T.append` T.replicate ((4 - T.length s `mod` 4) `mod` 4) "="++-- | Convert a bytestring to a base64url encoded JSON 'String'+--+encodeB64Url :: B.ByteString -> Value+encodeB64Url = String . unpad . E.decodeUtf8 . B64U.encode+ where+ unpad = T.dropWhileEnd (== '=')++-- | Convert an unsigned big endian octet sequence to the integer+-- it represents.+--+bsToInteger :: B.ByteString -> Integer+bsToInteger = B.foldl (\acc x -> acc * 256 + toInteger x) 0++-- | Convert an integer to its unsigned big endian representation as+-- an octet sequence.+--+integerToBS :: Integer -> B.ByteString+integerToBS = B.reverse . B.unfoldr (fmap swap . f)+ where+ f x = if x == 0 then Nothing else Just (toWord8 $ quotRem x 256)+ toWord8 (seed, x) = (seed, fromIntegral x)
+ test/Test.hs view
@@ -0,0 +1,25 @@+-- Copyright (C) 2013 Fraser Tweedale+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.++import Test.Hspec++import JWK+import JWS+import Types+++main = hspec $ do+ Types.spec+ JWK.spec+ JWS.spec