Enclose entire app response in single Tx

src/Auth.hs

@@ -4,7 +4,6 @@ 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
@@ -13,6 +12,8 @@ import qualified Hasql.Postgres as H
 import Data.String.Conversions (cs)
 import PgQuery (pgFmtLit)
 
+import System.IO.Unsafe
+
 data AuthUser = AuthUser {
     userId :: String
   , userPass :: String
@@ -50,10 +51,10 @@ 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 -> H.Session H.Postgres s IO ()
+addUser :: Text -> Text -> Text -> H.Tx H.Postgres s ()
 addUser identity pass role = do
-  Just hashed <- liftIO $ hashPasswordUsingPolicy fastBcryptHashingPolicy (cs pass)
-  H.tx Nothing $ H.unit $
+  let Just hashed = unsafePerformIO $ hashPasswordUsingPolicy fastBcryptHashingPolicy (cs pass)
+  H.unit $
     [H.q|insert into dbapi.auth (id, pass, rolname) values (?, ?, ?)|]
       identity (cs hashed :: Text) role