Fix lint warnings
This commit is contained in:
+3
-3
@@ -26,18 +26,18 @@ import Network.URI (URI(..), parseURI)
|
|||||||
import PgQuery(LoginAttempt(..), signInRole, setRole, resetRole)
|
import PgQuery(LoginAttempt(..), signInRole, setRole, resetRole)
|
||||||
import Codec.Binary.Base64.String (decode)
|
import Codec.Binary.Base64.String (decode)
|
||||||
|
|
||||||
inTransaction :: (Connection -> Application) -> (Connection -> Application)
|
inTransaction :: (Connection -> Application) -> Connection -> Application
|
||||||
inTransaction app conn req respond =
|
inTransaction app conn req respond =
|
||||||
finally (runRaw conn "begin" >> app conn req respond) (runRaw conn "commit")
|
finally (runRaw conn "begin" >> app conn req respond) (runRaw conn "commit")
|
||||||
|
|
||||||
withSavepoint :: (Connection -> Application) -> (Connection -> Application)
|
withSavepoint :: (Connection -> Application) -> Connection -> Application
|
||||||
withSavepoint app conn req respond = do
|
withSavepoint app conn req respond = do
|
||||||
runRaw conn "savepoint req_sp"
|
runRaw conn "savepoint req_sp"
|
||||||
catch (app conn req respond) (\e -> let _ = (e::SomeException) in
|
catch (app conn req respond) (\e -> let _ = (e::SomeException) in
|
||||||
runRaw conn "rollback to savepoint req_sp" >> throw e)
|
runRaw conn "rollback to savepoint req_sp" >> throw e)
|
||||||
|
|
||||||
authenticated :: BS.ByteString -> (Connection -> Application) ->
|
authenticated :: BS.ByteString -> (Connection -> Application) ->
|
||||||
(Connection -> Application)
|
Connection -> Application
|
||||||
authenticated anon app conn req respond = do
|
authenticated anon app conn req respond = do
|
||||||
attempt <- httpRequesterRole (requestHeaders req)
|
attempt <- httpRequesterRole (requestHeaders req)
|
||||||
case attempt of
|
case attempt of
|
||||||
|
|||||||
@@ -12,7 +12,7 @@ import SpecHelper
|
|||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = around appWithFixture $
|
spec = around appWithFixture $
|
||||||
describe "authorization" $ do
|
describe "authorization" $ do
|
||||||
it "hides tables that anonymous does not own" $ do
|
it "hides tables that anonymous does not own" $
|
||||||
get "/authors_only" `shouldRespondWith` 400 -- TODO: should be 404
|
get "/authors_only" `shouldRespondWith` 400 -- TODO: should be 404
|
||||||
it "indicates login failure" $ do
|
it "indicates login failure" $ do
|
||||||
let auth = authHeader "dbapi_test_author_a" "fakefake"
|
let auth = authHeader "dbapi_test_author_a" "fakefake"
|
||||||
|
|||||||
@@ -47,7 +47,7 @@ spec = around appWithFixture $ do
|
|||||||
incNullableStr record `shouldBe` Nothing
|
incNullableStr record `shouldBe` Nothing
|
||||||
|
|
||||||
context "into a table with simple pk" $
|
context "into a table with simple pk" $
|
||||||
it "fails with 400 and error" $ do
|
it "fails with 400 and error" $
|
||||||
post "/simple_pk" [json| { "extra":"foo"} |]
|
post "/simple_pk" [json| { "extra":"foo"} |]
|
||||||
`shouldRespondWith` 400
|
`shouldRespondWith` 400
|
||||||
|
|
||||||
|
|||||||
@@ -21,9 +21,9 @@ spec = let
|
|||||||
runRaw conn "select 1/0"
|
runRaw conn "select 1/0"
|
||||||
_ <- insert "1" "items" (SqlRow []) conn
|
_ <- insert "1" "items" (SqlRow []) conn
|
||||||
res $ responseLBS ok200 [("Content-Type", "application/json")] "{}"
|
res $ responseLBS ok200 [("Content-Type", "application/json")] "{}"
|
||||||
in around dbWithSchema $ do
|
in around dbWithSchema $
|
||||||
|
|
||||||
describe "withSavepoint" $ do
|
describe "withSavepoint" $
|
||||||
it "allows partial rollback of request" $ \c -> do
|
it "allows partial rollback of request" $ \c -> do
|
||||||
let app = withSavepoint dbErrApp c
|
let app = withSavepoint dbErrApp c
|
||||||
[[beforeCount]] <- quickQuery c "select count(*) from \"1\".items" []
|
[[beforeCount]] <- quickQuery c "select count(*) from \"1\".items" []
|
||||||
|
|||||||
Reference in New Issue
Block a user