haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Better getTime + putTime, added test

Browse Source
This commit is contained in:
Michael Snoyman 2010-05-16 11:23:45 +03:00
parent 022ead8b31
commit 0c9e2f94c0
1 changed files with 20 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
Yesod/Dispatch.hs
View File

@ -56,8 +56,11 @@ import Data.Serialize
#if TEST #if TEST
import Test.Framework (testGroup, Test) import Test.Framework (testGroup, Test)
import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.QuickCheck
import System.IO.Unsafe import System.IO.Unsafe
import Yesod.Content hiding (testSuite) import Yesod.Content hiding (testSuite)
import Data.Serialize.Get
import Data.Serialize.Put
#else #else
import Yesod.Content import Yesod.Content
#endif #endif
@ -321,21 +324,23 @@ instance Serialize SessionCookie where
return $ SessionCookie a b c return $ SessionCookie a b c
putTime :: Putter UTCTime putTime :: Putter UTCTime
putTime (UTCTime d t) = do putTime t@(UTCTime d _) = do
put $ toModifiedJulianDay d put $ toModifiedJulianDay d
put $ fromEnum t let ndt = diffUTCTime t $ UTCTime d 0
put $ toRational ndt
getTime :: Get UTCTime getTime :: Get UTCTime
getTime = do getTime = do
d <- get d <- get
t <- get ndt <- get
return $ UTCTime (ModifiedJulianDay d) (toEnum t) return $ fromRational ndt `addUTCTime` UTCTime (ModifiedJulianDay d) 0
#if TEST #if TEST
testSuite :: Test testSuite :: Test
testSuite = testGroup "Yesod.Dispatch" testSuite = testGroup "Yesod.Dispatch"
[ testProperty "encode/decode session" propEncDecSession [ testProperty "encode/decode session" propEncDecSession
, testProperty "get/put time" propGetPutTime
] ]
propEncDecSession :: [(String, String)] -> Bool propEncDecSession :: [(String, String)] -> Bool
@ -344,8 +349,18 @@ propEncDecSession session' = unsafePerformIO $ do
now <- getCurrentTime now <- getCurrentTime
let expire = addUTCTime 1 now let expire = addUTCTime 1 now
let rhost = B.pack "some host" let rhost = B.pack "some host"
val <- encodeSession key expire rhost session' let val = encodeSession key expire rhost session'
return $ Just session' == return $ Just session' ==
decodeSession key now rhost (B.pack val) decodeSession key now rhost (B.pack val)
propGetPutTime :: UTCTime -> Bool
propGetPutTime t = Right t == runGet getTime (runPut $ putTime t)
instance Arbitrary UTCTime where
arbitrary = do
a <- arbitrary
b <- arbitrary
return $ addUTCTime (fromRational b)
$ UTCTime (ModifiedJulianDay a) 0
#endif #endif