Optimization when auth role coincides with anon role

No need to set/reset role because it is already correct

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

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