change x5c type to (NonEmpty X509.SignedCertificate)

There is no real reason to keep the newtype within the JWSHeader and
JWK data types themselves - it is only needed for parsing/printing
and is extraneous w.r.t. the data type definition.  Update the data
declarations and perform necessary changes to the FromJSON/ToJSON
instances.

Add 'instance Functor (HeaderParam p)' to support this change.

This change also uncovered a bug in JWSHeader parsing where the
X509-related fields were read from the wrong keys, which was fixed
in this commit.

src/Crypto/JOSE/Header.hs

@@ -163,6 +163,9 @@ instance ProtectionIndicator () where
 data HeaderParam p a = HeaderParam p a
   deriving (Eq, Show)
 
+instance Functor (HeaderParam p) where
+  fmap f (HeaderParam p a) = HeaderParam p (f a)
+
 -- | Lens for the 'Protection' of a 'HeaderParam'
 protection :: Lens' (HeaderParam p a) p
 protection f (HeaderParam p v) = fmap (\p' -> HeaderParam p' v) (f p)
@@ -325,7 +328,7 @@ class HasX5u a where
   x5u :: Lens' (a p) (Maybe (HeaderParam p Types.URI))
 
 class HasX5c a where
-  x5c :: Lens' (a p) (Maybe (HeaderParam p (NonEmpty Types.Base64X509)))
+  x5c :: Lens' (a p) (Maybe (HeaderParam p (NonEmpty Types.SignedCertificate)))
 
 class HasX5t a where
   x5t :: Lens' (a p) (Maybe (HeaderParam p Types.Base64SHA1))

src/Crypto/JOSE/JWE.hs

@@ -73,7 +73,7 @@ data JWEHeader p = JWEHeader
   , _jweJwk :: Maybe (HeaderParam p JWK)
   , _jweKid :: Maybe (HeaderParam p String)
   , _jweX5u :: Maybe (HeaderParam p Types.URI)
-  , _jweX5c :: Maybe (HeaderParam p (NonEmpty Types.Base64X509))
+  , _jweX5c :: Maybe (HeaderParam p (NonEmpty Types.SignedCertificate))
   , _jweX5t :: Maybe (HeaderParam p Types.Base64SHA1)
   , _jweX5tS256 :: Maybe (HeaderParam p Types.Base64SHA256)
   , _jweTyp :: Maybe (HeaderParam p String)  -- ^ Content Type (of object)
@@ -96,7 +96,8 @@ instance HasParams JWEHeader where
     <*> headerOptional "jwk" hp hu
     <*> headerOptional "kid" hp hu
     <*> headerOptional "x5u" hp hu
-    <*> headerOptional "x5c" hp hu
+    <*> ((fmap . fmap . fmap . fmap)
+          (\(Types.Base64X509 cert) -> cert) (headerOptional "x5c" hp hu))
     <*> headerOptional "x5t" hp hu
     <*> headerOptional "x5t#S256" hp hu
     <*> headerOptional "typ" hp hu
@@ -113,7 +114,7 @@ instance HasParams JWEHeader where
       , fmap (\p -> (view isProtected p, "jwk" .= view param p)) jwk
       , fmap (\p -> (view isProtected p, "kid" .= view param p)) kid
       , fmap (\p -> (view isProtected p, "x5u" .= view param p)) x5u
-      , fmap (\p -> (view isProtected p, "x5c" .= view param p)) x5c
+      , fmap (\p -> (view isProtected p, "x5c" .= fmap Types.Base64X509 (view param p))) x5c
       , fmap (\p -> (view isProtected p, "x5t" .= view param p)) x5t
       , fmap (\p -> (view isProtected p, "x5t#S256" .= view param p)) x5tS256
       , fmap (\p -> (view isProtected p, "typ" .= view param p)) typ

src/Crypto/JOSE/JWK.hs

@@ -104,6 +104,7 @@ import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Builder as Builder
 import Data.List.NonEmpty
 import qualified Data.Text as T
+import qualified Data.X509 as X509
 
 import Test.QuickCheck
 
@@ -157,7 +158,7 @@ data JWK = JWK
   , _jwkAlg :: Maybe JWKAlg
   , _jwkKid :: Maybe T.Text
   , _jwkX5u :: Maybe Types.URI
-  , _jwkX5c :: Maybe (NonEmpty Types.Base64X509)
+  , _jwkX5c :: Maybe (NonEmpty X509.SignedCertificate)
   , _jwkX5t :: Maybe Types.Base64SHA1
   , _jwkX5tS256 :: Maybe Types.Base64SHA256
   }
@@ -172,7 +173,7 @@ instance FromJSON JWK where
     <*> o .:? "alg"
     <*> o .:? "kid"
     <*> o .:? "x5u"
-    <*> o .:? "x5c"
+    <*> ((fmap . fmap) (\(Types.Base64X509 cert) -> cert) <$> o .:? "x5c")
     <*> o .:? "x5t"
     <*> o .:? "x5t#S256"
 
@@ -183,7 +184,7 @@ instance ToJSON JWK where
     , fmap ("key_ops" .=) _jwkKeyOps
     , fmap ("kid" .=) _jwkKid
     , fmap ("x5u" .=) _jwkX5u
-    , fmap ("x5c" .=) _jwkX5c
+    , fmap (("x5c" .=) . fmap Types.Base64X509) _jwkX5c
     , fmap ("x5t" .=) _jwkX5t
     , fmap ("x5t#S256" .=) _jwkX5tS256
     ]

src/Crypto/JOSE/JWS.hs

@@ -179,7 +179,7 @@ data JWSHeader p = JWSHeader
   , _jwsHeaderJwk :: Maybe (HeaderParam p JWK)
   , _jwsHeaderKid :: Maybe (HeaderParam p String)  -- ^ interpretation unspecified
   , _jwsHeaderX5u :: Maybe (HeaderParam p Types.URI)
-  , _jwsHeaderX5c :: Maybe (HeaderParam p (NonEmpty Types.Base64X509))
+  , _jwsHeaderX5c :: Maybe (HeaderParam p (NonEmpty Types.SignedCertificate))
   , _jwsHeaderX5t :: Maybe (HeaderParam p Types.Base64SHA1)
   , _jwsHeaderX5tS256 :: Maybe (HeaderParam p Types.Base64SHA256)
   , _jwsHeaderTyp :: Maybe (HeaderParam p String)  -- ^ Content Type (of object)
@@ -325,9 +325,10 @@ instance HasParams JWSHeader where
     <*> headerOptional "jwk" hp hu
     <*> headerOptional "kid" hp hu
     <*> headerOptional "x5u" hp hu
+    <*> ((fmap . fmap . fmap . fmap)
+          (\(Types.Base64X509 cert) -> cert) (headerOptional "x5c" hp hu))
     <*> headerOptional "x5t" hp hu
     <*> headerOptional "x5t#S256" hp hu
-    <*> headerOptional "x5c" hp hu
     <*> headerOptional "typ" hp hu
     <*> headerOptional "cty" hp hu
     <*> (headerOptionalProtected "crit" hp hu
@@ -340,7 +341,7 @@ instance HasParams JWSHeader where
       , fmap (\p -> (view isProtected p, "jwk" .= view param p)) (view jwk h)
       , fmap (\p -> (view isProtected p, "kid" .= view param p)) (view kid h)
       , fmap (\p -> (view isProtected p, "x5u" .= view param p)) (view x5u h)
-      , fmap (\p -> (view isProtected p, "x5c" .= view param p)) (view x5c h)
+      , fmap (\p -> (view isProtected p, "x5c" .= fmap Types.Base64X509 (view param p))) (view x5c h)
       , fmap (\p -> (view isProtected p, "x5t" .= view param p)) (view x5t h)
       , fmap (\p -> (view isProtected p, "x5t#S256" .= view param p)) (view x5tS256 h)
       , fmap (\p -> (view isProtected p, "typ" .= view param p)) (view typ h)

src/Crypto/JOSE/Types.hs

@@ -31,6 +31,7 @@ module Crypto.JOSE.Types
   , Base64SHA1(..)
   , Base64SHA256(..)
   , Base64X509(..)
+  , SignedCertificate
   , URI
   , base64url
   ) where