Makes JWT generation possible in RPC endpoints

Fixes SET execution to execute in separate statements as Hasql uses
prepared statements we need to send 1 commend per statement.

src/PostgREST/Auth.hs

@@ -1,53 +1,23 @@
 {-# LANGUAGE FlexibleContexts #-}
 module PostgREST.Auth (
-    DbRole
-  , LoginAttempt (..)
-  , setRole
+  setRole
   , setJWTEnv
+  , tokenJWT
   ) where
 
 import           Control.Applicative
-import           Control.Monad           (mzero)
-
 import           Data.Aeson
 import           Data.Map (fromList, toList)
+import           Data.Maybe (fromMaybe)
 import           Data.Monoid
 import           Data.String.Conversions (cs)
 import           Data.Text (Text)
 import           PostgREST.PgQuery       (pgFmtLit)
-import           Prelude 
+import           Prelude
 import qualified Web.JWT                 as JWT
-
-
-
-data AuthUser = AuthUser {
-    userId   :: String
-  , userPass :: String
-  , userRole :: Maybe String
-  } deriving (Show)
-
-instance FromJSON AuthUser where
-  parseJSON (Object v) = AuthUser <$>
-                         v .: "id" <*>
-                         v .: "pass" <*>
-                         v .:? "role"
-  parseJSON _ = mzero
-
-instance ToJSON AuthUser where
-  toJSON u = object [
-      "id" .= userId u
-    , "pass" .= userPass u
-    , "role" .= userRole u ]
-
-type DbRole = Text
-type UserId = Text
-
-data LoginAttempt =
-    NoCredentials
-  | MalformedAuth
-  | LoginFailed
-  | LoginSuccess DbRole UserId
-  deriving (Eq, Show)
+import qualified Data.HashMap.Lazy       as HashMap
+import Data.Aeson.Lens
+import Control.Lens.Operators
 
 setJWTEnv :: Text -> Text -> Maybe [Text]
 setJWTEnv secret input = setDBEnv $ jwtClaims secret input
@@ -57,9 +27,9 @@ setDBEnv maybeClaims =
   (map setVar . toList) <$> maybeClaims
   where
     setVar ("role", String val) = setRole val
-    setVar (key, String val) = "set local postgrest.claims" <> key <> " = " <> pgFmtLit val <> ";"
-    setVar (key, Bool val) = "set local postgrest.claims" <> key <> " = " <> showText val <> ";"
-    setVar (key, Number val) = "set local postgrest.claims" <> key <> " = " <> showText val <> ";"
+    setVar (k, String val) = "set local postgrest.claims." <> k <> " = " <> pgFmtLit val <> ";"
+    setVar (k, Bool val) = "set local postgrest.claims." <> k <> " = " <> showText val <> ";"
+    setVar (k, Number val) = "set local postgrest.claims." <> k <> " = " <> showText val <> ";"
     setVar _ = ""
     showText :: Show a => a -> Text
     showText = cs . show
@@ -73,9 +43,10 @@ jwtClaims secret input = claims
     claims = JWT.unregisteredClaims <$> JWT.claims <$> decoded
     decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
 
-tokenJWT :: Text -> Text -> Text -> Text
-tokenJWT secret uid role = JWT.encodeSigned JWT.HS256 (JWT.secret secret) claimsSet
+tokenJWT :: Text -> Value -> Text
+tokenJWT secret claims = JWT.encodeSigned JWT.HS256 (JWT.secret secret) claimsSet
   where
     claimsSet = JWT.def {
-      JWT.unregisteredClaims = Data.Map.fromList [("id", String uid), ("role", String role)]
+      JWT.unregisteredClaims = Data.Map.fromList claimsList
     }
+    claimsList =  fromMaybe [] $ HashMap.toList <$> (claims ^? nth 0 . _Object)