diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/jose.cabal b/jose.cabal new file mode 100644 --- /dev/null +++ b/jose.cabal @@ -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 diff --git a/src/Crypto/JOSE/Classes.hs b/src/Crypto/JOSE/Classes.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/JOSE/Classes.hs @@ -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 diff --git a/src/Crypto/JOSE/Compact.hs b/src/Crypto/JOSE/Compact.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/JOSE/Compact.hs @@ -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 diff --git a/src/Crypto/JOSE/JWA/JWE.hs b/src/Crypto/JOSE/JWA/JWE.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/JOSE/JWA/JWE.hs @@ -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 + ]) diff --git a/src/Crypto/JOSE/JWA/JWE/Alg.hs b/src/Crypto/JOSE/JWA/JWE/Alg.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/JOSE/JWA/JWE/Alg.hs @@ -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 + ]) diff --git a/src/Crypto/JOSE/JWA/JWK.hs b/src/Crypto/JOSE/JWA/JWK.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/JOSE/JWA/JWK.hs @@ -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 diff --git a/src/Crypto/JOSE/JWA/JWS.hs b/src/Crypto/JOSE/JWA/JWS.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/JOSE/JWA/JWS.hs @@ -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 + ]) diff --git a/src/Crypto/JOSE/JWK.hs b/src/Crypto/JOSE/JWK.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/JOSE/JWK.hs @@ -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") diff --git a/src/Crypto/JOSE/JWS.hs b/src/Crypto/JOSE/JWS.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/JOSE/JWS.hs @@ -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 diff --git a/src/Crypto/JOSE/JWS/Internal.hs b/src/Crypto/JOSE/JWS/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/JOSE/JWS/Internal.hs @@ -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 diff --git a/src/Crypto/JOSE/Legacy.hs b/src/Crypto/JOSE/Legacy.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/JOSE/Legacy.hs @@ -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 diff --git a/src/Crypto/JOSE/TH.hs b/src/Crypto/JOSE/TH.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/JOSE/TH.hs @@ -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) [] diff --git a/src/Crypto/JOSE/Types.hs b/src/Crypto/JOSE/Types.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/JOSE/Types.hs @@ -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 diff --git a/src/Crypto/JOSE/Types/Internal.hs b/src/Crypto/JOSE/Types/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/JOSE/Types/Internal.hs @@ -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) diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -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