diff --git a/src/PgQuery.hs b/src/PgQuery.hs index 5e1e431e8..dea023907 100644 --- a/src/PgQuery.hs +++ b/src/PgQuery.hs @@ -6,6 +6,7 @@ module PgQuery ( getRows, insert, upsert, + addUser, RangedResult(..), ) where @@ -28,7 +29,7 @@ import Database.HDBC.PostgreSQL import qualified Network.HTTP.Types.URI as Net -import Types (SqlRow, getRow, sqlRowColumns, sqlRowValues) +import Types (SqlRow(..), getRow, sqlRowColumns, sqlRowValues) import Debug.Trace @@ -122,6 +123,12 @@ insert schema table row conn = do Just m <- fetchRowMap stmt return m +addUser :: String -> String -> Connection -> IO () +addUser identity role conn = + insert "dbapi" "auth" (SqlRow [ + ("id", toSql identity), ("rolname", toSql role) + ]) conn >> return () + upsert :: Schema -> Text -> SqlRow -> Net.Query -> Connection -> IO (M.Map String SqlValue) upsert schema table row qq conn = do sql <- populateSql conn $ upsertClause schema table row qq diff --git a/test/Unit/PgQuerySpec.hs b/test/Unit/PgQuerySpec.hs index dde03c47e..ee2d7e8d3 100644 --- a/test/Unit/PgQuerySpec.hs +++ b/test/Unit/PgQuerySpec.hs @@ -4,10 +4,10 @@ module Unit.PgQuerySpec where import Test.Hspec -import Database.HDBC (IConnection, SqlValue, toSql, prepare, execute, - seState, fetchAllRowsAL) +import Database.HDBC (IConnection, SqlValue, toSql, fromSql, prepare, execute, + seState, fetchAllRowsAL, quickQuery) -import PgQuery (insert) +import PgQuery (insert, addUser) import Types (SqlRow(SqlRow)) import TestTypes (fromList, incStr, incNullableStr, incInsert, incId) import Data.Map (toList) @@ -50,5 +50,8 @@ spec = around dbWithSchema $ do `shouldThrow` \e -> seState e == "23502" describe "addUser" $ do - it "adds a correct user to the right table" $ \_ -> do - pending + it "adds a correct user to the right table" $ \conn -> do + let {key = "a sill key"; role = "test_default_role"} + addUser key role conn + [newUser] <- quickQuery conn "select * from dbapi.auth" [] + (map fromSql newUser :: [String]) `shouldBe` [key, role]