From 2c635cfde8010b17be4d0d85d34e45679fb771ee Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Mon, 29 Dec 2014 09:39:13 -0800
Subject: [PATCH] Optimization when auth role coincides with anon role

No need to set/reset role because it is already correct
---
 postgrest.cabal    |  2 +-
 src/Main.hs        |  3 ++-
 src/Middleware.hs  | 24 ++++++------------------
 test/SpecHelper.hs |  5 +++--
 4 files changed, 12 insertions(+), 22 deletions(-)

diff --git a/postgrest.cabal b/postgrest.cabal
index a8e8c6b93..a195a5c67 100644
--- a/postgrest.cabal
+++ b/postgrest.cabal
@@ -1,5 +1,5 @@
 name:                  postgrest
-version:               0.2.4.8
+version:               0.2.4.9
 synopsis:              The database is your api
 license:               MIT
 license-file:          LICENSE
diff --git a/src/Main.hs b/src/Main.hs
index edded4718..224ccf008 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -49,13 +49,14 @@ main = do
         . gzip def . cors corsPolicy
         . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
       anonRole = cs $ configAnonRole conf
+      currRole = cs $ configDbUser conf
 
   H.session pgSettings sessSettings $ H.sessionUnlifter >>= \unlift ->
     liftIO $ runSettings appSettings $ middle $ \req respond -> do
       body <- strictRequestBody req
       respond =<< catchJust isSqlError
         (unlift $ H.tx Nothing
-                $ authenticated anonRole (app body) req)
+                $ authenticated currRole anonRole (app body) req)
         (return . sqlError)
 
   where
diff --git a/src/Middleware.hs b/src/Middleware.hs
index df963f7aa..2d0310e91 100644
--- a/src/Middleware.hs
+++ b/src/Middleware.hs
@@ -22,30 +22,18 @@ import Network.URI (URI(..), parseURI)
 import Auth (LoginAttempt(..), signInRole, setRole, resetRole)
 import Codec.Binary.Base64.String (decode)
 
--- data Environment = Test | Production deriving (Eq)
-
--- safeAction :: Request -> Bool
--- safeAction = (`notElem` ["PATCH", "PUT"]) . requestMethod
-
--- withSavepoint :: Environment -> (Connection -> Application) ->
---                  Connection -> Application
--- withSavepoint env app conn req respond =
---   if env == Production && safeAction req
---     then go
---     else Database.PostgreSQL.Simple.withSavepoint conn go
---   where go = app conn req respond
-
-authenticated :: forall s. Text -> (Request -> H.Tx H.Postgres s Response) ->
-       Request -> H.Tx H.Postgres s Response
-authenticated anon app req = do
+authenticated :: forall s. Text -> Text ->
+                 (Request -> H.Tx H.Postgres s Response) ->
+                 Request -> H.Tx H.Postgres s Response
+authenticated currentRole anon app req = do
   attempt <- httpRequesterRole (requestHeaders req)
   case attempt of
     MalformedAuth ->
       return $ responseLBS status400 [] "Malformed basic auth header"
     LoginFailed ->
       return $ responseLBS status401 [] "Invalid username or password"
-    LoginSuccess role -> runInRole role
-    NoCredentials -> runInRole anon
+    LoginSuccess role -> if role /= currentRole then runInRole role else app req
+    NoCredentials ->     if anon /= currentRole then runInRole anon else app req
 
  where
    httpRequesterRole :: RequestHeaders -> H.Tx H.Postgres s LoginAttempt
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index 47f85a458..4b26b4f98 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -44,14 +44,15 @@ pgSettings = H.ParamSettings "localhost" 5432 "postgrest_test" "" "postgrest_tes
 
 withApp :: ActionWith Application -> IO ()
 withApp perform =
-  let anonRole = cs $ configAnonRole cfg in
+  let anonRole = cs $ configAnonRole cfg
+      currRole = cs $ configDbUser cfg in
   perform $ middle $ \req resp ->
     H.session pgSettings testSettings $ H.sessionUnlifter >>= \unlift ->
       liftIO $ do
         body <- strictRequestBody req
         resp =<< catchJust isSqlError
           (unlift $ H.tx Nothing
-                  $ authenticated anonRole (app body) req)
+                  $ authenticated currRole anonRole (app body) req)
           (return . sqlError)
 
   where middle = cors corsPolicy