jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

First draft of big auth simplification

Browse Source
This commit is contained in:
Diogo Biazus
2015-10-16 15:55:47 -04:00
parent 2c67b8d7ba
commit 3add3f5b6c
5 changed files with 42 additions and 121 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/App.hs
+4 -39
View File
@@ -57,12 +57,12 @@ import PostgREST.Types
import Prelude
app :: DbStructure -> AppConfig -> DbRole -> BL.ByteString -> DbRole -> Request -> H.Tx P.Postgres s Response
app dbstructure conf authenticator reqBody dbrole req =
app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response
app dbstructure conf reqBody req =
case (path, verb) of
([], _) -> do
let body = encode $ filter (filterTableAcl dbrole) $ filter ((cs schema==).tableSchema) allTabs
let body = encode $ filter ((cs schema==).tableSchema) allTabs
return $ responseLBS status200 [jsonH] $ cs body
([table], "OPTIONS") -> do
@@ -130,41 +130,6 @@ app dbstructure conf authenticator reqBody dbrole req =
countQuery = requestToCountQuery schema <$> apiRequest
queries = (,) <$> query <*> countQuery
(["postgrest", "users"], "POST") -> do
let user = decode reqBody :: Maybe AuthUser
case user of
Nothing -> return $ responseLBS status400 [jsonH] $
encode . object $ [("message", String "Failed to parse user.")]
Just u -> do
_ <- addUser (cs $ userId u)
(cs $ userPass u) (cs <$> userRole u)
return $ responseLBS status201
[ jsonH
, (hLocation, "/postgrest/users?id=eq." <> cs (userId u))
] ""
(["postgrest", "tokens"], "POST") ->
case jwtSecret of
"secret" -> return $ responseLBS status500 [jsonH] $
encode . object $ [("message", String "JWT Secret is set as \"secret\" which is an unsafe default.")]
_ -> do
let user = decode reqBody :: Maybe AuthUser
case user of
Nothing -> return $ responseLBS status400 [jsonH] $
encode . object $ [("message", String "Failed to parse user.")]
Just u -> do
setRole authenticator
login <- signInRole (cs $ userId u) (cs $ userPass u)
case login of
LoginSuccess role uid ->
return $ responseLBS status201 [ jsonH ] $
encode . object $ [("token", String $ tokenJWT jwtSecret uid role)]
_ -> return $ responseLBS status401 [jsonH] $
encode . object $ [("message", String "Failed authentication.")]
([table], "POST") -> do
let qt = qualify table
echoRequested = hasPrefer "return=representation"
@@ -295,7 +260,7 @@ app dbstructure conf authenticator reqBody dbrole req =
hasPrefer val = any (\(h,v) -> h == "Prefer" && v == val) hdrs
accept = lookupHeader hAccept
schema = cs $ configSchema conf
jwtSecret = cs $ configJwtSecret conf
jwtSecret = (cs $ configJwtSecret conf) :: Text
range = rangeRequested hdrs
allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
contentType = fromMaybe "application/json" $ contentTypeForAccept accept
src/PostgREST/Auth.hs
+17 -46
View File
@@ -1,23 +1,24 @@
{-# LANGUAGE FlexibleContexts #-}
module PostgREST.Auth where
import Control.Applicative
import Control.Monad (mzero)
import Crypto.BCrypt
import Data.Aeson
import Data.Map
import Data.Map (lookup, fromList, toList)
import Data.Monoid
import Data.String.Conversions (cs)
import Data.Text
import Data.Maybe (isNothing)
import Data.Text (Text)
import qualified Data.Vector as V
import qualified Hasql as H
import qualified Hasql.Backend as B
import qualified Hasql.Postgres as P
import PostgREST.PgQuery (pgFmtLit)
import Prelude
import Prelude
import qualified Web.JWT as JWT
import System.IO.Unsafe
data AuthUser = AuthUser {
userId :: String
@@ -48,51 +49,21 @@ data LoginAttempt =
| LoginSuccess DbRole UserId
deriving (Eq, Show)
checkPass :: Text -> Text -> Bool
checkPass = (. cs) . validatePassword . cs
setJWTEnv :: Text -> Text -> Maybe [Text]
setJWTEnv secret input = setDBEnv $ jwtClaims secret input
setRole :: Text -> H.Tx P.Postgres s ()
setRole role = H.unitEx $ B.Stmt ("set local role " <> cs (pgFmtLit role)) V.empty True
setDBEnv :: Maybe JWT.ClaimsMap -> Maybe [Text]
setDBEnv maybeClaims =
(map setVar . toList) <$> maybeClaims
where
setVar ("role", String val) = setRole val
setVar (key, String val) = "set local postgrest." <> key <> " = " <> cs (pgFmtLit val) <> ";"
setUserId :: Text -> H.Tx P.Postgres s ()
setUserId uid =
if uid /= ""
then H.unitEx $ B.Stmt ("set local user_vars.user_id = " <> cs (pgFmtLit uid)) V.empty True
else resetUserId
setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
resetUserId :: H.Tx P.Postgres s ()
resetUserId = H.unitEx [H.stmt|reset user_vars.user_id|]
addUser :: Text -> Text -> Maybe Text -> H.Tx P.Postgres s ()
addUser identity pass role =
H.unitEx $
if isNothing role
then [H.stmt|insert into postgrest.auth (id, pass) values (?, ?)|]
identity hashedText
else [H.stmt|insert into postgrest.auth (id, pass, rolname) values (?, ?, ?)|]
identity hashedText role
where Just hashed = unsafePerformIO $ hashPasswordUsingPolicy fastBcryptHashingPolicy (cs pass)
hashedText = cs hashed :: Text
signInRole :: Text -> Text -> H.Tx P.Postgres s LoginAttempt
signInRole user pass = do
u <- H.maybeEx $ [H.stmt|select id, pass, rolname from postgrest.auth where id = ?|] user
return $ maybe LoginFailed (\r ->
let (uid, hashed, role) = r in
if checkPass hashed pass
then LoginSuccess role uid
else LoginFailed
) u
signInWithJWT :: Text -> Text -> LoginAttempt
signInWithJWT secret input = case maybeRole of
Just (Just (String role)) -> case maybeUserId of
Just (Just (String uid)) -> LoginSuccess (cs role) (cs uid)
_ -> LoginFailed
_ -> LoginFailed
jwtClaims :: Text -> Text -> Maybe JWT.ClaimsMap
jwtClaims secret input = claims
where
maybeRole = (Data.Map.lookup "role" <$> claims) ::Maybe (Maybe Value)
maybeUserId = (Data.Map.lookup "id" <$> claims) ::Maybe (Maybe Value)
claims = JWT.unregisteredClaims <$> JWT.claims <$> decoded
decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
src/PostgREST/Main.hs
+1 -1
View File
@@ -98,5 +98,5 @@ main = do
runSettings appSettings $ middle $ \ req respond -> do
body <- strictRequestBody req
resOrError <- liftIO $ H.session pool $ H.tx txSettings $
authenticated conf authenticator (app dbstructure conf authenticator body) req
runWithClaims conf (app dbstructure conf body) req
either (respond . errResponse) respond resOrError
src/PostgREST/Middleware.hs
+19 -34
View File
@@ -27,46 +27,31 @@ import Network.Wai.Middleware.Static (only, staticPolicy)
import Codec.Binary.Base64.String (decode)
import PostgREST.App (contentTypeForAccept)
import PostgREST.Auth (DbRole, LoginAttempt (..),
setRole, setUserId, signInRole,
signInWithJWT)
setRole, setJWTEnv)
import PostgREST.Config (AppConfig (..), corsPolicy)
import Prelude
import Prelude hiding(concat)
import qualified Web.JWT as JWT
authenticated :: forall s. AppConfig -> DbRole ->
(DbRole -> Request -> H.Tx P.Postgres s Response) ->
import qualified Data.Vector as V
import qualified Hasql.Backend as B
runWithClaims :: forall s. AppConfig ->
(Request -> H.Tx P.Postgres s Response) ->
Request -> H.Tx P.Postgres s Response
authenticated conf authenticator 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 uid -> if role /= authenticator then runInRole role uid else app authenticator req
NoCredentials -> if anon /= authenticator then runInRole anon "" else app authenticator req
runWithClaims conf app req = do
H.unitEx $ B.Stmt env V.empty True
app req
where
jwtSecret = cs $ configJwtSecret conf
hdrs = requestHeaders req
jwtSecret = (cs $ configJwtSecret conf) :: Text
auth = fromMaybe "" $ lookup hAuthorization hdrs
anon = cs $ configAnonRole conf
httpRequesterRole :: RequestHeaders -> H.Tx P.Postgres s LoginAttempt
httpRequesterRole hdrs = do
let auth = fromMaybe "" $ lookup hAuthorization hdrs
case split (==' ') (cs auth) of
("Basic" : b64 : _) ->
case split (==':') (cs . decode . cs $ b64) of
(u:p:_) -> signInRole u p
_ -> return MalformedAuth
("Bearer" : jwt : _) ->
return $ signInWithJWT jwtSecret jwt
_ -> return NoCredentials
runInRole :: Text -> Text -> H.Tx P.Postgres s Response
runInRole r uid = do
setUserId uid
setRole r
app r req
jwtEnv =
case split (==' ') (cs auth) of
("Bearer" : jwt : _) -> fromMaybe [] (setJWTEnv jwtSecret jwt)
_ -> []
env = concat $ setRole anon : jwtEnv
redirectInsecure :: Application -> Application
redirectInsecure app req respond = do
test/SpecHelper.hs
+1 -1
View File
@@ -80,7 +80,7 @@ withApp perform = do
perform $ middle $ \req resp -> do
body <- strictRequestBody req
result <- liftIO $ H.session pool $ H.tx txSettings
$ authenticated cfg authenticator (app dbstructure cfg authenticator body) req
$ runWithClaims cfg (app dbstructure cfg body) req
either (resp . errResponse) resp result
where middle = defaultMiddle False