Upgrade hasql to 0.4.0

src/App.hs

@@ -29,7 +29,6 @@ import Data.Aeson
 import Data.Coerce
 import Data.Monoid
 import qualified Hasql as H
-import qualified Hasql.Backend as HB
 import qualified Hasql.Postgres as H
 
 import PgQuery
@@ -37,7 +36,7 @@ import RangeQuery
 import PgStructure
 import Auth
 
-app :: Request -> H.Session H.Postgres IO Response
+app :: Request -> H.Session H.Postgres s IO Response
 app req =
   case (path, verb) of
     ([], _) -> do
@@ -169,12 +168,12 @@ app req =
     allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
 
 
-isSqlError :: HB.Error -> Maybe HB.Error
-isSqlError (HB.ErroneousResult x) = Just $ HB.ErroneousResult x
+isSqlError :: H.Error -> Maybe H.Error
+isSqlError (H.ErroneousResult x) = Just $ H.ErroneousResult x
 isSqlError _ = Nothing
 
-sqlErrHandler :: HB.Error -> IO Response
-sqlErrHandler (HB.ErroneousResult err) =
+sqlErrHandler :: H.Error -> IO Response
+sqlErrHandler (H.ErroneousResult err) =
   return $ if "42P01" `isInfixOf` err
     then responseLBS status404 [] ""
     else responseLBS status400 [] (cs err)

src/Auth.hs

@@ -50,7 +50,7 @@ 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 IO ()
+addUser :: Text -> Text -> Text -> H.Session H.Postgres s IO ()
 addUser identity pass role = do
   Just hashed <- liftIO $ hashPasswordUsingPolicy fastBcryptHashingPolicy (cs pass)
   H.tx Nothing $ H.unit $

src/Main.hs

@@ -7,7 +7,6 @@ import Middleware
 
 import Control.Monad (unless)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Reader (runReaderT, ask)
 import Control.Exception
 import Data.String.Conversions (cs)
 import Data.List.Split (splitOn)
@@ -51,12 +50,10 @@ main = do
         . gzip def . cors corsPolicy . clientErrors
         . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
 
-  H.session pgSettings sessSettings $ do
-    session' <- flip runReaderT <$> ask
-
+  H.session pgSettings sessSettings $ H.sessionUnlifter >>= \unlift ->
     liftIO $ runSettings appSettings $ middle $ \req respond ->
       respond =<< catchJust isSqlError
-        (session' $ authenticated (cs $ configAnonRole conf) app req)
+        (unlift $ authenticated (cs $ configAnonRole conf) app req)
         sqlErrHandler
 
   where

src/Middleware.hs

@@ -38,8 +38,8 @@ import Debug.Trace
 --     else Database.PostgreSQL.Simple.withSavepoint conn go
 --   where go = app conn req respond
 
-authenticated :: Text -> (Request -> H.Session H.Postgres IO Response) ->
-       Request -> H.Session H.Postgres IO Response
+authenticated :: Text -> (Request -> H.Session H.Postgres s IO Response) ->
+       Request -> H.Session H.Postgres s IO Response
 authenticated anon app req = do
   attempt <- httpRequesterRole (requestHeaders req)
   case attempt of
@@ -51,7 +51,7 @@ authenticated anon app req = do
     NoCredentials -> runInRole anon
 
  where
-   httpRequesterRole :: RequestHeaders -> H.Session H.Postgres IO LoginAttempt
+   httpRequesterRole :: RequestHeaders -> H.Session H.Postgres s IO LoginAttempt
    httpRequesterRole hdrs = do
     let auth = fromMaybe "" $ lookup hAuthorization hdrs
     case split (==' ') (cs auth) of
@@ -61,7 +61,6 @@ authenticated anon app req = do
           _ -> return MalformedAuth
       _ -> return NoCredentials
 
-   runInRole :: Text -> H.Session H.Postgres IO Response
    runInRole r = do
      H.tx Nothing $ setRole r
      resp <- app req