fb-persistent 0.1.2 → 0.1.3

raw patch · 2 files changed

+81/−4 lines, 2 filesdep +cerealdep +timePVP ok

version bump matches the API change (PVP)

Dependencies added: cereal, time

API changes (from Hackage documentation)

Files

• fb-persistent.cabal +3/−1
• src/Facebook/Persistent.hs +78/−3

@@ -1,5 +1,5 @@ name:              fb-persistent-version:           0.1.2+version:           0.1.3 license:           BSD3 license-file:      LICENSE author:            Felipe Lessa@@ -33,3 +33,5 @@       base       >= 4     && < 5     , fb         >= 0.7.1     , persistent >= 0.7   && < 0.10+    , cereal     == 0.3.*+    , time       == 1.4.*

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, GADTs #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | This package is meant to be imported as --@@ -8,13 +8,22 @@ -- the following orphan instances: -- -- @--- instance "PersistField" "Action" -- since 0.1+-- instance 'PersistField' 'Action'          -- since 0.1+-- instance 'PersistField' 'Id'              -- since 0.1.2+-- instance 'PersistField' 'AppAccessToken'  -- since 0.1.3+-- instance 'PersistField' 'UserAccessToken' -- since 0.1.3 -- @ module Facebook.Persistent () where -import Control.Applicative ((<$>))+import Control.Applicative ((<$>), (<*>))+import Data.String (fromString)+import Data.Int (Int64)+import Data.Word (Word8) import Database.Persist import Facebook+import qualified Data.Serialize as S+import qualified Data.Time.Clock as T+import qualified Data.Time.Clock.POSIX as T  -- | From @fb-persistent@.  Since 0.1. instance PersistField Action where@@ -35,3 +44,69 @@     fromPersistValue v = Id <$> fromPersistValue v     sqlType = sqlType . idCode     isNullable _ = False+++-- | From @fb-persistent@.  Since 0.1.3.  Note that your fields+-- should either be of type 'UserAccessToken' or+-- 'AppAccessToken', not a polymorphic @'AccessToken' kind@.+-- Expiration time of 'UserAccessToken'@s@ is saved with+-- precision of one second.+instance AccessTokenKind kind => PersistField (AccessToken kind) where+    toPersistValue = toPersistValue . S.runPut . accessTokenPut+    fromPersistValue v = do+      bs <- fromPersistValue v+      either (Left . fromString) Right (S.runGet accessTokenGet bs)+    sqlType = sqlType . S.runPut . accessTokenPut+    isNullable _ = False+++-- | Since 'AccessToken' is a GADT, our 'S.get' function needs a+-- type class in order to be implemented.  Which 'accessTokenGet'+-- gets used is chosen in compile-time.  As a bonus, we implement+-- 'S.put' in the same way.+class AccessTokenKind kind where+  accessTokenPut :: AccessToken kind -> S.Put+  accessTokenGet :: S.Get (AccessToken kind)++instance AccessTokenKind UserKind where+  accessTokenPut (UserAccessToken uid token expires) = do+    S.putWord8 0+    S.put uid+    S.put token+    putUTCTime expires+  accessTokenGet = do+    v <- S.getWord8+    case v of+      0 -> UserAccessToken <$> S.get <*> S.get <*> getUTCTime+      1 -> fail $ "fb-persistent: AccessToken: tried to decode an AppAccessToken as UserAccessToken."+      _ -> accessTokenUnknownVersion v++instance AccessTokenKind AppKind where+  accessTokenPut (AppAccessToken token) = do+    S.putWord8 1+    S.put token+  accessTokenGet = do+    v <- S.getWord8+    case v of+      1 -> AppAccessToken <$> S.get+      0 -> fail $ "fb-persistent: AccessToken: tried to decode an UserAccessToken as AppAccessToken."+      _ -> accessTokenUnknownVersion v+++putUTCTime :: T.UTCTime -> S.Put+putUTCTime = S.put . toInt64 . T.utcTimeToPOSIXSeconds+  where+    toInt64 :: T.POSIXTime -> Int64+    toInt64 = truncate++getUTCTime :: S.Get T.UTCTime+getUTCTime = T.posixSecondsToUTCTime . fromInt64 <$> S.get+  where+    fromInt64 :: Int64 -> T.POSIXTime+    fromInt64 = fromIntegral+++accessTokenUnknownVersion :: Monad m => Word8 -> m a+accessTokenUnknownVersion v =+  fail $ "fb-persistent: AccessToken: unknown version " ++ show v +++         ", are you using different versions of fb-persistent?"