addUser function.

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

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]