Add /dbapi/users route for creating new user

src/Dbapi.hs

@@ -5,7 +5,7 @@ module Dbapi where
 
 import Types (SqlRow, getRow)
 
-import Control.Monad (join)
+import Control.Monad (join, mzero)
 import Control.Arrow ((***))
 import Control.Applicative
 import Options.Applicative hiding (columns)
@@ -51,6 +51,19 @@ data AppConfig = AppConfig {
   , configSecure :: Bool
   }
 
+data AuthUser = AuthUser {
+    userId :: String
+  , userPass :: String
+  , userRole :: String
+  }
+
+instance JSON.FromJSON AuthUser where
+  parseJSON (JSON.Object v) = AuthUser <$>
+                         v JSON..: "id" <*>
+                         v JSON..: "pass" <*>
+                         v JSON..: "role"
+  parseJSON _          = mzero
+
 jsonContentType :: (HeaderName, BS.ByteString)
 jsonContentType = (hContentType, "application/json")
 
@@ -76,6 +89,20 @@ app conn req respond =
     ([], _) ->
       responseLBS status200 [jsonContentType] <$> printTables ver conn
 
+    (["dbapi", "users"], "POST") -> do
+      body <- strictRequestBody req
+      let parse = JSON.eitherDecode body
+
+      case parse of
+        Left err -> return $ responseLBS status400 [jsonContentType] json
+          where json = JSON.encode . JSON.object $ [("error", JSON.String $ "Failed to parse JSON payload. " <> cs err) ]
+        Right u -> do
+          addUser (cs $ userId u) (cs $ userPass u) (cs $ userRole u) conn
+          return $ responseLBS status201
+            [ jsonContentType
+            , (hLocation, "/dbapi/users?id=eq." <> cs (userId u))
+            ] ""
+
     ([table], "OPTIONS") ->
       responseLBS status200 [jsonContentType, allOrigins] <$>
         printColumns ver (cs table) conn

src/PgQuery.hs

@@ -170,10 +170,10 @@ insert schema table row conn = do
 
 addUser :: BS.ByteString -> BS.ByteString -> BS.ByteString -> Connection -> IO ()
 addUser identity pass role conn = do
-  hashed <- hashPasswordUsingPolicy fastBcryptHashingPolicy $ cs pass
+  Just hashed <- hashPasswordUsingPolicy fastBcryptHashingPolicy $ cs pass
-  _ <- insert "dbapi" "auth" (SqlRow [
+  _ <- quickQuery conn
-      ("id", toSql identity), ("pass", toSql hashed), ("rolname", toSql role)
+         "insert into dbapi.auth (id, pass, rolname) values (?, ?, ?)"
-    ]) conn
+         $ map toSql [identity, hashed, role]
   return ()
 
 signInRole :: BS.ByteString -> BS.ByteString -> Connection -> IO LoginAttempt

test/Feature/AuthSpec.hs

@@ -1,9 +1,10 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
 module Feature.AuthSpec where
 
 -- {{{ Imports
 import Test.Hspec
 import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
 import Network.HTTP.Types
 
 import SpecHelper
@@ -15,10 +16,11 @@ spec = around appWithFixture $
     it "hides tables that anonymous does not own" $
       get "/authors_only" `shouldRespondWith` 400 -- TODO: should be 404
     it "indicates login failure" $ do
-      let auth = authHeader "dbapi_test_author_a" "fakefake"
+      let auth = authHeader "dbapi_test_author" "fakefake"
       request methodGet "/authors_only" [auth] ""
         `shouldRespondWith` 401
-    -- it "allows users with permissions to see their tables" $ do
+    it "allows users with permissions to see their tables" $ do
-    --   let auth = authHeader "dbapi_test_author_a" ""
+      _ <- post "/dbapi/users" [json| { "id":"jdoe", "pass": "1234", "role": "dbapi_test_author" } |]
-    --   request methodGet "/authors_only" [auth] ""
+      let auth = authHeader "jdoe" "1234"
-    --     `shouldRespondWith` 200
+      request methodGet "/authors_only" [auth] ""
+        `shouldRespondWith` 200

test/fixtures/roles.sql

@@ -15,5 +15,3 @@ select pg_temp.create_role_if_not_exists('dbapi_anonymous', 'with nologin');
 select pg_temp.create_role_if_not_exists('test_default_role', 'with nologin');
 
 select pg_temp.create_role_if_not_exists('dbapi_test_author', 'with nologin');
-select pg_temp.create_role_if_not_exists('dbapi_test_author_a', 'with nologin in role dbapi_test_author');
-select pg_temp.create_role_if_not_exists('dbapi_test_author_b', 'with nologin in role dbapi_test_author');

test/fixtures/schema.sql

@@ -291,6 +291,9 @@ CREATE TABLE auth (
 
 ALTER TABLE dbapi.auth OWNER TO dbapi_test;
 
+REVOKE ALL ON TABLE dbapi.auth FROM dbapi_anonymous;
+GRANT INSERT ON TABLE dbapi.auth TO dbapi_anonymous;
+
 SET search_path = private, pg_catalog;
 
 --
@@ -597,8 +600,15 @@ ALTER TABLE ONLY has_fk
 
 REVOKE ALL ON SCHEMA "1" FROM dbapi_test;
 GRANT ALL ON SCHEMA "1" TO dbapi_test;
+
+REVOKE ALL ON SCHEMA "1" FROM dbapi_anonymous;
 GRANT USAGE ON SCHEMA "1" TO dbapi_anonymous;
 
+REVOKE ALL ON SCHEMA "dbapi" FROM dbapi_anonymous;
+GRANT USAGE ON SCHEMA "dbapi" TO dbapi_anonymous;
+
+REVOKE ALL ON SCHEMA "1" FROM dbapi_test_author;
+GRANT USAGE ON SCHEMA "1" TO dbapi_test_author;
 
 --
 -- TOC entry 2036 (class 0 OID 0)