Re-enable authentication

src/Auth.hs

@@ -1,20 +1,23 @@
-{-# LANGUAGE QuasiQuotes, ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, OverloadedStrings #-}
 module Auth where
 
 import Data.Aeson
 import Control.Monad (mzero)
 import Control.Applicative ( (<*>), (<$>) )
+import Control.Monad.IO.Class (liftIO)
 import Crypto.BCrypt
 import Data.Text
+import Data.Monoid
 import qualified Hasql as H
 import qualified Hasql.Postgres as H
 import Data.String.Conversions (cs)
+import PgQuery (pgFmtLit)
 
 data AuthUser = AuthUser {
     userId :: String
   , userPass :: String
   , userRole :: String
-  }
+  } deriving (Show)
 
 instance FromJSON AuthUser where
   parseJSON (Object v) = AuthUser <$>
@@ -42,17 +45,17 @@ checkPass :: Text -> Text -> Bool
 checkPass = (. cs) . validatePassword . cs
 
 setRole :: Text -> H.Tx H.Postgres s ()
-setRole role = H.unit $ [H.q| set role ?|] role
+setRole role = H.unit ("set role " <> cs (pgFmtLit role), [], True)
 
 resetRole :: H.Tx H.Postgres s ()
 resetRole = H.unit [H.q|reset role|]
 
-addUser :: Text -> Text -> Text -> IO(H.Tx H.Postgres s ())
+addUser :: Text -> Text -> Text -> H.Session H.Postgres IO ()
 addUser identity pass role = do
-  Just hashed <- hashPasswordUsingPolicy fastBcryptHashingPolicy (cs pass)
-  return $ H.unit $
+  Just hashed <- liftIO $ hashPasswordUsingPolicy fastBcryptHashingPolicy (cs pass)
+  H.tx Nothing $ H.unit $
     [H.q|insert into dbapi.auth (id, pass, rolname) values (?, ?, ?)|]
-      identity hashed role
+      identity (cs hashed :: Text) role
 
 signInRole :: Text -> Text -> H.Tx H.Postgres s LoginAttempt
 signInRole user pass = do