Fix auth functions

src/Auth.hs

@@ -1,9 +1,9 @@
-import qualified Data.Aeson as JSON
+module Auth where
+
 import qualified Data.ByteString.Char8 as BS
 import Crypto.BCrypt
-import Control.Monad (mzero)
-import Control.Applicative ( (<$>), (<*>) )
 import Database.PostgreSQL.Simple
+import GHC.Int
 
 data AuthUser = AuthUser {
     userId :: String
@@ -11,13 +11,6 @@ data AuthUser = AuthUser {
   , userRole :: String
   }
 
-instance JSON.FromJSON AuthUser where
-  parseJSON (JSON.Object v) = AuthUser <$>
-                         v JSON..: "id" <*>
-                         v JSON..: "pass" <*>
-                         v JSON..: "role"
-  parseJSON _          = mzero
-
 type DbRole = BS.ByteString
 
 data LoginAttempt =
@@ -30,8 +23,25 @@ data LoginAttempt =
 checkPass :: BS.ByteString -> BS.ByteString -> Bool
 checkPass = validatePassword
 
-setRole :: Connection -> DbRole -> IO ()
+setRole :: Connection -> DbRole -> IO Int64
 setRole conn role = execute conn "set role ?" (Only role)
 
-resetRole :: Connection -> IO ()
+resetRole :: Connection -> IO Int64
 resetRole = flip execute_ "reset role"
+
+addUser :: Connection -> BS.ByteString -> BS.ByteString -> BS.ByteString -> IO Int64
+addUser c identity pass role = do
+  Just hashed <- hashPasswordUsingPolicy fastBcryptHashingPolicy pass
+  execute c
+    "insert into dbapi.auth (id, pass, rolname) values (?, ?, ?)"
+    (identity, hashed, role)
+
+signInRole :: Connection -> BS.ByteString -> BS.ByteString -> IO LoginAttempt
+signInRole c user pass = do
+  u <- query c "select pass, rolname from dbapi.auth where id = ?" $ Only user
+  return $ case u of
+    [[hashed, role]] ->
+      if checkPass hashed pass
+         then LoginSuccess role
+         else LoginFailed
+    _ -> LoginFailed