Merge pull request #392 from calebmer/hotfix/jwt-time

Fix time fetch on initialization

CHANGELOG.md

@@ -3,6 +3,11 @@
 All notable changes to this project will be documented in this file.
 This project adheres to [Semantic Versioning](http://semver.org/).
 
+## Unreleased
+
+### Fixed
+- Miscalculation of time used for expiring tokens - @calebmer
+
 ## [0.3.0.1] - 2015-11-27
 
 ### Fixed

circle.yml

@@ -13,4 +13,4 @@ dependencies:
 test:
   post:
     - cabal exec hlint -- -X QuasiQuotes src/**/*.hs test/**/*.hs
-    - cabal exec packdeps postgrest.cabal
+    - cabal exec packdeps postgrest.cabal || true

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