From ef4ecce327871ece78eb8d460685297fb0cfcca6 Mon Sep 17 00:00:00 2001
From: Tony Morris <tmorris@tmorris.net>
Date: Mon, 21 Jan 2019 14:47:56 +1000
Subject: [PATCH] code review and feature additions

* ignore /dist-newtyle
* delete and replace orphan instances
* delete and replace overlapping instances
* fix some lenses
* use modern-uri(Text.URI) instead of Network.URI
* Implement Eq1, Show1
* upper bounds on dependencies
* remove shadowed variable names
* implement some waargonaut decoder/encoder values
---
 .gitignore                               |   3 +-
 jose.cabal                               |  57 +++--
 src/Crypto/JOSE.hs                       |   1 -
 src/Crypto/JOSE/Error.hs                 |  14 --
 src/Crypto/JOSE/Header.hs                | 118 +++++-----
 src/Crypto/JOSE/JWA/JWK.hs               |   9 +-
 src/Crypto/JOSE/JWE.hs                   |  44 ++--
 src/Crypto/JOSE/JWK.hs                   |  11 +-
 src/Crypto/JOSE/JWS.hs                   | 267 ++++++++++++++++++-----
 src/Crypto/JOSE/Types.hs                 |   4 +-
 src/Crypto/JOSE/Types/Internal.hs        |  24 +-
 src/Crypto/JOSE/Types/Orphans.hs         |  55 -----
 src/Crypto/JOSE/Types/WrappedNonEmpty.hs |  88 ++++++++
 src/Crypto/JOSE/Types/WrappedURI.hs      | 106 +++++++++
 src/Crypto/JWT.hs                        | 166 ++++++++++++--
 test/AESKW.hs                            |   2 +
 test/JWK.hs                              |   2 +-
 test/JWS.hs                              |  73 +++++--
 test/JWT.hs                              |  28 +--
 test/Properties.hs                       |  17 +-
 test/Test.hs                             |   1 -
 test/Types.hs                            |  11 +-
 test/WrappedExceptT.hs                   |  28 +++
 23 files changed, 817 insertions(+), 312 deletions(-)
 delete mode 100644 src/Crypto/JOSE/Types/Orphans.hs
 create mode 100644 src/Crypto/JOSE/Types/WrappedNonEmpty.hs
 create mode 100644 src/Crypto/JOSE/Types/WrappedURI.hs
 create mode 100644 test/WrappedExceptT.hs

diff --git a/.gitignore b/.gitignore
index 02ee1f3..cac09dd 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,5 @@
-dist
+/dist
+/dist-newstyle
 .cabal-sandbox
 cabal.sandbox.config
 .stack-work
diff --git a/jose.cabal b/jose.cabal
index 52017ea..2c87539 100644
--- a/jose.cabal
+++ b/jose.cabal
@@ -54,36 +54,42 @@ library
     Crypto.JOSE.JWA.JWS
     Crypto.JOSE.JWA.JWE
     Crypto.JOSE.JWA.JWE.Alg
+    Crypto.JOSE.Types.WrappedURI
 
   other-modules:
     Crypto.JOSE.TH
     Crypto.JOSE.Types.Internal
-    Crypto.JOSE.Types.Orphans
+    Crypto.JOSE.Types.WrappedNonEmpty
 
   build-depends:
-    base >= 4.8 && < 5
-    , attoparsec
-    , base64-bytestring == 1.0.*
-    , concise >= 0.1
-    , containers >= 0.5
-    , cryptonite >= 0.7
-    , lens >= 4.16
-    , memory >= 0.7
-    , monad-time >= 0.1
-    , mtl >= 2
-    , semigroups >= 0.15
-    , template-haskell >= 2.4
-    , safe >= 0.3
-    , aeson >= 0.8.0.1
-    , unordered-containers == 0.2.*
-    , bytestring == 0.10.*
-    , text >= 1.1
-    , time >= 1.5
-    , network-uri >= 2.6
-    , QuickCheck >= 2
-    , quickcheck-instances
-    , x509 >= 1.4
-    , vector
+    aeson                >= 1.4.2 && < 1.5,
+    attoparsec           >= 0.13.2 && < 0.14,
+    base                 >= 4.8 && < 5,
+    base64-bytestring    == 1.0.*,
+    bytestring           == 0.10.*,
+    concise              >= 0.1 && < 0.2,
+    containers           >= 0.5 && < 0.7,
+    contravariant        >= 1.4 && < 1.5,
+    cryptonite           >= 0.7 && < 0.26,
+    exceptions           >= 0.10.0 && < 0.11,
+    lens                 >= 4.16 && < 4.18,
+    mtl                  >= 2 && < 2.3,
+    memory               >= 0.7 && < 0.15,
+    modern-uri           >= 0.3.0 && < 0.4,
+    monad-time           >= 0.1 && < 0.4,
+    network-uri          >= 2.6 && < 2.7,
+    QuickCheck           >= 2 && < 2.13,
+    quickcheck-instances >= 0.3 && < 0.4,
+    safe                 >= 0.3 && < 0.4,
+    semigroups           >= 0.15 && < 0.19,
+    semigroupoids        >= 5 && < 6,
+    template-haskell     >= 2.4 && < 2.15,
+    text                 >= 1.1 && < 1.3,
+    time                 >= 1.5 && < 1.10,
+    unordered-containers == 0.2.*,
+    vector               >= 0.12 && < 0.13,
+    waargonaut           >= 0.5 && < 0.6,
+    x509                 >= 1.4 && < 1.8
 
   ghc-options:    -Wall
   hs-source-dirs: src
@@ -103,6 +109,8 @@ test-suite tests
     JWT
     Properties
     Types
+    WrappedExceptT
+  ghc-options:    -Wall
 
   build-depends:
     base
@@ -135,6 +143,7 @@ test-suite tests
     , hspec
     , QuickCheck
     , quickcheck-instances
+    , modern-uri
 
 executable jose-example
   if !flag(demos)
diff --git a/src/Crypto/JOSE.hs b/src/Crypto/JOSE.hs
index 49e0582..389dbb9 100644
--- a/src/Crypto/JOSE.hs
+++ b/src/Crypto/JOSE.hs
@@ -31,6 +31,5 @@ import Crypto.JOSE.Error
 import Crypto.JOSE.JWK
 import Crypto.JOSE.JWK.Store
 import Crypto.JOSE.JWS
-import Crypto.JOSE.Types (base64url)
 
 {-# ANN module ("HLint: ignore Use import/export shortcut" :: String) #-}
diff --git a/src/Crypto/JOSE/Error.hs b/src/Crypto/JOSE/Error.hs
index 15c9aca..263ac66 100644
--- a/src/Crypto/JOSE/Error.hs
+++ b/src/Crypto/JOSE/Error.hs
@@ -14,8 +14,6 @@
 
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {-|
 
@@ -38,16 +36,13 @@ module Crypto.JOSE.Error
 import Data.Semigroup ((<>))
 import Numeric.Natural
 
-import Control.Monad.Trans (MonadTrans(..))
 import qualified Crypto.PubKey.RSA as RSA
 import Crypto.Error (CryptoError)
-import Crypto.Random (MonadRandom(..))
 import Control.Lens (Getter, to)
 import Control.Lens.TH (makeClassyPrisms, makePrisms)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding.Error as T
 
-
 -- | The wrong number of parts were found when decoding a
 -- compact JOSE object.
 --
@@ -117,12 +112,3 @@ data Error
   --   that matched the allowed algorithms
   deriving (Eq, Show)
 makeClassyPrisms ''Error
-
-
-instance (
-    MonadRandom m
-  , MonadTrans t
-  , Functor (t m)
-  , Monad (t m)
-  ) => MonadRandom (t m) where
-    getRandomBytes = lift . getRandomBytes
diff --git a/src/Crypto/JOSE/Header.hs b/src/Crypto/JOSE/Header.hs
index d361d65..3dddaec 100644
--- a/src/Crypto/JOSE/Header.hs
+++ b/src/Crypto/JOSE/Header.hs
@@ -36,7 +36,13 @@ module Crypto.JOSE.Header
   , headerRequired
   , headerRequiredProtected
   , headerOptional
+  , headerOptional'
+  , headerOptionalNonEmpty
+  , headerOptionalURI
   , headerOptionalProtected
+  , headerOptionalProtected'
+  , headerOptionalProtectedNonEmpty
+  , headerOptionalProtectedURI
 
   -- * Parsing headers
   , parseParams
@@ -45,20 +51,6 @@ module Crypto.JOSE.Header
   -- * Encoding headers
   , protectedParamsEncoded
   , unprotectedParams
-
-
-  -- * Header fields shared by JWS and JWE
-  , HasAlg(..)
-  , HasJku(..)
-  , HasJwk(..)
-  , HasKid(..)
-  , HasX5u(..)
-  , HasX5c(..)
-  , HasX5t(..)
-  , HasX5tS256(..)
-  , HasTyp(..)
-  , HasCty(..)
-  , HasCrit(..)
   ) where
 
 
@@ -66,7 +58,7 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.Monoid ((<>))
 import Data.Proxy (Proxy(..))
 
-import Control.Lens (Lens', Getter, to)
+import Control.Lens (Lens', Getter, to, Getting, view, _Wrapped)
 import Data.Aeson (FromJSON(..), Object, Value, encode, object)
 import Data.Aeson.Types (Pair, Parser)
 import qualified Data.ByteString.Base64.URL.Lazy as B64UL
@@ -74,12 +66,10 @@ import qualified Data.ByteString.Lazy as L
 import qualified Data.HashMap.Strict as M
 import qualified Data.Text as T
 
-import qualified Crypto.JOSE.JWA.JWS as JWA.JWS
-import Crypto.JOSE.JWK (JWK)
-import Crypto.JOSE.Types.Orphans ()
+import Crypto.JOSE.Types.WrappedURI(WrappedURI)
+import Crypto.JOSE.Types.WrappedNonEmpty(WrappedNonEmpty)
 import Crypto.JOSE.Types.Internal (unpad)
-import qualified Crypto.JOSE.Types as Types
-
+import Text.URI(URI)
 
 -- | A thing with parameters.
 --
@@ -235,6 +225,34 @@ headerOptional k hp hu = case (hp >>= M.lookup k, hu >>= M.lookup k) of
     getUnprotected
   (Nothing, Nothing)  -> pure Nothing
 
+headerOptional'
+  :: (FromJSON a, ProtectionIndicator p)
+  => Getting b a b
+  -> T.Text
+  -> Maybe Object
+  -> Maybe Object
+  -> Parser (Maybe (HeaderParam p b))
+headerOptional' j k hp hu =
+  fmap (fmap (fmap (view j))) (headerOptional k hp hu)
+
+headerOptionalNonEmpty
+  :: (FromJSON a, ProtectionIndicator p)
+  => T.Text
+  -> Maybe Object
+  -> Maybe Object
+  -> Parser (Maybe (HeaderParam p (NonEmpty a)))
+headerOptionalNonEmpty =
+  headerOptional' (_Wrapped :: Getting (NonEmpty a) (WrappedNonEmpty a) (NonEmpty a))
+
+headerOptionalURI
+  :: ProtectionIndicator p
+  => T.Text
+  -> Maybe Object
+  -> Maybe Object
+  -> Parser (Maybe (HeaderParam p URI))
+headerOptionalURI =
+  headerOptional' (_Wrapped :: Getting URI WrappedURI URI)
+
 -- | Parse an optional parameter that, if present, MUST be carried
 -- in the protected header.
 --
@@ -250,6 +268,33 @@ headerOptionalProtected k hp hu = case (hp >>= M.lookup k, hu >>= M.lookup k) of
   (Just v, _) -> Just <$> parseJSON v
   _           -> pure Nothing
 
+headerOptionalProtected'
+  :: FromJSON a
+  => Getting b a b
+  -> T.Text
+  -> Maybe Object
+  -> Maybe Object
+  -> Parser (Maybe b)
+headerOptionalProtected' j k hp hu =
+  fmap (fmap (view j)) (headerOptionalProtected k hp hu)
+
+headerOptionalProtectedNonEmpty
+  :: FromJSON a
+  => T.Text
+  -> Maybe Object
+  -> Maybe Object
+  -> Parser (Maybe (NonEmpty a))
+headerOptionalProtectedNonEmpty =
+  headerOptionalProtected' (_Wrapped :: Getting (NonEmpty a) (WrappedNonEmpty a) (NonEmpty a))
+
+headerOptionalProtectedURI
+  :: T.Text
+  -> Maybe Object
+  -> Maybe Object
+  -> Parser (Maybe URI)
+headerOptionalProtectedURI =
+  headerOptionalProtected' (_Wrapped :: Getting URI WrappedURI URI)
+
 -- | Parse a required parameter that may be carried in either
 -- the protected or the unprotected header.
 --
@@ -311,36 +356,3 @@ parseCrit
 parseCrit reserved exts o = mapM (mapM (critObjectParser reserved exts o))
   -- TODO fail on duplicate strings
 
-
-class HasAlg a where
-  alg :: Lens' (a p) (HeaderParam p JWA.JWS.Alg)
-
-class HasJku a where
-  jku :: Lens' (a p) (Maybe (HeaderParam p Types.URI))
-
-class HasJwk a where
-  jwk :: Lens' (a p) (Maybe (HeaderParam p JWK))
-
-class HasKid a where
-  kid :: Lens' (a p) (Maybe (HeaderParam p T.Text))
-
-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.SignedCertificate)))
-
-class HasX5t a where
-  x5t :: Lens' (a p) (Maybe (HeaderParam p Types.Base64SHA1))
-
-class HasX5tS256 a where
-  x5tS256 :: Lens' (a p) (Maybe (HeaderParam p Types.Base64SHA256))
-
-class HasTyp a where
-  typ :: Lens' (a p) (Maybe (HeaderParam p T.Text))
-
-class HasCty a where
-  cty :: Lens' (a p) (Maybe (HeaderParam p T.Text))
-
-class HasCrit a where
-  crit :: Lens' (a p) (Maybe (NonEmpty T.Text))
diff --git a/src/Crypto/JOSE/JWA/JWK.hs b/src/Crypto/JOSE/JWA/JWK.hs
index f9f2699..53e96b4 100644
--- a/src/Crypto/JOSE/JWA/JWK.hs
+++ b/src/Crypto/JOSE/JWA/JWK.hs
@@ -107,8 +107,7 @@ 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
-import Crypto.JOSE.Types.Orphans ()
-
+import Crypto.JOSE.Types.WrappedNonEmpty (parseNonEmpty, kvNonEmpty, gettingGenMaybeNonEmpty)
 
 -- | \"crv\" (Curve) Parameter
 --
@@ -159,7 +158,7 @@ instance FromJSON RSAPrivateKeyOptionalParameters where
     o .: "dp" <*>
     o .: "dq" <*>
     o .: "qi" <*>
-    o .:? "oth")
+    (o `parseNonEmpty` "oth"))
 
 instance ToJSON RSAPrivateKeyOptionalParameters where
   toJSON RSAPrivateKeyOptionalParameters{..} = object $ [
@@ -168,7 +167,7 @@ instance ToJSON RSAPrivateKeyOptionalParameters where
     , "dp" .= rsaDp
     , "dq" .= rsaDq
     , "qi" .= rsaQi
-    ] ++ maybe [] ((:[]) . ("oth" .=)) rsaOth
+    ] ++ maybe [] ((:[]) . ("oth" `kvNonEmpty`)) rsaOth
 
 instance Arbitrary RSAPrivateKeyOptionalParameters where
   arbitrary = RSAPrivateKeyOptionalParameters
@@ -177,7 +176,7 @@ instance Arbitrary RSAPrivateKeyOptionalParameters where
     <*> arbitrary
     <*> arbitrary
     <*> arbitrary
-    <*> arbitrary
+    <*> gettingGenMaybeNonEmpty
 
 
 -- | RSA private key parameters
diff --git a/src/Crypto/JOSE/JWE.hs b/src/Crypto/JOSE/JWE.hs
index ccc91fd..0605884 100644
--- a/src/Crypto/JOSE/JWE.hs
+++ b/src/Crypto/JOSE/JWE.hs
@@ -20,8 +20,9 @@
 module Crypto.JOSE.JWE
   (
     JWEHeader(..)
-
   , JWE(..)
+  , newJWEHeader
+  , wrap
   ) where
 
 import Control.Applicative ((<|>))
@@ -54,7 +55,8 @@ import Crypto.JOSE.JWA.JWE
 import Crypto.JOSE.JWK
 import qualified Crypto.JOSE.Types as Types
 import qualified Crypto.JOSE.Types.Internal as Types
-
+import Crypto.JOSE.Types.WrappedNonEmpty(kvNonEmpty)
+import Crypto.JOSE.Types.WrappedURI(kvURI)
 
 critInvalidNames :: [T.Text]
 critInvalidNames =
@@ -83,8 +85,8 @@ data JWEHeader p = JWEHeader
   deriving (Eq, Show)
 
 newJWEHeader :: ProtectionIndicator p => AlgWithParams -> Enc -> JWEHeader p
-newJWEHeader alg enc =
-  JWEHeader (Just alg) (HeaderParam getProtected enc) z z z z z z z z z z z
+newJWEHeader alg_ enc =
+  JWEHeader (Just alg_) (HeaderParam getProtected enc) z z z z z z z z z z z
   where z = Nothing
 
 instance HasParams JWEHeader where
@@ -92,34 +94,34 @@ instance HasParams JWEHeader where
     <$> parseJSON (Object (fromMaybe mempty hp <> fromMaybe mempty hu))
     <*> headerRequired "enc" hp hu
     <*> headerOptionalProtected "zip" hp hu
-    <*> headerOptional "jku" hp hu
+    <*> headerOptionalURI "jku" hp hu
     <*> headerOptional "jwk" hp hu
     <*> headerOptional "kid" hp hu
-    <*> headerOptional "x5u" hp hu
+    <*> headerOptionalURI "x5u" hp hu
     <*> ((fmap . fmap . fmap . fmap)
-          (\(Types.Base64X509 cert) -> cert) (headerOptional "x5c" hp hu))
+          (\(Types.Base64X509 cert) -> cert) (headerOptionalNonEmpty "x5c" hp hu))
     <*> headerOptional "x5t" hp hu
     <*> headerOptional "x5t#S256" hp hu
     <*> headerOptional "typ" hp hu
     <*> headerOptional "cty" hp hu
-    <*> (headerOptionalProtected "crit" hp hu
+    <*> (headerOptionalProtectedNonEmpty "crit" hp hu
       >>= parseCrit critInvalidNames (extensions proxy)
         (fromMaybe mempty hp <> fromMaybe mempty hu))
-  params (JWEHeader alg enc zip' jku jwk kid x5u x5c x5t x5tS256 typ cty crit) =
+  params (JWEHeader _ enc zip' jku_ jwk_ kid_ x5u_ x5c_ x5t_ x5tS256_ typ_ cty_ crit_) =
     catMaybes
       [ undefined -- TODO
       , Just (view isProtected enc,      "enc" .= view param enc)
       , fmap (\p -> (True, "zip" .= p)) zip'
-      , fmap (\p -> (view isProtected p, "jku" .= view param p)) jku
-      , 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" .= 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
-      , fmap (\p -> (view isProtected p, "cty" .= view param p)) cty
-      , fmap (\p -> (True, "crit" .= p)) crit
+      , fmap (\p -> (view isProtected p, "jku" `kvURI` view param p)) jku_
+      , 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" `kvURI` view param p)) x5u_
+      , fmap (\p -> (view isProtected p, "x5c" `kvNonEmpty` 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_
+      , fmap (\p -> (view isProtected p, "cty" .= view param p)) cty_
+      , fmap (\p -> (True, "crit" `kvNonEmpty` p)) crit_
       ]
 
 
@@ -180,10 +182,10 @@ wrap
   -> KeyMaterial
   -> B.ByteString  -- ^ message (key to wrap)
   -> m (Either Error (AlgWithParams, B.ByteString))
-wrap alg@RSA_OAEP (RSAKeyMaterial k) m = bimap RSAError (alg,) <$>
+wrap alg_@RSA_OAEP (RSAKeyMaterial k) m = bimap RSAError (alg_,) <$>
   OAEP.encrypt (OAEP.OAEPParams SHA1 (mgf1 SHA1) Nothing) (rsaPublicKey k) m
 wrap RSA_OAEP _ _ = return $ Left $ AlgorithmMismatch "Cannot use RSA_OAEP with non-RSA key"
-wrap alg@RSA_OAEP_256 (RSAKeyMaterial k) m = bimap RSAError (alg,) <$>
+wrap alg_@RSA_OAEP_256 (RSAKeyMaterial k) m = bimap RSAError (alg_,) <$>
   OAEP.encrypt (OAEP.OAEPParams SHA256 (mgf1 SHA256) Nothing) (rsaPublicKey k) m
 wrap RSA_OAEP_256 _ _ = return $ Left $ AlgorithmMismatch "Cannot use RSA_OAEP_256 with non-RSA key"
 wrap A128KW (OctKeyMaterial (OctKeyParameters (Types.Base64Octets k))) m
diff --git a/src/Crypto/JOSE/JWK.hs b/src/Crypto/JOSE/JWK.hs
index c2da143..d2d044d 100644
--- a/src/Crypto/JOSE/JWK.hs
+++ b/src/Crypto/JOSE/JWK.hs
@@ -120,7 +120,8 @@ 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
-
+import Crypto.JOSE.Types.WrappedNonEmpty(parseNonEmpty, kvNonEmpty)
+import Crypto.JOSE.Types.WrappedURI(parseURI, kvURI)
 
 -- | RFC 7517 §4.4.  "alg" (Algorithm) Parameter
 --
@@ -200,8 +201,8 @@ instance FromJSON JWK where
     <*> o .:? "key_ops"
     <*> o .:? "alg"
     <*> o .:? "kid"
-    <*> o .:? "x5u"
-    <*> ((fmap . fmap) (\(Types.Base64X509 cert) -> cert) <$> o .:? "x5c")
+    <*> o `parseURI` "x5u"
+    <*> ((fmap . fmap) (\(Types.Base64X509 cert) -> cert) <$> (o `parseNonEmpty` "x5c"))
     <*> o .:? "x5t"
     <*> o .:? "x5t#S256"
     ) >=> checkKey
@@ -217,8 +218,8 @@ instance ToJSON JWK where
     , fmap ("use" .=) _jwkUse
     , fmap ("key_ops" .=) _jwkKeyOps
     , fmap ("kid" .=) _jwkKid
-    , fmap ("x5u" .=) _jwkX5u
-    , fmap (("x5c" .=) . fmap Types.Base64X509) _jwkX5cRaw
+    , fmap ("x5u" `kvURI`) _jwkX5u
+    , fmap (("x5c" `kvNonEmpty`) . fmap Types.Base64X509) _jwkX5cRaw
     , fmap ("x5t" .=) _jwkX5t
     , fmap ("x5t#S256" .=) _jwkX5tS256
     ]
diff --git a/src/Crypto/JOSE/JWS.hs b/src/Crypto/JOSE/JWS.hs
index 05bd42b..97b9b19 100644
--- a/src/Crypto/JOSE/JWS.hs
+++ b/src/Crypto/JOSE/JWS.hs
@@ -34,10 +34,8 @@ doJwsVerify jwk jws = runExceptT $ 'verifyJWS'' jwk jws
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE MonoLocalBinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE DefaultSignatures #-}
 
 module Crypto.JOSE.JWS
   (
@@ -79,6 +77,19 @@ module Crypto.JOSE.JWS
   , HasJWSHeader(..)
   , JWSHeader
 
+  -- * Header fields shared by JWS and JWE
+  , HasAlg(..)
+  , HasJku(..)
+  , HasJwk(..)
+  , HasKid(..)
+  , HasX5u(..)
+  , HasX5c(..)
+  , HasX5t(..)
+  , HasX5tS256(..)
+  , HasTyp(..)
+  , HasCty(..)
+  , HasCrit(..)
+
   , module Crypto.JOSE.Error
   , module Crypto.JOSE.Header
   , module Crypto.JOSE.JWK
@@ -89,7 +100,6 @@ import Data.Foldable (toList)
 import Data.Maybe (catMaybes, fromMaybe)
 import Data.Monoid ((<>))
 import Data.List.NonEmpty (NonEmpty)
-import Data.Traversable (traverse)
 import Data.Word (Word8)
 
 import Control.Lens hiding ((.=))
@@ -111,6 +121,14 @@ import Crypto.JOSE.JWK.Store
 import Crypto.JOSE.Header
 import qualified Crypto.JOSE.Types as Types
 import qualified Crypto.JOSE.Types.Internal as Types
+import Crypto.JOSE.Types.WrappedNonEmpty(kvNonEmpty)
+import Crypto.JOSE.Types.WrappedURI(kvURI)
+import Text.URI(URI)
+import Data.Text(Text)
+import Data.X509(SignedCertificate)
+import Crypto.JOSE.Types(Base64SHA1)
+import Crypto.JOSE.Types(Base64SHA256)
+import Data.Functor.Classes(Eq1(liftEq), eq1, Show1(liftShowsPrec), showsPrec1)
 
 {- $extending
 
@@ -191,46 +209,166 @@ data JWSHeader p = JWSHeader
   }
   deriving (Eq, Show)
 
-class HasJWSHeader a where
+instance Eq1 JWSHeader where
+  liftEq f (JWSHeader a1 k1 w1 i1 u1 c1 t1 s1 p1 y1 r1) (JWSHeader a2 k2 w2 i2 u2 c2 t2 s2 p2 y2 r2) =
+    let eqHeaderParam (HeaderParam p1' a1') (HeaderParam p2' a2') =
+          (p1' `f` p2') && a1' == a2'
+        eqMaybeHeaderParam a1' a2' =
+          all (\x1' -> all (\x2' -> x1' `eqHeaderParam` x2') a2') a1'
+    in  and 
+          [
+            a1 `eqHeaderParam` a2
+          , k1 `eqMaybeHeaderParam` k2
+          , w1 `eqMaybeHeaderParam` w2
+          , i1 `eqMaybeHeaderParam` i2
+          , u1 `eqMaybeHeaderParam` u2
+          , c1 `eqMaybeHeaderParam` c2
+          , t1 `eqMaybeHeaderParam` t2
+          , s1 `eqMaybeHeaderParam` s2
+          , p1 `eqMaybeHeaderParam` p2
+          , y1 `eqMaybeHeaderParam` y2
+          , r1 == r2
+          ]
+
+instance Show1 JWSHeader where
+  liftShowsPrec f _ n (JWSHeader a k w i u c t s p y r) = 
+    let showHeaderParam (HeaderParam p' a') =
+          showParen True (showString "HeaderParam " . f n p' . showString " " . shows a')
+        showMaybeHeaderParam Nothing =
+          showString "Nothing"
+        showMaybeHeaderParam (Just hp) =
+          showString "Just " . showHeaderParam hp
+    in  showString "JWSHeader " .
+        showHeaderParam a .
+        showMaybeHeaderParam k .
+        showMaybeHeaderParam w .
+        showMaybeHeaderParam i .
+        showMaybeHeaderParam u .
+        showMaybeHeaderParam c .
+        showMaybeHeaderParam t .
+        showMaybeHeaderParam s .
+        showMaybeHeaderParam p .
+        showMaybeHeaderParam y .
+        shows r
+
+class HasAlg a where
+  alg :: Lens' (a p) (HeaderParam p Alg)
+  default alg :: HasJWSHeader a => Lens' (a p) (HeaderParam p Alg)
+  alg = jwsHeader . alg
+
+class HasJku a where
+  jku :: Lens' (a p) (Maybe (HeaderParam p URI))
+  default jku :: HasJWSHeader a => Lens' (a p) (Maybe (HeaderParam p URI))
+  jku = jwsHeader . jku
+
+class HasJwk a where
+  jwk :: Lens' (a p) (Maybe (HeaderParam p JWK))  
+  default jwk :: HasJWSHeader a => Lens' (a p) (Maybe (HeaderParam p JWK))
+  jwk = jwsHeader . jwk
+
+class HasKid a where
+  kid :: Lens' (a p) (Maybe (HeaderParam p Text))
+  default kid :: HasJWSHeader a => Lens' (a p) (Maybe (HeaderParam p Text))
+  kid = jwsHeader . kid
+
+class HasX5u a where
+  x5u :: Lens' (a p) (Maybe (HeaderParam p URI))
+  default x5u :: HasJWSHeader a => Lens' (a p) (Maybe (HeaderParam p URI))
+  x5u = jwsHeader . x5u
+
+class HasX5c a where
+  x5c :: Lens' (a p) (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
+  default x5c :: HasJWSHeader a => Lens' (a p) (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
+  x5c = jwsHeader . x5c
+
+class HasX5t a where
+  x5t :: Lens' (a p) (Maybe (HeaderParam p Base64SHA1))
+  default x5t :: HasJWSHeader a => Lens' (a p) (Maybe (HeaderParam p Base64SHA1))
+  x5t = jwsHeader . x5t
+
+class HasX5tS256 a where
+  x5tS256 :: Lens' (a p) (Maybe (HeaderParam p Base64SHA256))
+  default x5tS256 :: HasJWSHeader a => Lens' (a p) (Maybe (HeaderParam p Base64SHA256))
+  x5tS256 = jwsHeader . x5tS256
+
+class HasTyp a where
+  typ :: Lens' (a p) (Maybe (HeaderParam p Text))
+  default typ :: HasJWSHeader a => Lens' (a p) (Maybe (HeaderParam p Text))
+  typ = jwsHeader . typ
+
+class HasCty a where
+  cty :: Lens' (a p) (Maybe (HeaderParam p Text))
+  default cty :: HasJWSHeader a => Lens' (a p) (Maybe (HeaderParam p Text))
+  cty = jwsHeader . cty
+
+class HasCrit a where
+  crit :: Lens' (a p) (Maybe (NonEmpty Text))
+  default crit :: HasJWSHeader a => Lens' (a p) (Maybe (NonEmpty Text))
+  crit = jwsHeader . crit
+
+class
+  (
+    HasAlg a
+  , HasJku a
+  , HasJwk a
+  , HasKid a
+  , HasX5u a
+  , HasX5c a
+  , HasX5t a
+  , HasX5tS256 a
+  , HasTyp a
+  , HasCty a
+  , HasCrit a
+  ) =>
+  HasJWSHeader a where
   jwsHeader :: Lens' (a p) (JWSHeader p)
-
-instance HasJWSHeader JWSHeader where
-  jwsHeader = id
-
-instance HasJWSHeader a => HasAlg a where
-  alg = jwsHeader . \f h@(JWSHeader { _jwsHeaderAlg = a }) ->
+  
+instance HasAlg JWSHeader where
+  alg f h@(JWSHeader { _jwsHeaderAlg = a }) =
     fmap (\a' -> h { _jwsHeaderAlg = a' }) (f a)
-instance HasJWSHeader a => HasJku a where
+
+instance HasJku JWSHeader where
   jku = jwsHeader . \f h@(JWSHeader { _jwsHeaderJku = a }) ->
     fmap (\a' -> h { _jwsHeaderJku = a' }) (f a)
-instance HasJWSHeader a => HasJwk a where
+
+instance HasJwk JWSHeader where
   jwk = jwsHeader . \f h@(JWSHeader { _jwsHeaderJwk = a }) ->
     fmap (\a' -> h { _jwsHeaderJwk = a' }) (f a)
-instance HasJWSHeader a => HasKid a where
+
+instance HasKid JWSHeader where
   kid = jwsHeader . \f h@(JWSHeader { _jwsHeaderKid = a }) ->
     fmap (\a' -> h { _jwsHeaderKid = a' }) (f a)
-instance HasJWSHeader a => HasX5u a where
+
+instance HasX5u JWSHeader where
   x5u = jwsHeader . \f h@(JWSHeader { _jwsHeaderX5u = a }) ->
     fmap (\a' -> h { _jwsHeaderX5u = a' }) (f a)
-instance HasJWSHeader a => HasX5c a where
+
+instance HasX5c JWSHeader where
   x5c = jwsHeader . \f h@(JWSHeader { _jwsHeaderX5c = a }) ->
     fmap (\a' -> h { _jwsHeaderX5c = a' }) (f a)
-instance HasJWSHeader a => HasX5t a where
+
+instance HasX5t JWSHeader where
   x5t = jwsHeader . \f h@(JWSHeader { _jwsHeaderX5t = a }) ->
     fmap (\a' -> h { _jwsHeaderX5t = a' }) (f a)
-instance HasJWSHeader a => HasX5tS256 a where
+
+instance HasX5tS256 JWSHeader where
   x5tS256 = jwsHeader . \f h@(JWSHeader { _jwsHeaderX5tS256 = a }) ->
     fmap (\a' -> h { _jwsHeaderX5tS256 = a' }) (f a)
-instance HasJWSHeader a => HasTyp a where
+
+instance HasTyp JWSHeader where
   typ = jwsHeader . \f h@(JWSHeader { _jwsHeaderTyp = a }) ->
     fmap (\a' -> h { _jwsHeaderTyp = a' }) (f a)
-instance HasJWSHeader a => HasCty a where
+
+instance HasCty JWSHeader where
   cty = jwsHeader . \f h@(JWSHeader { _jwsHeaderCty = a }) ->
     fmap (\a' -> h { _jwsHeaderCty = a' }) (f a)
-instance HasJWSHeader a => HasCrit a where
+
+instance HasCrit JWSHeader where
   crit = jwsHeader . \f h@(JWSHeader { _jwsHeaderCrit = a }) ->
     fmap (\a' -> h { _jwsHeaderCrit = a' }) (f a)
 
+instance HasJWSHeader JWSHeader where
+  jwsHeader = id
 
 -- | Construct a minimal header with the given algorithm and
 -- protection indicator for the /alg/ header.
@@ -282,7 +420,6 @@ data Signature p a = Signature
   (Maybe T.Text)      -- Encoded protected header, if available
   (a p)               -- Header
   Types.Base64Octets  -- Signature
-  deriving (Show)
 
 -- | Getter for header of a signature
 header :: Getter (Signature p a) (a p)
@@ -292,8 +429,12 @@ header = to (\(Signature _ h _) -> h)
 signature :: (Cons s s Word8 Word8, AsEmpty s) => Getter (Signature p a) s
 signature = to (\(Signature _ _ (Types.Base64Octets s)) -> s) . recons
 
-instance (Eq (a p)) => Eq (Signature p a) where
-  Signature _ h s == Signature _ h' s' = h == h' && s == s'
+instance (Eq1 a, Eq p) => Eq (Signature p a) where
+  Signature _ h s == Signature _ h' s' = (h `eq1` h') && s == s'
+
+instance (Show1 a, Show p) => Show (Signature p a) where
+  showsPrec n (Signature t h s) =
+    showString "Signature " . showParen True (showsPrec n t . showString ", " . showsPrec1 n h . showString ", " . showsPrec n s)
 
 instance (HasParams a, ProtectionIndicator p) => FromJSON (Signature p a) where
   parseJSON = withObject "signature" (\o -> Signature
@@ -328,32 +469,32 @@ instance (HasParams a, ProtectionIndicator p) => ToJSON (Signature p a) where
 instance HasParams JWSHeader where
   parseParamsFor proxy hp hu = JWSHeader
     <$> headerRequired "alg" hp hu
-    <*> headerOptional "jku" hp hu
+    <*> headerOptionalURI "jku" hp hu
     <*> headerOptional "jwk" hp hu
     <*> headerOptional "kid" hp hu
-    <*> headerOptional "x5u" hp hu
+    <*> headerOptionalURI "x5u" hp hu
     <*> ((fmap . fmap . fmap . fmap)
-          (\(Types.Base64X509 cert) -> cert) (headerOptional "x5c" hp hu))
+          (\(Types.Base64X509 cert) -> cert) (headerOptionalNonEmpty "x5c" hp hu))
     <*> headerOptional "x5t" hp hu
     <*> headerOptional "x5t#S256" hp hu
     <*> headerOptional "typ" hp hu
     <*> headerOptional "cty" hp hu
-    <*> (headerOptionalProtected "crit" hp hu
+    <*> (headerOptionalProtectedNonEmpty "crit" hp hu
       >>= parseCrit jwsCritInvalidNames (extensions proxy)
         (fromMaybe mempty hp <> fromMaybe mempty hu))
   params h =
     catMaybes
       [ Just (view (alg . isProtected) h, "alg" .= (view (alg . param) h))
-      , fmap (\p -> (view isProtected p, "jku" .= view param p)) (view jku h)
+      , fmap (\p -> (view isProtected p, "jku" `kvURI` view param p)) (view jku h)
       , 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" .= fmap Types.Base64X509 (view param p))) (view x5c h)
+      , fmap (\p -> (view isProtected p, "x5u" `kvURI` view param p)) (view x5u h)
+      , fmap (\p -> (view isProtected p, "x5c" `kvNonEmpty` 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)
       , fmap (\p -> (view isProtected p, "cty" .= view param p)) (view cty h)
-      , fmap (\p -> (True, "crit" .= p)) (view crit h)
+      , fmap (\p -> (True, "crit" `kvNonEmpty` p)) (view crit h)
       ]
 
 
@@ -397,11 +538,13 @@ type FlattenedJWS = JWS Identity Protection
 --
 type CompactJWS = JWS Identity ()
 
-instance (Eq (t (Signature p a))) => Eq (JWS t p a) where
-  JWS p sigs == JWS p' sigs' = p == p' && sigs == sigs'
+instance (Eq1 t, Eq1 a, Eq p) => Eq (JWS t p a) where
+  JWS p sigs == JWS p' sigs' =
+    p == p' && (sigs `eq1` sigs')
 
-instance (Show (t (Signature p a))) => Show (JWS t p a) where
-  show (JWS p sigs) = "JWS " <> show p <> " " <> show sigs
+instance (Show1 t, Show1 a, Show p) => Show (JWS t p a) where
+  showsPrec n (JWS p sigs) = 
+    showString "JWS " . showsPrec n p . showString " " . showsPrec1 n sigs
 
 signatures :: Foldable t => Fold (JWS t p a) (Signature p a)
 signatures = folding (\(JWS _ sigs) -> sigs)
@@ -470,7 +613,7 @@ instance HasParams a => FromCompact (JWS Identity () a) where
 --
 signJWS
   :: ( Cons s s Word8 Word8
-     , HasJWSHeader a, HasParams a, MonadRandom m, AsError e, MonadError e m
+     , HasAlg a, HasParams a, MonadRandom m, AsError e, MonadError e m
      , Traversable t
      , ProtectionIndicator p
      )
@@ -482,7 +625,7 @@ signJWS s =
   in fmap (JWS (Types.Base64Octets s')) . traverse (uncurry (mkSignature s'))
 
 mkSignature
-  :: ( HasJWSHeader a, HasParams a, MonadRandom m, AsError e, MonadError e m
+  :: ( HasAlg a, HasParams a, MonadRandom m, AsError e, MonadError e m
      , ProtectionIndicator p
      )
   => B.ByteString -> a p -> JWK -> m (Signature p a)
@@ -510,31 +653,35 @@ data ValidationSettings = ValidationSettings
   (S.Set Alg)
   ValidationPolicy
 
-class HasValidationSettings a where
+class (HasValidationPolicy a, HasAlgorithms a) => HasValidationSettings a where
   validationSettings :: Lens' a ValidationSettings
 
-  validationSettingsAlgorithms :: Lens' a (S.Set Alg)
-  validationSettingsAlgorithms = validationSettings . go where
-    go f (ValidationSettings algs pol) =
-      (\algs' -> ValidationSettings algs' pol) <$> f algs
-
-  validationSettingsValidationPolicy :: Lens' a ValidationPolicy
-  validationSettingsValidationPolicy = validationSettings . go where
-    go f (ValidationSettings algs pol) =
-      (\pol' -> ValidationSettings algs pol') <$> f pol
-
 instance HasValidationSettings ValidationSettings where
   validationSettings = id
-
+  
 class HasAlgorithms s where
   algorithms :: Lens' s (S.Set Alg)
+  default algorithms :: HasValidationSettings s => Lens' s (S.Set Alg)
+  algorithms = validationSettings . algorithms
+
+instance HasAlgorithms (S.Set Alg) where
+  algorithms = id
+
+instance HasAlgorithms ValidationSettings where
+  algorithms f (ValidationSettings a p) =
+    fmap (\a' -> ValidationSettings a' p) (f a)
+
 class HasValidationPolicy s where
   validationPolicy :: Lens' s ValidationPolicy
+  default validationPolicy :: HasValidationSettings s => Lens' s ValidationPolicy
+  validationPolicy = validationSettings . validationPolicy
+
+instance HasValidationPolicy ValidationPolicy where
+  validationPolicy = id
 
-instance HasValidationSettings a => HasAlgorithms a where
-  algorithms = validationSettingsAlgorithms
-instance HasValidationSettings a => HasValidationPolicy a where
-  validationPolicy = validationSettingsValidationPolicy
+instance HasValidationPolicy ValidationSettings where
+  validationPolicy f (ValidationSettings a p) =
+    fmap (\p' -> ValidationSettings a p') (f p)
 
 -- | The default validation settings.
 --
@@ -557,7 +704,7 @@ defaultValidationSettings = ValidationSettings
 -- See also 'defaultValidationSettings'.
 --
 verifyJWS'
-  ::  ( AsError e, MonadError e m , HasJWSHeader h, HasParams h
+  ::  ( AsError e, MonadError e m , HasAlg h, HasParams h
       , VerificationKeyStore m (h p) s k
       , Cons s s Word8 Word8, AsEmpty s
       , Foldable t
@@ -579,8 +726,8 @@ verifyJWS' = verifyJWS defaultValidationSettings
 -- Returns the payload if successfully verified.
 --
 verifyJWS
-  ::  ( HasAlgorithms a, HasValidationPolicy a, AsError e, MonadError e m
-      , HasJWSHeader h, HasParams h
+  ::  ( HasValidationSettings a, AsError e, MonadError e m
+      , HasAlg h, HasParams h
       , VerificationKeyStore m (h p) s k
       , Cons s s Word8 Word8, AsEmpty s
       , Foldable t
@@ -593,8 +740,8 @@ verifyJWS
 verifyJWS = verifyJWSWithPayload pure
 
 verifyJWSWithPayload
-  ::  ( HasAlgorithms a, HasValidationPolicy a, AsError e, MonadError e m
-      , HasJWSHeader h, HasParams h
+  ::  ( HasValidationSettings a, AsError e, MonadError e m
+      , HasAlg h, HasParams h
       , VerificationKeyStore m (h p) payload k
       , Cons s s Word8 Word8, AsEmpty s
       , Foldable t
@@ -628,7 +775,7 @@ verifyJWSWithPayload dec conf k (JWS p@(Types.Base64Octets p') sigs) =
     payload <$ applyPolicy policy results
 
 verifySig
-  :: (HasJWSHeader a, HasParams a, ProtectionIndicator p)
+  :: (HasAlg a, HasParams a, ProtectionIndicator p)
   => Types.Base64Octets
   -> Signature p a
   -> JWK
diff --git a/src/Crypto/JOSE/Types.hs b/src/Crypto/JOSE/Types.hs
index 334435f..c272f85 100644
--- a/src/Crypto/JOSE/Types.hs
+++ b/src/Crypto/JOSE/Types.hs
@@ -43,14 +43,12 @@ import Data.Aeson
 import Data.Aeson.Types (Parser)
 import qualified Data.ByteString as B
 import Data.X509
-import Network.URI (URI)
+import Text.URI (URI)
 import Test.QuickCheck
 import Test.QuickCheck.Instances ()
 
 import Crypto.Number.Basic (log2)
 import Crypto.JOSE.Types.Internal
-import Crypto.JOSE.Types.Orphans ()
-
 
 -- | A base64url encoded octet sequence interpreted as an integer.
 --
diff --git a/src/Crypto/JOSE/Types/Internal.hs b/src/Crypto/JOSE/Types/Internal.hs
index bc9d2ff..c2defbd 100644
--- a/src/Crypto/JOSE/Types/Internal.hs
+++ b/src/Crypto/JOSE/Types/Internal.hs
@@ -35,6 +35,11 @@ module Crypto.JOSE.Types.Internal
   , intBytes
   , sizedIntegerToBS
   , base64url
+  , viewMaybe
+  , previewEqual
+  , gettingGen
+  , genMaybe
+  , gettingGenMaybe
   ) where
 
 import Data.Bifunctor (first)
@@ -43,7 +48,7 @@ import Data.Monoid ((<>))
 import Data.Tuple (swap)
 import Data.Word (Word8)
 
-import Control.Lens
+import Control.Lens(Snoc, snoc, unsnoc, AsEmpty, Cons, Prism', Getting, AReview, iso, prism, view, preview, review)
 import Control.Lens.Cons.Extras
 import Crypto.Number.Basic (log2)
 import Data.Aeson.Types
@@ -52,8 +57,10 @@ import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Base64.URL as B64U
 import qualified Data.HashMap.Strict as M
+import Data.Text(Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
+import Test.QuickCheck(Arbitrary(arbitrary), Gen, frequency)
 
 -- | Convert a JSON object into a list of pairs or the empty list
 -- if the JSON value is not an object.
@@ -181,3 +188,18 @@ sizedIntegerToBS w = zeroPad . integerToBS
 
 intBytes :: Integer -> Int
 intBytes n = (log2 n `div` 8) + 1
+
+viewMaybe :: FromJSON a => Getting b a b -> Object -> Text -> Parser (Maybe b)
+viewMaybe k o t = fmap (fmap (view k)) (o .:? t)
+
+previewEqual :: (ToJSON v, KeyValue kv) => AReview v a -> Text -> a -> kv
+previewEqual k t v = t .= review k v
+
+gettingGen :: Arbitrary s => Getting a s a -> Gen a
+gettingGen k = fmap (view k) arbitrary
+
+genMaybe :: Gen a -> Gen (Maybe a)
+genMaybe g = frequency [(1, return Nothing), (3, fmap Just g)]
+
+gettingGenMaybe :: Arbitrary s => Getting a s a -> Gen (Maybe a)
+gettingGenMaybe k = genMaybe (fmap (view k) arbitrary)
diff --git a/src/Crypto/JOSE/Types/Orphans.hs b/src/Crypto/JOSE/Types/Orphans.hs
deleted file mode 100644
index 4864b4d..0000000
--- a/src/Crypto/JOSE/Types/Orphans.hs
+++ /dev/null
@@ -1,55 +0,0 @@
--- Copyright (C) 2014, 2015, 2016  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 CPP #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Crypto.JOSE.Types.Orphans where
-
-import Data.List.NonEmpty (NonEmpty(..))
-import qualified Data.Text as T
-import Network.URI (URI, parseURI)
-import Test.QuickCheck
-
-#if ! MIN_VERSION_aeson(0,11,1)
-import Data.Foldable (toList)
-import qualified Data.Vector as V
-#endif
-
-import Data.Aeson
-
-
-#if ! MIN_VERSION_aeson(0,11,1)
-instance FromJSON a => FromJSON (NonEmpty a) where
-  parseJSON = withArray "NonEmpty [a]" $ \v -> case toList v of
-    [] -> fail "Non-empty list required"
-    (x:xs) -> mapM parseJSON (x :| xs)
-
-instance ToJSON a => ToJSON (NonEmpty a) where
-  toJSON = Array . V.fromList . map toJSON . toList
-#endif
-
-
-instance FromJSON URI where
-  parseJSON = withText "URI" $
-    maybe (fail "not a URI") return . parseURI . T.unpack
-
-instance ToJSON URI where
-  toJSON = String . T.pack . show
-
-
-#if ! MIN_VERSION_QuickCheck(2,9,0)
-instance Arbitrary a => Arbitrary (NonEmpty a) where
-  arbitrary = (:|) <$> arbitrary <*> arbitrary
-#endif
diff --git a/src/Crypto/JOSE/Types/WrappedNonEmpty.hs b/src/Crypto/JOSE/Types/WrappedNonEmpty.hs
new file mode 100644
index 0000000..55587de
--- /dev/null
+++ b/src/Crypto/JOSE/Types/WrappedNonEmpty.hs
@@ -0,0 +1,88 @@
+-- Copyright (C) 2014, 2015, 2016  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 DeriveTraversable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Crypto.JOSE.Types.WrappedNonEmpty where
+
+import Data.List.NonEmpty (NonEmpty(..))
+import Test.QuickCheck(Arbitrary(arbitrary), Gen)
+import Data.Foldable (toList)
+import qualified Data.Vector as V(fromList)
+
+import Control.Lens(Rewrapped, Wrapped(_Wrapped', Unwrapped), _Wrapped, Getting, AReview, iso, view)
+import Data.Aeson
+import Data.Aeson.Types
+import Data.Text(Text)
+import Crypto.JOSE.Types.Internal
+import qualified Waargonaut.Encode as Encoder(nonempty)
+import Waargonaut.Encode(Encoder)
+import qualified Waargonaut.Decode as Decoder(nonempty)
+import Waargonaut.Decode(Decoder)
+import Data.Functor.Contravariant(contramap)
+
+newtype WrappedNonEmpty a =
+  WrappedNonEmpty (NonEmpty a)
+  deriving (Eq, Ord, Show, Functor, Foldable, Traversable)
+
+instance WrappedNonEmpty a ~ x => Rewrapped (WrappedNonEmpty a) x
+
+instance Wrapped (WrappedNonEmpty a) where
+  type Unwrapped (WrappedNonEmpty a) =
+    NonEmpty a
+  _Wrapped' =
+    iso
+      (\(WrappedNonEmpty x) -> x)
+      WrappedNonEmpty
+
+instance FromJSON a => FromJSON (WrappedNonEmpty a) where
+  parseJSON =
+    withArray "WrappedNonEmpty [a]" $ \v -> case toList v of
+      [] -> fail "Wrapped Non-empty list required"
+      (x:xs) -> mapM parseJSON (WrappedNonEmpty (x :| xs))
+
+instance ToJSON a => ToJSON (WrappedNonEmpty a) where
+  toJSON = Array . V.fromList . map toJSON . toList
+
+instance Arbitrary a => Arbitrary (WrappedNonEmpty a) where
+  arbitrary = (\h t -> WrappedNonEmpty (h :| t)) <$> arbitrary <*> arbitrary
+
+encodeWrappedNonEmpty ::
+  Applicative f =>
+  Encoder f a
+  -> Encoder f (WrappedNonEmpty a)
+encodeWrappedNonEmpty =
+  contramap (view _Wrapped) . Encoder.nonempty
+
+decodeWrappedNonEmpty ::
+  Monad f =>
+  Decoder f a
+  -> Decoder f (WrappedNonEmpty a)
+decodeWrappedNonEmpty =
+  fmap WrappedNonEmpty . Decoder.nonempty
+  
+kvNonEmpty :: (ToJSON a, KeyValue kv) => Text -> NonEmpty a -> kv
+kvNonEmpty = previewEqual (_Wrapped :: AReview (WrappedNonEmpty a) (NonEmpty a))
+
+parseNonEmpty :: FromJSON a => Object -> Text -> Parser (Maybe (NonEmpty a))
+parseNonEmpty = viewMaybe (_Wrapped :: Getting (NonEmpty a) (WrappedNonEmpty a) (NonEmpty a))
+
+gettingGenNonEmpty :: Arbitrary a => Gen (NonEmpty a)
+gettingGenNonEmpty = gettingGen (_Wrapped :: Getting (NonEmpty a) (WrappedNonEmpty a) (NonEmpty a))
+
+gettingGenMaybeNonEmpty :: Arbitrary a => Gen (Maybe (NonEmpty a))
+gettingGenMaybeNonEmpty = genMaybe gettingGenNonEmpty
diff --git a/src/Crypto/JOSE/Types/WrappedURI.hs b/src/Crypto/JOSE/Types/WrappedURI.hs
new file mode 100644
index 0000000..d4671cc
--- /dev/null
+++ b/src/Crypto/JOSE/Types/WrappedURI.hs
@@ -0,0 +1,106 @@
+-- Copyright (C) 2014, 2015, 2016  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 FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Crypto.JOSE.Types.WrappedURI where
+  
+import Control.Lens(Rewrapped, Wrapped(_Wrapped', Unwrapped), _Wrapped, Getting, AReview, iso, view)
+import Control.Monad.Error.Lens(throwing)
+import Data.Aeson
+import Data.Aeson.Types
+import Data.Text(Text)
+import Crypto.JOSE.Types.Internal
+import Control.Monad.Catch(MonadThrow)
+import qualified Waargonaut.Encode as Encoder(text)
+import Waargonaut.Encode(Encoder)
+import qualified Waargonaut.Decode as Decoder(text)
+import Waargonaut.Decode(Decoder)
+import Waargonaut.Decode.Error(_ConversionFailure)
+import Data.Functor.Contravariant(contramap)
+import Text.URI (URI, mkURI, render)
+
+newtype WrappedURI =
+  WrappedURI URI
+  deriving (Eq, Ord, Show)
+
+instance WrappedURI ~ x => Rewrapped WrappedURI x
+
+instance Wrapped WrappedURI where
+  type Unwrapped WrappedURI =
+    URI
+  _Wrapped' =
+    iso
+      (\(WrappedURI x) -> x)
+      WrappedURI
+
+instance FromJSON WrappedURI where
+  parseJSON = withText "URI" $
+    maybe (fail "not a URI") return . mkURI'
+
+instance ToJSON WrappedURI where
+  toJSON = String . render'
+
+encodeURI ::
+  Applicative f =>
+  Encoder f URI
+encodeURI =
+  contramap render Encoder.text
+
+encodeWrappedURI ::
+  Applicative f =>
+  Encoder f WrappedURI
+encodeWrappedURI =
+  contramap render' Encoder.text
+
+decodeURI ::
+  Monad f =>
+  Decoder f URI
+decodeURI =
+  Decoder.text >>= \a -> case mkURI a of
+    Nothing ->
+      throwing _ConversionFailure a
+    Just u ->
+      pure u
+
+decodeWrappedURI ::
+  Monad f =>
+  Decoder f WrappedURI
+decodeWrappedURI =
+  Decoder.text >>= \a -> case mkURI' a of
+    Nothing ->
+      throwing _ConversionFailure a
+    Just u ->
+      pure u
+
+mkURI' ::
+  MonadThrow f =>
+  Text
+  -> f WrappedURI
+mkURI' =
+  fmap WrappedURI . mkURI
+
+render' ::
+  WrappedURI
+  -> Text
+render' =
+  render . view _Wrapped
+
+kvURI :: KeyValue kv => Text -> URI -> kv
+kvURI = previewEqual (_Wrapped :: AReview WrappedURI URI)
+
+parseURI :: Object -> Text -> Parser (Maybe URI)
+parseURI = viewMaybe (_Wrapped :: Getting URI WrappedURI URI)
diff --git a/src/Crypto/JWT.hs b/src/Crypto/JWT.hs
index a94b3b2..c5c2219 100644
--- a/src/Crypto/JWT.hs
+++ b/src/Crypto/JWT.hs
@@ -17,9 +17,8 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE MonoLocalBinds #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE LambdaCase #-}
 
 {-|
 
@@ -108,6 +107,14 @@ module Crypto.JWT
   , uri
   , NumericDate(..)
 
+  -- * waargonaut encoder/decoder
+  , encodeStringOrURI
+  , decodeStringOrURI
+  , encodeNumericDate
+  , decodeNumericDate
+  , encodeAudience
+  , decodeAudience
+
   , module Crypto.JOSE
 
   ) where
@@ -124,7 +131,7 @@ import Data.Maybe
 import qualified Data.String
 
 import Control.Lens (
-  makeClassy, makeClassyPrisms, makePrisms,
+  makeClassyPrisms, makePrisms,
   Lens', _Just, over, preview, view,
   Prism', prism', Cons, iso, AsEmpty)
 import Control.Lens.Cons.Extras (recons)
@@ -136,11 +143,17 @@ import qualified Data.HashMap.Strict as M
 import qualified Data.Text as T
 import Data.Time (NominalDiffTime, UTCTime, addUTCTime)
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
-import Network.URI (parseURI)
-
+import Text.URI (mkURI)
 import Crypto.JOSE
 import Crypto.JOSE.Types
-
+import qualified Waargonaut.Encode as Encoder(text, either, scientific, list, encodeA, runEncoder)
+import Waargonaut.Encode(Encoder)
+import qualified Waargonaut.Decode as Decoder(text, scientific, list)
+import Waargonaut.Decode(Decoder)
+import Waargonaut.Decode.Error(_ConversionFailure)
+import Data.Functor.Contravariant(contramap)
+import Crypto.JOSE.Types.WrappedURI
+import Data.Functor.Alt((<!>))
 
 data JWTError
   = JWSError Error
@@ -181,18 +194,18 @@ stringOrUri = iso (view recons) (view recons) . prism' rev fwd
   rev (Arbitrary s) = s
   rev (OrURI x) = T.pack (show x)
   fwd s
-    | T.any (== ':') s = OrURI <$> parseURI (T.unpack s)
+    | T.any (== ':') s = OrURI <$> mkURI s
     | otherwise = pure (Arbitrary s)
 
 string :: Prism' StringOrURI T.Text
 string = prism' Arbitrary f where
   f (Arbitrary s) = Just s
-  f _ = Nothing
+  f (OrURI _) = Nothing
 
 uri :: Prism' StringOrURI URI
 uri = prism' OrURI f where
   f (OrURI s) = Just s
-  f _ = Nothing
+  f (Arbitrary _) = Nothing
 
 instance FromJSON StringOrURI where
   parseJSON = withText "StringOrURI"
@@ -202,6 +215,27 @@ instance ToJSON StringOrURI where
   toJSON (Arbitrary s)  = toJSON s
   toJSON (OrURI x)      = toJSON $ show x
 
+encodeStringOrURI ::
+  Applicative f =>
+  Encoder f StringOrURI
+encodeStringOrURI =
+  contramap (
+    \case
+      Arbitrary s ->
+        Left s
+      OrURI x ->
+        Right (WrappedURI x)
+  ) (Encoder.either Encoder.text encodeWrappedURI)
+
+decodeStringOrURI ::
+  Monad f =>
+  Decoder f StringOrURI
+decodeStringOrURI =
+  Decoder.text >>= \a -> case preview stringOrUri a of
+    Nothing ->
+      throwing _ConversionFailure a
+    Just u ->
+      pure u
 
 -- | A JSON numeric value representing the number of seconds from
 --   1970-01-01T0:0:0Z UTC until the specified UTC date\/time.
@@ -215,8 +249,19 @@ instance FromJSON NumericDate where
 
 instance ToJSON NumericDate where
   toJSON (NumericDate t)
-    = Number $ fromRational $ toRational $ utcTimeToPOSIXSeconds t
+    = Number . fromRational . toRational . utcTimeToPOSIXSeconds $ t
+
+encodeNumericDate ::
+  Applicative f =>
+  Encoder f NumericDate
+encodeNumericDate =
+  contramap (\(NumericDate x) -> fromRational . toRational . utcTimeToPOSIXSeconds $ x) Encoder.scientific
 
+decodeNumericDate ::
+  Monad f =>
+  Decoder f NumericDate
+decodeNumericDate =
+  fmap (NumericDate . posixSecondsToUTCTime . fromRational . toRational) Decoder.scientific
 
 -- | Audience data.  In the general case, the /aud/ value is an
 -- array of case-sensitive strings, each containing a 'StringOrURI'
@@ -237,6 +282,49 @@ instance ToJSON Audience where
   toJSON (Audience [aud]) = toJSON aud
   toJSON (Audience auds) = toJSON auds
 
+encodeAudience ::
+  Applicative f =>
+  Encoder f Audience
+encodeAudience =
+  Encoder.encodeA $ \case
+    Audience [x] ->
+      Encoder.runEncoder encodeStringOrURI x
+    Audience xs ->
+      Encoder.runEncoder (Encoder.list encodeStringOrURI) xs
+
+decodeAudience ::
+  Monad f =>
+  Decoder f Audience
+decodeAudience =
+  fmap Audience (fmap pure decodeStringOrURI <!> Decoder.list decodeStringOrURI)
+  
+{-
+
+instance FromJSON Audience where
+  parseJSON v = Audience <$> (parseJSON v <|> fmap (:[]) (parseJSON v))
+-}
+
+  -- a :: JCurs
+
+  -- fmap undefined (Decoder.runDecoder undefined undefined undefined)
+  -- fmap undefined (Decoder.either (Decoder.list decodeStringOrURI) decodeStringOrURI)
+
+{-
+
+
+encodeNumericDate ::
+  Applicative f =>
+  Encoder f NumericDate
+encodeNumericDate =
+  contramap (\(NumericDate x) -> fromRational . toRational . utcTimeToPOSIXSeconds $ x) Encoder.scientific
+
+decodeNumericDate ::
+  Monad f =>
+  Decoder f NumericDate
+decodeNumericDate =
+  fmap (NumericDate . posixSecondsToUTCTime . fromRational . toRational) Decoder.scientific
+
+-}
 
 -- | The JWT Claims Set represents a JSON object whose members are
 -- the registered claims defined by RFC 7519.  Unrecognised
@@ -368,35 +456,67 @@ data JWTValidationSettings = JWTValidationSettings
   , _jwtValidationSettingsAudiencePredicate :: StringOrURI -> Bool
   , _jwtValidationSettingsIssuerPredicate :: StringOrURI -> Bool
   }
-makeClassy ''JWTValidationSettings
 
-instance HasJWTValidationSettings a => HasValidationSettings a where
-  validationSettings = jwtValidationSettingsValidationSettings
+class (
+        HasValidationSettings a
+      , HasAllowedSkew a
+      , HasAudiencePredicate a
+      , HasIssuerPredicate a
+      , HasCheckIssuedAt a
+      ) =>
+  HasJWTValidationSettings a where
+  jwtValidationSettings :: Lens' a JWTValidationSettings
+
+instance HasJWTValidationSettings JWTValidationSettings where
+  jwtValidationSettings = id
+
+instance HasAlgorithms JWTValidationSettings where
+
+instance HasValidationPolicy JWTValidationSettings where
+
+instance HasValidationSettings JWTValidationSettings where
+  validationSettings f (JWTValidationSettings v s i a p) =
+    fmap (\v' -> JWTValidationSettings v' s i a p) (f v)
+
+instance HasAllowedSkew JWTValidationSettings where
+  allowedSkew f (JWTValidationSettings v s i a p) =
+    fmap (\s' -> JWTValidationSettings v s' i a p) (f s)
+
+instance HasAudiencePredicate JWTValidationSettings where
+  audiencePredicate f (JWTValidationSettings v s i a p) =
+    fmap (\a' -> JWTValidationSettings v s i a' p) (f a)
+
+instance HasIssuerPredicate JWTValidationSettings where
+  issuerPredicate f (JWTValidationSettings v s i a p) =
+    fmap (\p' -> JWTValidationSettings v s i a p') (f p)
+
+instance HasCheckIssuedAt JWTValidationSettings where
+  checkIssuedAt f (JWTValidationSettings v s i a p) =
+    fmap (\i' -> JWTValidationSettings v s i' a p) (f i)
 
 -- | Maximum allowed skew when validating the /nbf/, /exp/ and /iat/ claims.
 class HasAllowedSkew s where
   allowedSkew :: Lens' s NominalDiffTime
+  default allowedSkew :: HasJWTValidationSettings s => Lens' s NominalDiffTime
+  allowedSkew = jwtValidationSettings . allowedSkew
 
 -- | Predicate for checking values in the /aud/ claim.
 class HasAudiencePredicate s where
   audiencePredicate :: Lens' s (StringOrURI -> Bool)
+  default audiencePredicate :: HasJWTValidationSettings s => Lens' s (StringOrURI -> Bool)
+  audiencePredicate = jwtValidationSettings . audiencePredicate
 
 -- | Predicate for checking the /iss/ claim.
 class HasIssuerPredicate s where
   issuerPredicate :: Lens' s (StringOrURI -> Bool)
+  default issuerPredicate :: HasJWTValidationSettings s => Lens' s (StringOrURI -> Bool)
+  issuerPredicate = jwtValidationSettings . issuerPredicate
 
 -- | Whether to check that the /iat/ claim is not in the future.
 class HasCheckIssuedAt s where
   checkIssuedAt :: Lens' s Bool
-
-instance HasJWTValidationSettings a => HasAllowedSkew a where
-  allowedSkew = jwtValidationSettingsAllowedSkew
-instance HasJWTValidationSettings a => HasAudiencePredicate a where
-  audiencePredicate = jwtValidationSettingsAudiencePredicate
-instance HasJWTValidationSettings a => HasIssuerPredicate a where
-  issuerPredicate = jwtValidationSettingsIssuerPredicate
-instance HasJWTValidationSettings a => HasCheckIssuedAt a where
-  checkIssuedAt = jwtValidationSettingsCheckIssuedAt
+  default checkIssuedAt :: HasJWTValidationSettings s => Lens' s Bool
+  checkIssuedAt = jwtValidationSettings . checkIssuedAt
 
 -- | Acquire the default validation settings.
 --
diff --git a/test/AESKW.hs b/test/AESKW.hs
index c2962d3..ded9cfc 100644
--- a/test/AESKW.hs
+++ b/test/AESKW.hs
@@ -28,6 +28,7 @@ import Test.Tasty.QuickCheck
 import Crypto.JOSE.AESKW
 
 
+aeskwProperties :: TestTree
 aeskwProperties = testGroup "AESKW"
   [ testProperty "AESKW round-trip" prop_roundTrip
   ]
@@ -52,3 +53,4 @@ prop_roundTrip = monadicIO $ do
     16 -> assert $ check (cipherInit kek :: CryptoFailable AES128)
     24 -> assert $ check (cipherInit kek :: CryptoFailable AES192)
     32 -> assert $ check (cipherInit kek :: CryptoFailable AES256)
+    n  -> fail ("expecting length one of [16,24,32], was :" ++ show n)
diff --git a/test/JWK.hs b/test/JWK.hs
index 6b43245..1f633b4 100644
--- a/test/JWK.hs
+++ b/test/JWK.hs
@@ -22,7 +22,6 @@ import Data.Monoid ((<>))
 import Control.Lens (_Left, _Right, review, view)
 import Control.Lens.Extras (is)
 import Data.Aeson
-import qualified Data.ByteArray as BA
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import Test.Hspec
@@ -301,6 +300,7 @@ cfrgSpec = describe "RFC 8037 test vectors" $ do
       pk <- _A2_result
       pure $ view asPublicKey sk == Just pk
 
+rfc8037_A1_jwkJson :: L.ByteString
 rfc8037_A1_jwkJson = ""
   <> "{\"kty\":\"OKP\",\"crv\":\"Ed25519\","
   <> "\"d\":\"nWGxne_9WmC6hEr0kuwsxERJxWl7MmkZcDusAxyuf2A\","
diff --git a/test/JWS.hs b/test/JWS.hs
index 5d80dcb..63eb4e5 100644
--- a/test/JWS.hs
+++ b/test/JWS.hs
@@ -13,6 +13,9 @@
 -- limitations under the License.
 
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 module JWS where
 
@@ -25,7 +28,6 @@ import Control.Lens.Cons.Extras (recons)
 import Control.Monad.Except (runExceptT)
 import Data.Aeson
 import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Base64.URL as B64U
 import Test.Hspec
 
@@ -36,7 +38,11 @@ import Crypto.JOSE.JWK
 import Crypto.JOSE.JWS
 import qualified Crypto.JOSE.JWA.JWS as JWA.JWS
 import qualified Crypto.JOSE.Types as Types
+import Data.Functor.Classes
+import WrappedExceptT
 
+deriving instance Eq1 JWSHeader'
+deriving instance Show1 JWSHeader'
 
 drg :: ChaChaDRG
 drg = drgNewTest (1,2,3,4,5)
@@ -56,8 +62,21 @@ spec = do
 --
 newtype JWSHeader' p = JWSHeader' { unJWSHeader' :: JWSHeader p }
   deriving (Eq, Show)
+
 _JWSHeader' :: Iso' (JWSHeader' p) (JWSHeader p)
 _JWSHeader' = iso unJWSHeader' JWSHeader'
+
+instance HasX5u JWSHeader' where
+instance HasAlg JWSHeader' where
+instance HasJku JWSHeader' where
+instance HasJwk JWSHeader' where
+instance HasKid JWSHeader' where
+instance HasX5c JWSHeader' where
+instance HasX5t JWSHeader' where
+instance HasX5tS256 JWSHeader' where
+instance HasTyp JWSHeader' where
+instance HasCty JWSHeader' where
+instance HasCrit JWSHeader' where
 instance HasJWSHeader JWSHeader' where
   jwsHeader = _JWSHeader'
 instance HasParams JWSHeader' where
@@ -71,12 +90,34 @@ data ACMEHeader p = ACMEHeader
   { _acmeJwsHeader :: JWSHeader p
   , _acmeNonce :: Types.Base64Octets
   } deriving (Show)
+
+instance Eq1 ACMEHeader where
+  liftEq f (ACMEHeader h1 o1) (ACMEHeader h2 o2) =
+    (liftEq f h1 h2) && (o1 == o2)
+
+instance Show1 ACMEHeader where
+  liftShowsPrec f g n (ACMEHeader h o) =
+    showString "ACMEHeader " .
+    liftShowsPrec f g n h .
+    shows o
+
 acmeJwsHeader :: Lens' (ACMEHeader p) (JWSHeader p)
 acmeJwsHeader f s@ACMEHeader{ _acmeJwsHeader = a} =
   fmap (\a' -> s { _acmeJwsHeader = a'}) (f a)
 acmeNonce :: Lens' (ACMEHeader p) Types.Base64Octets
 acmeNonce f s@ACMEHeader{ _acmeNonce = a} =
   fmap (\a' -> s { _acmeNonce = a'}) (f a)
+instance HasX5u ACMEHeader where
+instance HasAlg ACMEHeader where
+instance HasJku ACMEHeader where
+instance HasJwk ACMEHeader where
+instance HasKid ACMEHeader where
+instance HasX5c ACMEHeader where
+instance HasX5t ACMEHeader where
+instance HasX5tS256 ACMEHeader where
+instance HasTyp ACMEHeader where
+instance HasCty ACMEHeader where
+instance HasCrit ACMEHeader where
 instance HasJWSHeader ACMEHeader where
   jwsHeader = acmeJwsHeader
 instance HasParams ACMEHeader where
@@ -222,11 +263,11 @@ appendixA1Spec = describe "RFC 7515 A.1.  Example JWS using HMAC SHA-256" $ do
 
   it "computes the HMAC correctly" $
     fst (withDRG drg $
-      runExceptT (sign alg (jwk ^. jwkMaterial) (signingInput' ^. recons)))
+      runWrappedExceptT' (sign alg_ (jwk_ ^. jwkMaterial) (signingInput' ^. recons)))
       `shouldBe` (Right mac :: Either Error BS.ByteString)
 
   it "validates the JWS correctly" $
-    (jws >>= verifyJWS defaultValidationSettings jwk)
+    (jws >>= verifyJWS defaultValidationSettings jwk_)
     `shouldBe` Right examplePayloadBytes
 
   where
@@ -237,14 +278,14 @@ appendixA1Spec = describe "RFC 7515 A.1.  Example JWS using HMAC SHA-256" $ do
       \cGxlLmNvbS9pc19yb290Ijp0cnVlfQ"
     compactJWS = signingInput' <> ".dBjftJeZ4CVP-mB92K27uhbUJU1p1r_wW1gFWFOEjXk"
     jws = decodeCompact compactJWS :: Either Error (CompactJWS JWSHeader)
-    alg = JWA.JWS.HS256
-    h = newJWSHeader ((), alg)
+    alg_ = JWA.JWS.HS256
+    h = newJWSHeader ((), alg_)
         & typ .~ Just (HeaderParam () "JWT")
     mac = view recons
       [116, 24, 223, 180, 151, 153, 224, 37, 79, 250, 96, 125, 216, 173,
       187, 186, 22, 212, 37, 77, 105, 214, 191, 240, 91, 88, 5, 88, 83,
       132, 141, 121]
-    jwk = fromOctets
+    jwk_ = fromOctets
       [3,35,53,75,43,15,165,188,131,126,6,101,119,123,166,143,90,179,40,
        230,240,84,201,40,169,15,132,178,210,80,46,191,211,251,90,146,
        210,6,71,239,150,138,180,195,119,98,61,34,61,46,33,114,5,46,79,8,
@@ -275,15 +316,15 @@ jwkRSA1024 = fromJust $ decode $
 appendixA2Spec :: Spec
 appendixA2Spec = describe "RFC 7515 A.2. Example JWS using RSASSA-PKCS-v1_5 SHA-256" $ do
   it "computes the signature correctly" $
-    fst (withDRG drg $ runExceptT (sign JWA.JWS.RS256 (jwk ^. jwkMaterial) signingInput'))
+    fst (withDRG drg $ runWrappedExceptT' (sign JWA.JWS.RS256 (jwk_ ^. jwkMaterial) signingInput'))
       `shouldBe` (Right sig :: Either Error BS.ByteString)
 
   it "validates the signature correctly" $
-    verify JWA.JWS.RS256 (jwk ^. jwkMaterial) signingInput' sig
+    verify JWA.JWS.RS256 (jwk_ ^. jwkMaterial) signingInput' sig
       `shouldBe` (Right True :: Either Error Bool)
 
   it "prohibits signing with 1024-bit key" $
-    fst (withDRG drg (runExceptT $
+    fst (withDRG drg (runWrappedExceptT' $
       signJWS signingInput' (Identity (newJWSHeader ((), JWA.JWS.RS256), jwkRSA1024))))
         `shouldBe` (Left KeySizeTooSmall :: Either Error (CompactJWS JWSHeader))
 
@@ -293,7 +334,7 @@ appendixA2Spec = describe "RFC 7515 A.2. Example JWS using RSASSA-PKCS-v1_5 SHA-
       \.\
       \eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFt\
       \cGxlLmNvbS9pc19yb290Ijp0cnVlfQ"
-    jwk = fromJust $ decode "\
+    jwk_ = fromJust $ decode "\
       \{\"kty\":\"RSA\",\
       \ \"n\":\"ofgWCuLjybRlzo0tZWJjNiuSfb4p4fAkd_wWJcyQoTbji9k0l8W26mPddx\
             \HmfHQp-Vaw-4qPCJrcS2mJPMEzP1Pt0Bm4d4QlL-yRT-SFd2lZS-pCgNMs\
@@ -334,7 +375,7 @@ appendixA2Spec = describe "RFC 7515 A.2. Example JWS using RSASSA-PKCS-v1_5 SHA-
 appendixA3Spec :: Spec
 appendixA3Spec = describe "RFC 7515 A.3.  Example JWS using ECDSA P-256 SHA-256" $
   it "validates the signature correctly" $
-    verify JWA.JWS.ES256 (jwk ^. jwkMaterial) signingInput' sig
+    verify JWA.JWS.ES256 (jwk_ ^. jwkMaterial) signingInput' sig
     `shouldBe` (Right True :: Either Error Bool)
   where
     signingInput' = "\
@@ -342,7 +383,7 @@ appendixA3Spec = describe "RFC 7515 A.3.  Example JWS using ECDSA P-256 SHA-256"
       \.\
       \eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFt\
       \cGxlLmNvbS9pc19yb290Ijp0cnVlfQ"
-    jwk = fromJust $ decode "\
+    jwk_ = fromJust $ decode "\
       \{\"kty\":\"EC\",\
       \ \"crv\":\"P-256\",\
       \ \"x\":\"f83OJ3D2xF1Bg8vub9tLe1gHMzV76e8Tus9uPHvRVEU\",\
@@ -367,7 +408,7 @@ appendixA5Spec = describe "RFC 7515 A.5.  Example Unsecured JWS" $ do
 
   where
     jws = fst $ withDRG drg $ runExceptT $
-      signJWS examplePayloadBytes (Identity (newJWSHeader ((), JWA.JWS.None), undefined))
+      runWrappedExceptT (signJWS examplePayloadBytes (Identity (newJWSHeader ((), JWA.JWS.None), undefined)))
       :: Either Error (CompactJWS JWSHeader)
     exampleJWS = "eyJhbGciOiJub25lIn0\
       \.\
@@ -502,7 +543,7 @@ appendixA6Spec = describe "RFC 7515 A.6.  Example JWS Using General JSON Seriali
 cfrgSpec :: Spec
 cfrgSpec = describe "RFC 8037 signature/validation test vectors" $ do
   let
-    jwk = fromJust $ decode "\
+    jwk_ = fromJust $ decode "\
       \{\"kty\":\"OKP\",\"crv\":\"Ed25519\",\
       \\"d\":\"nWGxne_9WmC6hEr0kuwsxERJxWl7MmkZcDusAxyuf2A\",\
       \\"x\":\"11qYAYKxCrfVS_7TyWQHOg7hcvPapiMlrwIaaPcHURo\"}"
@@ -514,8 +555,8 @@ cfrgSpec = describe "RFC 8037 signature/validation test vectors" $ do
     sig = BS.pack sigOctets
     signingInput = "eyJhbGciOiJFZERTQSJ9.RXhhbXBsZSBvZiBFZDI1NTE5IHNpZ25pbmc"
   it "computes the correct signature" $
-    fst (withDRG drg $ runExceptT (sign JWA.JWS.EdDSA (view jwkMaterial jwk) signingInput))
+    fst (withDRG drg $ runWrappedExceptT' (sign JWA.JWS.EdDSA (view jwkMaterial jwk_) signingInput))
       `shouldBe` (Right sig :: Either Error BS.ByteString)
   it "validates signatures correctly" $
-    verify JWA.JWS.EdDSA (view jwkMaterial jwk) signingInput sig
+    verify JWA.JWS.EdDSA (view jwkMaterial jwk_) signingInput sig
       `shouldBe` (Right True :: Either Error Bool)
diff --git a/test/JWT.hs b/test/JWT.hs
index 1660fe6..3547c53 100644
--- a/test/JWT.hs
+++ b/test/JWT.hs
@@ -18,25 +18,21 @@
 
 module JWT where
 
-import Data.Maybe
+import Data.Maybe(fromJust)
 import Data.Monoid ((<>))
 
-import Control.Lens
-import Control.Lens.Extras (is)
-import Control.Monad.Reader (MonadReader(..), ReaderT, runReaderT)
-import Control.Monad.State (execState)
-import Control.Monad.Time (MonadTime(..))
-import Data.Aeson hiding ((.=))
-import Data.Functor.Identity (runIdentity)
+import Control.Lens((&), (.~), preview, over, set, _Left)
+import Control.Lens.Extras(is)
+import Control.Monad.Reader (runReaderT)
+import Data.Aeson(Value(Bool), decode, encode)
 import Data.HashMap.Strict (insert)
-import qualified Data.Set as S
-import Data.Time
-import Network.URI (parseURI)
+import qualified Data.Set as S(singleton)
+import Data.Time(UTCTime, parseTimeM, defaultTimeLocale)
 import Safe (headMay)
 import Test.Hspec
 
-import Crypto.JWT
-
+import Crypto.JWT(NumericDate(NumericDate), ClaimsSet, JWTError, StringOrURI, JWK, emptyClaimsSet, claimIss, stringOrUri, claimExp, unregisteredClaims, addClaim, algorithms, Alg(None), defaultJWTValidationSettings, validateClaimsSet, JWTError(JWTExpired, JWTIssuedAtFuture, JWTNotYetValid, JWTNotInAudience, JWTNotInIssuer), allowedSkew, claimIat, checkIssuedAt, claimNbf, audiencePredicate, claimAud, Audience(Audience), issuerPredicate, string, uri, decodeCompact, verifyClaims, _JWSInvalidSignature)
+import Crypto.JOSE.Types.WrappedURI
 
 intDate :: String -> Maybe NumericDate
 intDate = fmap NumericDate . parseTimeM True defaultTimeLocale "%F %T"
@@ -259,9 +255,9 @@ spec = do
   describe "StringOrURI" $
     it "parses from JSON correctly" $ do
       (decode "[\"foo\"]" >>= headMay >>= preview string) `shouldBe` Just "foo"
-      (decode "[\"http://example.com\"]" >>= headMay >>= preview uri)
-        `shouldBe` parseURI "http://example.com"
-      decode "[\":\"]" `shouldBe` (Nothing :: Maybe [StringOrURI])
+      (decode "[\"http://example.com\"]" >>= headMay >>= preview uri >>= pure . WrappedURI)
+        `shouldBe` mkURI' "http://example.com"
+      decode "[\"\\:\"]" `shouldBe` (Nothing :: Maybe [StringOrURI])
       decode "[12345]" `shouldBe` (Nothing :: Maybe [StringOrURI])
 
   describe "NumericDate" $
diff --git a/test/Properties.hs b/test/Properties.hs
index 4833dd3..80ff270 100644
--- a/test/Properties.hs
+++ b/test/Properties.hs
@@ -13,10 +13,10 @@
 -- limitations under the License.
 
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 module Properties where
 
-import Control.Applicative
 import Control.Monad.Except (runExceptT)
 
 import Data.Aeson
@@ -32,6 +32,9 @@ import Crypto.JOSE.Types
 import Crypto.JOSE.JWK
 import Crypto.JOSE.JWS
 
+import WrappedExceptT
+
+properties :: TestTree
 properties = testGroup "Properties"
   [ testProperty "SizedBase64Integer round-trip"
     (prop_roundTrip :: SizedBase64Integer -> Bool)
@@ -58,9 +61,9 @@ prop_rsaSignAndVerify :: B.ByteString -> Property
 prop_rsaSignAndVerify msg = monadicIO $ do
   keylen <- pick $ elements ((`div` 8) <$> [2048, 3072, 4096])
   k :: JWK <- run $ genJWK (RSAGenParam keylen)
-  alg <- pick $ elements [RS256, RS384, RS512, PS256, PS384, PS512]
-  monitor (collect alg)
-  wp (runExceptT (signJWS msg [(newJWSHeader (Protected, alg), k)]
+  alg_ <- pick $ elements [RS256, RS384, RS512, PS256, PS384, PS512]
+  monitor (collect alg_)
+  wp (runWrappedExceptT' (signJWS msg [(newJWSHeader (Protected, alg_), k)]
     >>= verifyJWS defaultValidationSettings k)) (checkSignVerifyResult msg)
 
 prop_bestJWSAlg :: B.ByteString -> Property
@@ -70,11 +73,11 @@ prop_bestJWSAlg msg = monadicIO $ do
   case bestJWSAlg k of
     Left (KeyMismatch _) -> pre False  -- skip non-signing keys
     Left _ -> assert False
-    Right alg -> do
-      monitor (collect alg)
+    Right alg_ -> do
+      monitor (collect alg_)
       let
         go = do
-          jws <- signJWS msg [(newJWSHeader (Protected, alg), k)]
+          jws <- runWrappedExceptT (signJWS msg [(newJWSHeader (Protected, alg_), k)])
           verifyJWS defaultValidationSettings k jws
       wp (runExceptT go) (checkSignVerifyResult msg)
 
diff --git a/test/Test.hs b/test/Test.hs
index def2b93..76e376d 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -14,7 +14,6 @@
 
 import Test.Tasty
 import Test.Tasty.Hspec
-import Test.Tasty.QuickCheck
 
 import AESKW
 import JWK
diff --git a/test/Types.hs b/test/Types.hs
index 63d5f7d..835382c 100644
--- a/test/Types.hs
+++ b/test/Types.hs
@@ -13,16 +13,17 @@
 -- limitations under the License.
 
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 module Types where
 
 import Data.Aeson
 import qualified Data.ByteString as BS
 import Data.List.NonEmpty
-import Network.URI (parseURI)
 import Test.Hspec
 
 import Crypto.JOSE.Types
+import Crypto.JOSE.Types.WrappedURI(WrappedURI, mkURI')
 
 spec :: Spec
 spec = do
@@ -45,12 +46,12 @@ uriSpec :: Spec
 uriSpec = describe "URI typeclasses" $ do
   it "gets parsed from JSON correctly" $ do
     decode "[\"http://example.com\"]" `shouldBe`
-      fmap (fmap (:[])) parseURI "http://example.com"
-    decode "[\"foo\"]" `shouldBe` (Nothing :: Maybe [URI])
+      fmap (fmap (:[])) mkURI' "http://example.com"
+    decode "[\"foo\\\"]" `shouldBe` (Nothing :: Maybe [WrappedURI])
 
   it "gets formatted to JSON correctly" $
-    fmap toJSON (Network.URI.parseURI "http://example.com")
-      `shouldBe` Just (String "http://example.com")
+    fmap toJSON (mkURI' "http://example.com/")
+      `shouldBe` Just (String "http://example.com/")
 
 base64IntegerSpec :: Spec
 base64IntegerSpec = describe "Base64Integer" $ do
diff --git a/test/WrappedExceptT.hs b/test/WrappedExceptT.hs
new file mode 100644
index 0000000..a382d7e
--- /dev/null
+++ b/test/WrappedExceptT.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module WrappedExceptT where
+
+import Control.Monad.Except
+import Control.Monad.Trans (MonadTrans(..))
+import Crypto.Random (MonadRandom(..))
+
+newtype WrappedExceptT e f a =
+  WrappedExceptT { runWrappedExceptT :: ExceptT e f a }
+  deriving (Eq, Ord, Show, Functor, Applicative, Monad, MonadTrans)
+
+instance MonadRandom f => MonadRandom (WrappedExceptT e f) where
+  getRandomBytes = lift . getRandomBytes
+
+instance Monad f => MonadError e (WrappedExceptT e f) where
+  throwError =
+    WrappedExceptT . throwError 
+  catchError (WrappedExceptT a) f =
+    WrappedExceptT (catchError a (runWrappedExceptT . f))
+    
+runWrappedExceptT' ::
+  WrappedExceptT e f a
+  -> f (Either e a)
+runWrappedExceptT' =
+  runExceptT . runWrappedExceptT