From 8b5f4e8556101caf4e6c8c707e412a7d9c5a6cd2 Mon Sep 17 00:00:00 2001
From: Diogo Biazus <diogob@gmail.com>
Date: Sun, 18 Oct 2015 17:14:11 -0400
Subject: [PATCH] Removes lenses and uses simpler approach to generate JWT
 claims. Also fixes the setVar to avoid the ::unknown type cast from
 insertableValue

---
 postgrest.cabal       |  6 ------
 src/PostgREST/Auth.hs | 28 +++++++++++++++-------------
 2 files changed, 15 insertions(+), 19 deletions(-)

diff --git a/postgrest.cabal b/postgrest.cabal
index 2b3642b6c..38f5bf364 100644
--- a/postgrest.cabal
+++ b/postgrest.cabal
@@ -53,8 +53,6 @@ executable postgrest
                      , mtl
                      , cassava
                      , jwt
-                     , lens
-                     , lens-aeson >= 1.0.0.5
                      , parsec
                      , errors
                      , bifunctors
@@ -88,8 +86,6 @@ library
                      , hasql-postgres
                      , http-types
                      , jwt
-                     , lens
-                     , lens-aeson >= 1.0.0.5
                      , mtl
                      , network
                      , network-uri
@@ -181,8 +177,6 @@ Test-Suite spec
                      , process
                      , heredoc
                      , jwt
-                     , lens
-                     , lens-aeson >= 1.0.0.5
                      , parsec
                      , errors
                      , bifunctors
diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs
index f7cce5fec..8b8f6e32b 100644
--- a/src/PostgREST/Auth.hs
+++ b/src/PostgREST/Auth.hs
@@ -7,17 +7,16 @@ module PostgREST.Auth (
 
 import           Control.Applicative
 import           Data.Aeson
-import           Data.Map (fromList, toList)
-import           Data.Maybe (fromMaybe)
+import           Data.Aeson.Types (emptyObject, emptyArray)
+import           Data.Vector as V (null, head)
+import           Data.Map as M (fromList, toList)
 import           Data.Monoid
 import           Data.String.Conversions (cs)
 import           Data.Text (Text)
-import           PostgREST.PgQuery       (pgFmtLit, pgFmtIdent, insertableValue)
+import           PostgREST.PgQuery       (pgFmtLit, pgFmtIdent, unquoted)
 import           Prelude
 import qualified Web.JWT                 as JWT
-import qualified Data.HashMap.Lazy       as HashMap
-import Data.Aeson.Lens
-import Control.Lens.Operators
+import qualified Data.HashMap.Lazy       as H
 
 setJWTEnv :: Text -> Text -> Maybe [Text]
 setJWTEnv secret input = setDBEnv $ jwtClaims secret input
@@ -28,7 +27,8 @@ setDBEnv maybeClaims =
   where
     setVar ("role", String val) = setRole val
     setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <>
-                  " = " <> insertableValue val <> ";"
+                  " = " <> valueToVariable val <> ";"
+    valueToVariable = pgFmtLit . unquoted
 
 setRole :: Text -> Text
 setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
@@ -40,9 +40,11 @@ jwtClaims secret input = claims
     decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
 
 tokenJWT :: Text -> Value -> Text
-tokenJWT secret claims = JWT.encodeSigned JWT.HS256 (JWT.secret secret) claimsSet
-  where
-    claimsSet = JWT.def {
-      JWT.unregisteredClaims = Data.Map.fromList claimsList
-    }
-    claimsList =  fromMaybe [] $ HashMap.toList <$> (claims ^? nth 0 . _Object)
+tokenJWT secret (Array a) = JWT.encodeSigned JWT.HS256 (JWT.secret secret)
+                               JWT.def { JWT.unregisteredClaims = fromHashMap o }
+                          where
+                            Object o = if V.null a then emptyObject else V.head a
+tokenJWT secret _          = tokenJWT secret emptyArray
+
+fromHashMap :: Object -> JWT.ClaimsMap
+fromHashMap = M.fromList . H.toList