module Facebook.Types
( Credentials(..)
, appIdBS
, appSecretBS
, AccessToken(..)
, UserAccessToken
, AppAccessToken
, AccessTokenData
, Id(..)
, UserId
, accessTokenData
, accessTokenExpires
, accessTokenUserId
, UserKind
, AppKind
, Argument
, (<>)
, FbUTCTime(..)
) where
import Control.Applicative (pure)
import Data.ByteString (ByteString)
import Data.Int (Int64)
import Data.Monoid (Monoid, mappend)
import Data.String (IsString)
import Data.Text (Text)
import Data.Time (UTCTime, parseTime)
import Data.Typeable (Typeable, Typeable1)
import System.Locale (defaultTimeLocale)
import qualified Data.Aeson as A
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Text.Lazy.Builder.Int as TLBI
data Credentials =
Credentials { appName :: Text
, appId :: Text
, appSecret :: Text
}
deriving (Eq, Ord, Show, Read, Typeable)
appIdBS :: Credentials -> ByteString
appIdBS = TE.encodeUtf8 . appId
appSecretBS :: Credentials -> ByteString
appSecretBS = TE.encodeUtf8 . appSecret
data AccessToken kind where
UserAccessToken :: UserId -> AccessTokenData -> UTCTime -> AccessToken UserKind
AppAccessToken :: AccessTokenData -> AccessToken AppKind
type UserAccessToken = AccessToken UserKind
type AppAccessToken = AccessToken AppKind
deriving instance Eq (AccessToken kind)
deriving instance Ord (AccessToken kind)
deriving instance Show (AccessToken kind)
deriving instance Typeable1 AccessToken
type AccessTokenData = Text
newtype Id = Id { idCode :: Text }
deriving (Eq, Ord, Show, Read, Typeable, IsString)
instance A.FromJSON Id where
parseJSON (A.Object v) = v A..: "id"
parseJSON (A.String s) = pure $ Id s
parseJSON (A.Number d) = pure $ Id $ from $ floor d
where from i = TL.toStrict $ TLB.toLazyText $ TLBI.decimal (i :: Int64)
parseJSON o = fail $ "Can't parse Facebook.Id from " ++ show o
instance A.ToJSON Id where
toJSON (Id t) = A.String t
type UserId = Id
accessTokenData :: AccessToken anyKind -> AccessTokenData
accessTokenData (UserAccessToken _ d _) = d
accessTokenData (AppAccessToken d) = d
accessTokenExpires :: AccessToken anyKind -> Maybe UTCTime
accessTokenExpires (UserAccessToken _ _ expt) = Just expt
accessTokenExpires (AppAccessToken _) = Nothing
accessTokenUserId :: UserAccessToken -> UserId
accessTokenUserId (UserAccessToken uid _ _) = uid
data UserKind deriving (Typeable)
data AppKind deriving (Typeable)
type Argument = (ByteString, ByteString)
(<>) :: Monoid a => a -> a -> a
(<>) = mappend
newtype FbUTCTime = FbUTCTime { unFbUTCTime :: UTCTime }
instance A.FromJSON FbUTCTime where
parseJSON (A.String t) =
case parseTime defaultTimeLocale "%FT%T%z" (T.unpack t) of
Just d -> return (FbUTCTime d)
_ -> fail $ "could not parse FbUTCTime string " ++ show t
parseJSON _ = fail "could not parse FbUTCTime from something which is not a string"