gaku-sei · gaku-sei · Jul 31, 2020 · Jul 31, 2020 · gaku-sei · Jul 31, 2020
diff --git a/README.md b/README.md
@@ -26,37 +26,45 @@ sign
 
 By default, some values will be set for you: `alg` will be `HS256`, `typ` equals `JWT`, and the `iat` field will be set to the creation timestamp. You _can_ override any for the above by providing the value explicitely.
 
-You can also provide an `unregistered` claim, that will contain literally any [encodable](https://pursuit.purescript.org/packages/purescript-foreign-generic/10.0.0/docs/Foreign.Generic.Class#t:Encode) data:
+You can also provide an `unregisteredClaims` record, each values of that record must be [encodable](https://pursuit.purescript.org/packages/purescript-foreign-generic/10.0.0/docs/Foreign.Generic.Class#t:Encode):
 
 ```purs
 sign
   (Secret "my-super-secret-key")
   defaultHeaders
-  (defaultClaims { unregistered = unregisteredClaim "Foo" } )
+  (defaultClaims { unregisteredClaims = Just { foo: "bar" } )
 ```
 
 ### Decode
 
-If decode succeeds, it will return a `Token Unverified` you can read the headers and claims from it:
+If decode succeeds, it will return a `Token r Unverified` where `r` is the row type of the `unregisteredClaims` record. You can read the headers and claims as follow:
 
 ```purs
 decodedHeaders :: String -> Maybe JOSEHeaders
-decodedHeaders token = decode token >>= hush <<< headers
+decodedHeaders token = hush $ decode' token <#> _.headers
 
-decodedClaims :: String -> Maybe Claims
-decodedClaims token = decode token >>= hush <<< claims
+decodedClaims :: String -> Maybe (Claims ())
+decodedClaims token = hush $ decode' token <#> _.claims
+
+decodedClaims' :: String -> Maybe (Claims ( foo :: String ))
+decodedClaims' token = hush $ decode token <#> _.claims
 ```
 
+Notice that when decoding claims with some explicit unregistered claims, said claims must be of the expected type at runtime.
+
 ### Verify
 
-If verify succeeds, it will return a `Token Verified` you can read the headers and claims from it:
+If verify succeeds, it will return a `Token Verified` you can read the headers and claims this way:
 
 ```purs
 verifiedHeaders :: String -> Maybe JOSEHeaders
-verifiedHeaders token = verify (Secret "my-super-secret-key") token >>= hush <<< headers
+verifiedHeaders token = hush $ verify' (Secret "my-super-secret-key") token <#> _.headers
+
+verifiedClaims :: String -> Maybe (Claims ())
+verifiedClaims token = hush $ verify' (Secret "my-super-secret-key") token <#> _.claims
 
-verifiedClaims :: String -> Maybe Claims
-verifiedClaims token = verify (Secret "my-super-secret-key") token >>= hush <<< claims
+verifiedClaims' :: String -> Maybe (Claims ( foo :: String ))
+verifiedClaims' token = hush $ verify (Secret "my-super-secret-key") token <#> _.claims
 ```
 
 ## Documentation

diff --git a/src/Node/Jwt.js b/src/Node/Jwt.js
@@ -1,31 +1,65 @@
-var jwt = require("jsonwebtoken");
+const jwt = require("jsonwebtoken");
 
-exports._decode = function decode(just, nothing, token) {
+const registeredClaimsKeys = ["iss", "sub", "aud", "exp", "nbf", "iat", "jti"];
+
+// TODO: Remove this when https://github.com/erikd/language-javascript/pull/118 is merged
+const partitionClaims = (claims) =>
+  Object.entries(claims).reduce(
+    ([registered, unregistered], [key, value]) => {
+      const claim = { [key]: value };
+
+      return registeredClaimsKeys.includes(key)
+        ? [Object.assign({}, registered, claim), unregistered]
+        : [registered, Object.assign({}, unregistered || {}, claim)];
+    },
+    [{}, undefined]
+  );
+
+const normalizeClaims = ({ header, payload, signature }, just, nothing) => {
   try {
-    const decodedToken = jwt.decode(token, { complete: true, json: false });
+    const [registeredClaims, unregisteredClaims] = partitionClaims(payload);
 
-    return decodedToken ? just(decodedToken) : nothing;
-  } catch (error) {
+    return just({
+      header,
+      payload: Object.assign({}, registeredClaims, { unregisteredClaims }),
+      signature,
+    });
+  } catch (_) {
     return nothing;
   }
 };
 
-exports._verify = function verify(just, nothing, secret, token) {
+exports._decode = (just, nothing, token) => {
   try {
-    const verifiedToken = jwt.verify(token, secret, {
-      complete: true,
-      json: false,
-    });
+    return normalizeClaims(
+      jwt.decode(token, { complete: true, json: false }),
+      just,
+      nothing
+    );
+  } catch (_) {
+    return nothing;
+  }
+};
 
-    return verifiedToken ? just(verifiedToken) : nothing;
-  } catch (error) {
+exports._verify = (just, nothing, token, secret) => {
+  try {
+    return normalizeClaims(
+      jwt.verify(token, secret, { complete: true, json: false }),
+      just,
+      nothing
+    );
+  } catch (_) {
     return nothing;
   }
 };
 
-exports._sign = function sign(payload, secret, options) {
+exports._sign = (payload, unregisteredClaims, secret, options) => {
+  const fullPayload = unregisteredClaims
+    ? Object.assign({}, payload, unregisteredClaims)
+    : payload;
+
   return new Promise(function (resolve, reject) {
-    jwt.sign(payload, secret, options, function (error, token) {
+    jwt.sign(fullPayload, secret, options, function (error, token) {
       if (error) {
         return reject(error);
       }

diff --git a/src/Node/Jwt.purs b/src/Node/Jwt.purs
@@ -1,8 +1,10 @@
 module Node.Jwt
   ( module Types
   , decode
+  , decode'
   , sign
   , verify
+  , verify'
   ) where
 
 import Types
@@ -17,10 +19,10 @@ import Data.Newtype (unwrap)
 import Data.Options (options, (:=))
 import Data.Traversable (traverse)
 import Effect.Aff (Aff)
-import Effect.Uncurried (EffectFn3, runEffectFn3)
+import Effect.Uncurried (EffectFn4, runEffectFn4)
 import Foreign (ForeignError, readNullOrUndefined, readString, renderForeignError)
 import Foreign.Generic (F, Foreign)
-import Foreign.Generic (decode) as Generic
+import Foreign.Generic (decode, encode) as Generic
 import Foreign.Index ((!))
 import Options as Options
 import Prelude (bind, map, pure, ($), (<$>), (<*>), (<>), (>>=))
@@ -41,8 +43,8 @@ claims token =
     iss <- token ! "payload" ! "iss" >>= readNullOrUndefined >>= traverse readString
     sub <- token ! "payload" ! "sub" >>= readNullOrUndefined >>= traverse readString
     jti <- token ! "payload" ! "jti" >>= readNullOrUndefined >>= traverse readString
-    (unregistered :: Maybe (Record r)) <- token ! "payload" ! "unregistered" >>= readNullOrUndefined >>= traverse Generic.decode
-    pure { iat, nbf, exp, aud: unwrap <$> aud, iss, sub, jti, unregistered }
+    unregisteredClaims <- token ! "payload" ! "unregisteredClaims" >>= readNullOrUndefined >>= traverse Generic.decode
+    pure { iat, nbf, exp, aud: unwrap <$> aud, iss, sub, jti, unregisteredClaims }
 
 -- Extract JWT headers from any foreign value
 headers :: Foreign -> Either (NonEmptyList ForeignError) JOSEHeaders
@@ -54,42 +56,38 @@ headers token =
     cty <- token ! "header" ! "cty" >>= readNullOrUndefined >>= traverse Generic.decode
     pure { alg, typ, kid, cty }
 
-foreign import _sign :: EffectFn3 Foreign String Foreign (Promise String)
+foreign import _sign :: EffectFn4 Foreign Foreign String Foreign (Promise String)
 
 sign :: forall r l. Encodable r l => Secret -> JOSEHeaders -> Claims r -> Aff String
-sign (Secret secret) { typ, cty, alg, kid } { iss, sub, aud, exp, nbf, iat, jti, unregistered } =
+sign (Secret secret) { typ, cty, alg, kid } { iss, sub, aud, exp, nbf, iat, jti, unregisteredClaims } =
   toAffE
-    $ runEffectFn3 _sign payloadOptions secret
-    $ signOptions
+    $ runEffectFn4 _sign payloadOptions (Generic.encode unregisteredClaims) secret signOptions
   where
   payloadOptions :: Foreign
   payloadOptions =
     options
-      ( (Options.iat := iat)
-          <> (Options.nbf := nbf)
-          <> (Options.exp := exp)
-          <> (Options.unregistered := unregistered)
-      )
+      $ (Options.iat := iat)
+      <> (Options.nbf := nbf)
+      <> (Options.exp := exp)
+
+  signHeaderOptions :: Foreign
+  signHeaderOptions =
+    options
+      $ (Options.typ := typ)
+      <> (Options.cty := cty)
+      <> (Options.alg := alg)
+      <> (Options.kid := kid)
 
   signOptions :: Foreign
   signOptions =
     options
-      ( (Options.algorithm := alg)
-          <> (Options.audience := aud)
-          <> (Options.issuer := iss)
-          <> (Options.jwtid := jti)
-          <> (Options.subject := sub)
-          <> (Options.keyid := kid)
-          <> ( Options.header
-                := ( options
-                      ( (Options.typ := typ)
-                          <> (Options.cty := cty)
-                          <> (Options.alg := alg)
-                          <> (Options.kid := kid)
-                      )
-                  )
-            )
-      )
+      $ (Options.algorithm := alg)
+      <> (Options.audience := aud)
+      <> (Options.issuer := iss)
+      <> (Options.jwtid := jti)
+      <> (Options.subject := sub)
+      <> (Options.keyid := kid)
+      <> (Options.header := signHeaderOptions)
 
 -- Utility function used to automatically convert any foreign value into a token
 foreignToToken :: forall r l s. Decodable r l => Foreign -> Either (NonEmptyList String) (Token r s)
@@ -103,7 +101,13 @@ foreign import _decode :: Fn3 (Foreign -> Maybe Foreign) (Maybe Foreign) String
 decode :: forall r l. Decodable r l => String -> Either (NonEmptyList String) (Token r Unverified)
 decode s = (note (singleton "Couldn't decode token") $ runFn3 _decode Just Nothing s) >>= foreignToToken
 
+decode' :: String -> Either (NonEmptyList String) (Token () Unverified)
+decode' = decode
+
 foreign import _verify :: Fn4 (Foreign -> Maybe Foreign) (Maybe Foreign) String String (Maybe Foreign)
 
 verify :: forall r l. Decodable r l => Secret -> String -> Either (NonEmptyList String) (Token r Verified)
-verify (Secret secret) s = (note (singleton "Couldn't verify token") $ runFn4 _verify Just Nothing secret s) >>= foreignToToken
+verify (Secret secret) s = (note (singleton "Couldn't verify token") $ runFn4 _verify Just Nothing s secret) >>= foreignToToken
+
+verify' :: Secret -> String -> Either (NonEmptyList String) (Token () Unverified)
+verify' = verify
diff --git a/src/Node/Options.purs b/src/Node/Options.purs
@@ -7,7 +7,6 @@ import Data.Options (Option, opt, optional)
 import Foreign.Generic (Foreign, encode)
 import Prelude (($), (<<<))
 import Types (Algorithm, EitherWrapper(..), NumericDate, Typ)
-import GenericRecord (class Encodable)
 
 foreign import data SignOptions :: Type
 
@@ -56,6 +55,3 @@ nbf = optional $ cmap encode $ opt "nbf"
 
 exp :: Option PayloadOptions (Maybe NumericDate)
 exp = optional $ cmap encode $ opt "exp"
-
-unregistered :: forall r l. Encodable r l => Option PayloadOptions (Maybe (Record r))
-unregistered = optional $ cmap encode $ opt "unregistered"
diff --git a/src/Node/Types.purs b/src/Node/Types.purs
@@ -117,7 +117,7 @@ type Claims r
     , nbf :: Maybe NumericDate
     , iat :: Maybe NumericDate
     , jti :: Maybe String
-    , unregistered :: Maybe (Record r)
+    , unregisteredClaims :: Maybe (Record r)
     }
 
 data Verified
@@ -138,7 +138,7 @@ defaultClaims =
   , nbf: Nothing
   , iat: Nothing
   , jti: Nothing
-  , unregistered: Nothing
+  , unregisteredClaims: Nothing
   }
 
 newtype Secret

diff --git a/test/Main.purs b/test/Main.purs
@@ -11,7 +11,7 @@ import Effect (Effect)
 import Effect.Aff (Milliseconds(..), launchAff_)
 import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Now (now)
-import Node.Jwt (Algorithm(..), NumericDate(..), Secret(..), Token, Typ(..), Unverified, Verified, Claims, decode, defaultClaims, defaultHeaders, sign, verify)
+import Node.Jwt (Algorithm(..), Claims, NumericDate(..), Secret(..), Typ(..), decode, decode', defaultClaims, defaultHeaders, sign, verify')
 import Prelude (Unit, bind, bottom, discard, negate, (#), ($), (&&), (/=), (<), (<#>), (<$>), (<<<), (>), (>>=), (>>>))
 import Prim.Row (class Lacks)
 import Record (delete)
@@ -20,8 +20,8 @@ import Test.Spec.Assertions (shouldEqual, shouldSatisfy)
 import Test.Spec.Reporter (consoleReporter)
 import Test.Spec.Runner (runSpec)
 
-cleanClaims :: forall r a. Lacks "unregistered" r => { unregistered :: a | r } -> { | r }
-cleanClaims = delete (SProxy :: SProxy "unregistered")
+cleanClaims :: forall r a. Lacks "unregisteredClaims" r => { unregisteredClaims :: a | r } -> { | r }
+cleanClaims = delete (SProxy :: SProxy "unregisteredClaims")
 
 getTimestamp :: forall m. MonadEffect m => m DateTime
 getTimestamp = liftEffect $ modifyTime (setMillisecond bottom) <<< toDateTime <$> now
@@ -41,7 +41,7 @@ main =
             it "signs a token with custom unregistered claims" do
               token <-
                 sign (Secret "whatever") defaultHeaders
-                  $ defaultClaims { unregistered = Just { foo: "bar" } }
+                  $ defaultClaims { unregisteredClaims = Just { "https://my-domain.com/foo": "bar" } }
               token `shouldSatisfy` (/=) ""
           describe "decode" do
             it "decodes a token with default headers, and default claims" do
@@ -50,18 +50,17 @@ main =
                 claims' = defaultClaims { iat = Just $ wrap timestamp }
               token <- sign (Secret "whatever") defaultHeaders claims'
               let
-                decodedToken :: Maybe (Token () Unverified)
-                decodedToken = hush $ decode token
+                decodedToken = hush $ decode' token
               (decodedToken <#> _.headers) `shouldEqual` Just defaultHeaders
               (decodedToken <#> _.claims <#> cleanClaims) `shouldEqual` Just (cleanClaims claims')
             it "decodes a token with custom unregistered claims" do
               token <-
                 sign (Secret "whatever") defaultHeaders
-                  $ defaultClaims { unregistered = Just { foo: "bar" } }
+                  $ defaultClaims { unregisteredClaims = Just { "https://my-domain.com/foo": "bar" } }
               let
                 decodedToken = hush $ decode token
               (decodedToken <#> _.headers) `shouldEqual` Just defaultHeaders
-              (decodedToken >>= _.claims >>> _.unregistered) `shouldEqual` Just { foo: "bar" }
+              (decodedToken >>= _.claims >>> _.unregisteredClaims) `shouldEqual` Just { "https://my-domain.com/foo": "bar" }
             it "decodes a token with default headers, and default claims, with numeric date" do
               timestamp <- getTimestamp
               let
@@ -76,12 +75,11 @@ main =
                   , jti: Just "an id"
                   , nbf: wrap <<< toDateTime <$> (instant $ Milliseconds 1000.0)
                   , sub: Just "subject!"
-                  , unregistered: Nothing
+                  , unregisteredClaims: Nothing
                   }
               token <- sign (Secret "whatever") customHeaders customClaims
               let
-                decodedToken :: Maybe (Token () Unverified)
-                decodedToken = hush $ decode token
+                decodedToken = hush $ decode' token
               (decodedToken <#> _.claims >>= _.exp # isJust) `shouldEqual` true
               (decodedToken <#> _.claims >>= _.nbf # isJust) `shouldEqual` true
               (decodedToken <#> _.headers) `shouldEqual` Just customHeaders
@@ -100,12 +98,11 @@ main =
                   , jti: Just "an id"
                   , nbf: Nothing
                   , sub: Just "subject!"
-                  , unregistered: Nothing
+                  , unregisteredClaims: Nothing
                   }
               token <- sign (Secret "whatever") customHeaders customClaims
               let
-                decodedToken :: Maybe (Token () Unverified)
-                decodedToken = hush $ decode token
+                decodedToken = hush $ decode' token
               (decodedToken <#> _.headers) `shouldEqual` Just customHeaders
               let
                 receivedClaims = decodedToken <#> _.claims <#> cleanClaims
@@ -121,15 +118,13 @@ main =
                 claims' = defaultClaims { iat = Just $ wrap timestamp }
               token <- sign (Secret "whatever") defaultHeaders claims'
               let
-                verifiedToken :: Maybe (Token () Verified)
-                verifiedToken = hush $ verify (Secret "whatever") token
+                verifiedToken = hush $ verify' (Secret "whatever") token
               (verifiedToken <#> _.headers) `shouldEqual` Just defaultHeaders
               (verifiedToken <#> _.claims <#> cleanClaims) `shouldEqual` Just (cleanClaims claims')
             it "doesn't verify a token when the secrets differ" do
               token <- sign (Secret "whatever") defaultHeaders defaultClaims
               let
-                verifiedToken :: Maybe (Token () Verified)
-                verifiedToken = hush $ verify (Secret "whatever!") token
+                verifiedToken = hush $ verify' (Secret "whatever!") token
               verifiedToken `shouldEqual` Nothing
               (verifiedToken <#> _.headers) `shouldEqual` Nothing
               (verifiedToken <#> _.claims <#> cleanClaims) `shouldEqual` Nothing
@@ -147,12 +142,11 @@ main =
                   , jti: Just "an id"
                   , nbf: Nothing
                   , sub: Just "subject!"
-                  , unregistered: Nothing
+                  , unregisteredClaims: Nothing
                   }
               token <- sign (Secret "whatever") customHeaders customClaims
               let
-                verifiedToken :: Maybe (Token () Verified)
-                verifiedToken = hush $ verify (Secret "whatever") token
+                verifiedToken = hush $ verify' (Secret "whatever") token
               (verifiedToken <#> _.headers) `shouldEqual` Just customHeaders
               let
                 receivedClaims = verifiedToken <#> _.claims <#> cleanClaims