module Facebook.Persistent () where
import Control.Applicative ((<$>), (<*>))
import Control.Monad (liftM)
import Data.String (fromString)
import Data.Text (Text)
import Data.Int (Int64)
import Data.Word (Word8)
import Database.Persist
import Database.Persist.Sql
import Facebook
import qualified Data.Serialize as S
import qualified Data.Text.Encoding as TE
import qualified Data.Time.Clock as T
import qualified Data.Time.Clock.POSIX as T
instance PersistField Action where
toPersistValue = toPersistValue . show
fromPersistValue v =
case fmap reads $ fromPersistValue v of
Right [(action,"")] -> Right action
Right _ -> Left "fromPersistValue[Facebook.Action]: \
\Could not parse action"
Left err -> Left err
instance PersistFieldSql Action where
sqlType = sqlType . liftM show
instance PersistField Id where
toPersistValue = toPersistValue . TE.encodeUtf8 . idCode
fromPersistValue v = Id . TE.decodeUtf8 <$> fromPersistValue v
instance PersistFieldSql Id where
sqlType = sqlType . liftM (TE.encodeUtf8 . idCode)
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)
instance AccessTokenKind kind => PersistFieldSql (AccessToken kind) where
sqlType = sqlType . liftM (S.runPut . accessTokenPut)
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
putId uid
putText token
putUTCTime expires
accessTokenGet = do
v <- S.getWord8
case v of
0 -> UserAccessToken <$> getId <*> getText <*> 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
putText token
accessTokenGet = do
v <- S.getWord8
case v of
1 -> AppAccessToken <$> getText
0 -> fail $ "fb-persistent: AccessToken: tried to decode an UserAccessToken as AppAccessToken."
_ -> accessTokenUnknownVersion v
getText :: S.Get Text
getText = TE.decodeUtf8 <$> S.get
putText :: Text -> S.Put
putText = S.put . TE.encodeUtf8
getId :: S.Get Id
getId = Id <$> getText
putId :: Id -> S.Put
putId = putText . idCode
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?"