Fix time fetch on initialization

src/PostgREST/Main.hs

@@ -17,6 +17,7 @@ import           Data.Functor.Identity
 import           Data.Monoid                          ((<>))
 import           Data.String.Conversions              (cs)
 import           Data.Text                            (Text)
+import           Data.Time.Clock.POSIX                (getPOSIXTime)
 import qualified Hasql                                as H
 import qualified Hasql.Postgres                       as P
 import           Network.Wai
@@ -73,7 +74,8 @@ main = do
   dbStructure <- either hasqlError return dbOrError
 
   runSettings appSettings $ middle $ \ req respond -> do
+    time <- getPOSIXTime
     body <- strictRequestBody req
     resOrError <- liftIO $ H.session pool $ H.tx txSettings $
-      runWithClaims conf (app dbStructure conf body) req
+      runWithClaims conf time (app dbStructure conf body) req
     either (respond . pgErrResponse) respond resOrError

src/PostgREST/Middleware.hs

@@ -6,7 +6,7 @@ module PostgREST.Middleware where
 import           Data.Maybe                    (fromMaybe)
 import           Data.Text
 import           Data.String.Conversions       (cs)
-import           Data.Time.Clock.POSIX         (getPOSIXTime)
+import           Data.Time.Clock               (NominalDiffTime)
 import qualified Hasql                         as H
 import qualified Hasql.Postgres                as P
 
@@ -23,20 +23,17 @@ import           PostgREST.Auth                (setRole, jwtClaims, claimsToSQL)
 import           PostgREST.Config              (AppConfig (..), corsPolicy)
 import           PostgREST.Error               (errResponse)
 
-import           System.IO.Unsafe              (unsafePerformIO)
-
 import           Prelude hiding(concat)
 
 import qualified Data.Vector             as V
 import qualified Hasql.Backend           as B
 import qualified Data.Map.Lazy           as M
 
-runWithClaims :: forall s. AppConfig ->
+runWithClaims :: forall s. AppConfig -> NominalDiffTime ->
                  (Request -> H.Tx P.Postgres s Response) ->
                  Request -> H.Tx P.Postgres s Response
-runWithClaims conf app req = do
+runWithClaims conf time app req = do
     _ <- H.unitEx $ stmt setAnon
-    let time = unsafePerformIO getPOSIXTime
     case split (== ' ') (cs auth) of
       ("Bearer" : tokenStr : _) ->
         case jwtClaims jwtSecret tokenStr time of

test/SpecHelper.hs

@@ -12,6 +12,7 @@ import Data.String.Conversions (cs)
 import Data.Monoid
 import Data.Text hiding (map)
 import qualified Data.Vector as V
+import Data.Time.Clock.POSIX (getPOSIXTime)
 import Control.Monad (void)
 import Control.Applicative
 
@@ -59,9 +60,10 @@ withApp perform = do
   db <- either (fail . show) return dbOrError
 
   perform $ middle $ \req resp -> do
+    time <- getPOSIXTime
     body <- strictRequestBody req
     result <- liftIO $ H.session pool $ H.tx txSettings
-      $ runWithClaims cfg (app db cfg body) req
+      $ runWithClaims cfg time (app db cfg body) req
     either (resp . pgErrResponse) resp result
 
   where middle = defaultMiddle