{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving#-}
{-# LANGUAGE StandaloneDeriving#-}
{-# LANGUAGE GADTs#-}
{-# LANGUAGE DeriveDataTypeable#-}
{-# LANGUAGE CPP#-}

module Facebook.Types
  ( Credentials(..)
  , ApiVersion
  , appIdBS
  , appSecretBS
  , AccessToken(..)
  , UserAccessToken
  , AppAccessToken
  , AccessTokenData
  , Id(..)
  , UserId
  , accessTokenData
  , accessTokenExpires
  , accessTokenUserId
  , UserKind
  , AppKind
  , Argument
  , (<>)
  , FbUTCTime(..)
  , FacebookException(..)
  ) where

import Control.Applicative ((<$>), (<*>), pure)
import Control.Monad (mzero)
import qualified UnliftIO.Exception as E
import Data.ByteString (ByteString)
import Data.Int (Int64)
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid (Monoid, mappend)
#endif
import Data.String (IsString)
import Data.Text (Text)
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Typeable (Typeable)
#if MIN_VERSION_time(1,5,0)
import Data.Time (defaultTimeLocale, parseTimeM)
#else
import System.Locale (defaultTimeLocale)
import Data.Time (parseTime)
#endif
import qualified Data.Aeson as A
import qualified Data.Aeson.Types 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

-- | Credentials that you get for your app when you register on
-- Facebook.
data Credentials = Credentials
  { Credentials -> Text
appName :: Text -- ^ Your application name (e.g. for Open Graph calls).
  , Credentials -> Text
appId :: Text -- ^ Your application ID.
  , Credentials -> Text
appSecret :: Text -- ^ Your application secret key.
  , Credentials -> Bool
appSecretProof :: Bool -- ^ To enable app secret proof verification
  } deriving (Credentials -> Credentials -> Bool
(Credentials -> Credentials -> Bool)
-> (Credentials -> Credentials -> Bool) -> Eq Credentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Credentials -> Credentials -> Bool
$c/= :: Credentials -> Credentials -> Bool
== :: Credentials -> Credentials -> Bool
$c== :: Credentials -> Credentials -> Bool
Eq, Eq Credentials
Eq Credentials
-> (Credentials -> Credentials -> Ordering)
-> (Credentials -> Credentials -> Bool)
-> (Credentials -> Credentials -> Bool)
-> (Credentials -> Credentials -> Bool)
-> (Credentials -> Credentials -> Bool)
-> (Credentials -> Credentials -> Credentials)
-> (Credentials -> Credentials -> Credentials)
-> Ord Credentials
Credentials -> Credentials -> Bool
Credentials -> Credentials -> Ordering
Credentials -> Credentials -> Credentials
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Credentials -> Credentials -> Credentials
$cmin :: Credentials -> Credentials -> Credentials
max :: Credentials -> Credentials -> Credentials
$cmax :: Credentials -> Credentials -> Credentials
>= :: Credentials -> Credentials -> Bool
$c>= :: Credentials -> Credentials -> Bool
> :: Credentials -> Credentials -> Bool
$c> :: Credentials -> Credentials -> Bool
<= :: Credentials -> Credentials -> Bool
$c<= :: Credentials -> Credentials -> Bool
< :: Credentials -> Credentials -> Bool
$c< :: Credentials -> Credentials -> Bool
compare :: Credentials -> Credentials -> Ordering
$ccompare :: Credentials -> Credentials -> Ordering
$cp1Ord :: Eq Credentials
Ord, Int -> Credentials -> ShowS
[Credentials] -> ShowS
Credentials -> String
(Int -> Credentials -> ShowS)
-> (Credentials -> String)
-> ([Credentials] -> ShowS)
-> Show Credentials
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Credentials] -> ShowS
$cshowList :: [Credentials] -> ShowS
show :: Credentials -> String
$cshow :: Credentials -> String
showsPrec :: Int -> Credentials -> ShowS
$cshowsPrec :: Int -> Credentials -> ShowS
Show, ReadPrec [Credentials]
ReadPrec Credentials
Int -> ReadS Credentials
ReadS [Credentials]
(Int -> ReadS Credentials)
-> ReadS [Credentials]
-> ReadPrec Credentials
-> ReadPrec [Credentials]
-> Read Credentials
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Credentials]
$creadListPrec :: ReadPrec [Credentials]
readPrec :: ReadPrec Credentials
$creadPrec :: ReadPrec Credentials
readList :: ReadS [Credentials]
$creadList :: ReadS [Credentials]
readsPrec :: Int -> ReadS Credentials
$creadsPrec :: Int -> ReadS Credentials
Read, Typeable)

-- | 'appId' for 'ByteString'.
appIdBS :: Credentials -> ByteString
appIdBS :: Credentials -> ByteString
appIdBS = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString)
-> (Credentials -> Text) -> Credentials -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credentials -> Text
appId

-- | 'appSecret' for 'ByteString'.
appSecretBS :: Credentials -> ByteString
appSecretBS :: Credentials -> ByteString
appSecretBS = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString)
-> (Credentials -> Text) -> Credentials -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credentials -> Text
appSecret


-- | Graph API version.
-- See: https://developers.facebook.com/docs/graph-api/changelog
type ApiVersion = Text

-- | An access token.  While you can make some API calls without
-- an access token, many require an access token and some will
-- give you more information with an appropriate access token.
--
-- There are two kinds of access tokens:
--
-- [User access token] An access token obtained after an user
-- accepts your application.  Let's you access more information
-- about that user and act on their behalf (depending on which
-- permissions you've asked for).
--
-- [App access token] An access token that allows you to take
-- administrative actions for your application.
--
-- These two kinds of access tokens are distinguished by the
-- phantom type on 'AccessToken', which can be 'UserKind' or
-- 'AppKind'.
data AccessToken kind where
        UserAccessToken ::
          UserId -> AccessTokenData -> UTCTime -> AccessToken UserKind
        AppAccessToken :: AccessTokenData -> AccessToken AppKind

-- | Type synonym for @'AccessToken' 'UserKind'@.
type UserAccessToken = AccessToken UserKind

-- | Type synonym for @'AccessToken' 'AppKind'@.
type AppAccessToken = AccessToken AppKind

deriving instance Eq (AccessToken kind)

deriving instance Ord (AccessToken kind)

deriving instance Show (AccessToken kind)

deriving instance Typeable AccessToken

-- | The access token data that is passed to Facebook's API
-- calls.
type AccessTokenData = Text

-- | The identification code of an object.
newtype Id = Id
  { Id -> Text
idCode :: Text
  } deriving (Id -> Id -> Bool
(Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
Eq, Eq Id
Eq Id
-> (Id -> Id -> Ordering)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Id)
-> (Id -> Id -> Id)
-> Ord Id
Id -> Id -> Bool
Id -> Id -> Ordering
Id -> Id -> Id
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Id -> Id -> Id
$cmin :: Id -> Id -> Id
max :: Id -> Id -> Id
$cmax :: Id -> Id -> Id
>= :: Id -> Id -> Bool
$c>= :: Id -> Id -> Bool
> :: Id -> Id -> Bool
$c> :: Id -> Id -> Bool
<= :: Id -> Id -> Bool
$c<= :: Id -> Id -> Bool
< :: Id -> Id -> Bool
$c< :: Id -> Id -> Bool
compare :: Id -> Id -> Ordering
$ccompare :: Id -> Id -> Ordering
$cp1Ord :: Eq Id
Ord, Int -> Id -> ShowS
[Id] -> ShowS
Id -> String
(Int -> Id -> ShowS)
-> (Id -> String) -> ([Id] -> ShowS) -> Show Id
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> String
$cshow :: Id -> String
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
Show, ReadPrec [Id]
ReadPrec Id
Int -> ReadS Id
ReadS [Id]
(Int -> ReadS Id)
-> ReadS [Id] -> ReadPrec Id -> ReadPrec [Id] -> Read Id
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Id]
$creadListPrec :: ReadPrec [Id]
readPrec :: ReadPrec Id
$creadPrec :: ReadPrec Id
readList :: ReadS [Id]
$creadList :: ReadS [Id]
readsPrec :: Int -> ReadS Id
$creadsPrec :: Int -> ReadS Id
Read, Typeable, String -> Id
(String -> Id) -> IsString Id
forall a. (String -> a) -> IsString a
fromString :: String -> Id
$cfromString :: String -> Id
IsString)

instance A.FromJSON Id where
  parseJSON :: Value -> Parser Id
parseJSON (A.Object Object
v) = Object
v Object -> Key -> Parser Id
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"id"
  parseJSON (A.String Text
s) = Id -> Parser Id
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Id -> Parser Id) -> Id -> Parser Id
forall a b. (a -> b) -> a -> b
$ Text -> Id
Id Text
s
  parseJSON (A.Number Scientific
d) = Id -> Parser Id
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Id -> Parser Id) -> Id -> Parser Id
forall a b. (a -> b) -> a -> b
$ Text -> Id
Id (Text -> Id) -> Text -> Id
forall a b. (a -> b) -> a -> b
$ Int64 -> Text
from (Int64 -> Text) -> Int64 -> Text
forall a b. (a -> b) -> a -> b
$ Scientific -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
floor Scientific
d
    where
      from :: Int64 -> Text
from Int64
i = Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
TLB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Int64 -> Builder
forall a. Integral a => a -> Builder
TLBI.decimal (Int64
i :: Int64)
  parseJSON Value
o = String -> Parser Id
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Id) -> String -> Parser Id
forall a b. (a -> b) -> a -> b
$ String
"Can't parse Facebook.Id from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
o

instance A.ToJSON Id where
  toJSON :: Id -> Value
toJSON (Id Text
t) = Text -> Value
A.String Text
t

-- | A Facebook user ID such as @1008905713901@.
type UserId = Id

-- | Get the access token data.
accessTokenData :: AccessToken anyKind -> AccessTokenData
accessTokenData :: AccessToken anyKind -> Text
accessTokenData (UserAccessToken Id
_ Text
d UTCTime
_) = Text
d
accessTokenData (AppAccessToken Text
d) = Text
d

-- | Expire time of an access token.  It may never expire, in
-- which case it will be @Nothing@.
accessTokenExpires :: AccessToken anyKind -> Maybe UTCTime
accessTokenExpires :: AccessToken anyKind -> Maybe UTCTime
accessTokenExpires (UserAccessToken Id
_ Text
_ UTCTime
expt) = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
expt
accessTokenExpires (AppAccessToken Text
_) = Maybe UTCTime
forall a. Maybe a
Nothing

-- | Get the user ID of an user access token.
accessTokenUserId :: UserAccessToken -> UserId
accessTokenUserId :: UserAccessToken -> Id
accessTokenUserId (UserAccessToken Id
uid Text
_ UTCTime
_) = Id
uid

-- | Phantom type used mark an 'AccessToken' as an user access
-- token.
data UserKind
  deriving (Typeable)

-- | Phantom type used mark an 'AccessToken' as an app access
-- token.
data AppKind
  deriving (Typeable)

-- | An argument given to an API call.
type Argument = (ByteString, ByteString)

-- | Synonym for 'mappend'.
#if !(MIN_VERSION_base(4,11,0))
(<>)
  :: Monoid a
  => a -> a -> a
(<>) = mappend
#endif

----------------------------------------------------------------------
-- | /Since 0.14.9./ Not a Facebook JSON format, but a custom @fb@
-- format for convenience if you need to serialize access tokens.
instance A.ToJSON (AccessToken kind) where
  toJSON :: AccessToken kind -> Value
toJSON (UserAccessToken Id
uid Text
data_ UTCTime
expires) =
    [Pair] -> Value
A.object
      [ Key
"kind" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= (Text
"user" :: Text)
      , Key
"id" Key -> Id -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Id
uid
      , Key
"token" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
data_
      , Key
"expires" Key -> UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= UTCTime
expires
      ]
  toJSON (AppAccessToken Text
data_) =
    [Pair] -> Value
A.object [Key
"kind" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= (Text
"app" :: Text), Key
"token" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
data_]

-- | (Internal) Since the user of 'parseJSON' is going to choose
-- via its @kind@ whether a 'UserAccessToken' or an
-- 'AppAccessToken' is wanted, we need this type class to
-- implement 'FromJSON'.
class ParseAccessToken kind  where
  parseTokenJSON :: A.Object -> A.Parser (AccessToken kind)

instance ParseAccessToken UserKind where
  parseTokenJSON :: Object -> Parser UserAccessToken
parseTokenJSON Object
v = Object -> Text -> Parser UserAccessToken -> Parser UserAccessToken
forall a. Object -> Text -> Parser a -> Parser a
checkKind Object
v Text
"user" (Parser UserAccessToken -> Parser UserAccessToken)
-> Parser UserAccessToken -> Parser UserAccessToken
forall a b. (a -> b) -> a -> b
$ Id -> Text -> UTCTime -> UserAccessToken
UserAccessToken (Id -> Text -> UTCTime -> UserAccessToken)
-> Parser Id -> Parser (Text -> UTCTime -> UserAccessToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Id
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"id" Parser (Text -> UTCTime -> UserAccessToken)
-> Parser Text -> Parser (UTCTime -> UserAccessToken)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"token" Parser (UTCTime -> UserAccessToken)
-> Parser UTCTime -> Parser UserAccessToken
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"expires"

instance ParseAccessToken AppKind where
  parseTokenJSON :: Object -> Parser (AccessToken AppKind)
parseTokenJSON Object
v = Object
-> Text
-> Parser (AccessToken AppKind)
-> Parser (AccessToken AppKind)
forall a. Object -> Text -> Parser a -> Parser a
checkKind Object
v Text
"app" (Parser (AccessToken AppKind) -> Parser (AccessToken AppKind))
-> Parser (AccessToken AppKind) -> Parser (AccessToken AppKind)
forall a b. (a -> b) -> a -> b
$ Text -> AccessToken AppKind
AppAccessToken (Text -> AccessToken AppKind)
-> Parser Text -> Parser (AccessToken AppKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"token"

-- | (Internal) Used to implement 'parseTokenJSON'.
checkKind :: A.Object -> Text -> A.Parser a -> A.Parser a
checkKind :: Object -> Text -> Parser a -> Parser a
checkKind Object
v Text
kind Parser a
ok = do
  Text
kind' <- Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"kind"
  if Text
kind Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
kind'
    then Parser a
ok
    else String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$
         String
"Expected access token kind " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
kind String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but found " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
kind' String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
         String
"."

-- | /Since 0.14.9./ Parses the format that 'ToJSON' produces.
-- Note that you need to statically decide whether you want to
-- parse a user access token or an app access token.
instance ParseAccessToken kind =>
         A.FromJSON (AccessToken kind) where
  parseJSON :: Value -> Parser (AccessToken kind)
parseJSON (A.Object Object
v) = Object -> Parser (AccessToken kind)
forall kind.
ParseAccessToken kind =>
Object -> Parser (AccessToken kind)
parseTokenJSON Object
v
  parseJSON Value
_ = Parser (AccessToken kind)
forall (m :: * -> *) a. MonadPlus m => m a
mzero

----------------------------------------------------------------------
-- | @newtype@ for 'UTCTime' that follows Facebook's
-- conventions of JSON parsing.
--
--  * As a string, while @aeson@ expects a format of @%FT%T%Q@,
--    Facebook gives time values formatted as @%FT%T%z@.
--
--  * As a number, 'FbUTCTime' accepts a number of seconds since
--    the Unix epoch.
newtype FbUTCTime = FbUTCTime
  { FbUTCTime -> UTCTime
unFbUTCTime :: UTCTime
  } deriving (FbUTCTime -> FbUTCTime -> Bool
(FbUTCTime -> FbUTCTime -> Bool)
-> (FbUTCTime -> FbUTCTime -> Bool) -> Eq FbUTCTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FbUTCTime -> FbUTCTime -> Bool
$c/= :: FbUTCTime -> FbUTCTime -> Bool
== :: FbUTCTime -> FbUTCTime -> Bool
$c== :: FbUTCTime -> FbUTCTime -> Bool
Eq, Eq FbUTCTime
Eq FbUTCTime
-> (FbUTCTime -> FbUTCTime -> Ordering)
-> (FbUTCTime -> FbUTCTime -> Bool)
-> (FbUTCTime -> FbUTCTime -> Bool)
-> (FbUTCTime -> FbUTCTime -> Bool)
-> (FbUTCTime -> FbUTCTime -> Bool)
-> (FbUTCTime -> FbUTCTime -> FbUTCTime)
-> (FbUTCTime -> FbUTCTime -> FbUTCTime)
-> Ord FbUTCTime
FbUTCTime -> FbUTCTime -> Bool
FbUTCTime -> FbUTCTime -> Ordering
FbUTCTime -> FbUTCTime -> FbUTCTime
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FbUTCTime -> FbUTCTime -> FbUTCTime
$cmin :: FbUTCTime -> FbUTCTime -> FbUTCTime
max :: FbUTCTime -> FbUTCTime -> FbUTCTime
$cmax :: FbUTCTime -> FbUTCTime -> FbUTCTime
>= :: FbUTCTime -> FbUTCTime -> Bool
$c>= :: FbUTCTime -> FbUTCTime -> Bool
> :: FbUTCTime -> FbUTCTime -> Bool
$c> :: FbUTCTime -> FbUTCTime -> Bool
<= :: FbUTCTime -> FbUTCTime -> Bool
$c<= :: FbUTCTime -> FbUTCTime -> Bool
< :: FbUTCTime -> FbUTCTime -> Bool
$c< :: FbUTCTime -> FbUTCTime -> Bool
compare :: FbUTCTime -> FbUTCTime -> Ordering
$ccompare :: FbUTCTime -> FbUTCTime -> Ordering
$cp1Ord :: Eq FbUTCTime
Ord, Int -> FbUTCTime -> ShowS
[FbUTCTime] -> ShowS
FbUTCTime -> String
(Int -> FbUTCTime -> ShowS)
-> (FbUTCTime -> String)
-> ([FbUTCTime] -> ShowS)
-> Show FbUTCTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FbUTCTime] -> ShowS
$cshowList :: [FbUTCTime] -> ShowS
show :: FbUTCTime -> String
$cshow :: FbUTCTime -> String
showsPrec :: Int -> FbUTCTime -> ShowS
$cshowsPrec :: Int -> FbUTCTime -> ShowS
Show, ReadPrec [FbUTCTime]
ReadPrec FbUTCTime
Int -> ReadS FbUTCTime
ReadS [FbUTCTime]
(Int -> ReadS FbUTCTime)
-> ReadS [FbUTCTime]
-> ReadPrec FbUTCTime
-> ReadPrec [FbUTCTime]
-> Read FbUTCTime
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FbUTCTime]
$creadListPrec :: ReadPrec [FbUTCTime]
readPrec :: ReadPrec FbUTCTime
$creadPrec :: ReadPrec FbUTCTime
readList :: ReadS [FbUTCTime]
$creadList :: ReadS [FbUTCTime]
readsPrec :: Int -> ReadS FbUTCTime
$creadsPrec :: Int -> ReadS FbUTCTime
Read, Typeable)

instance A.FromJSON FbUTCTime where
  parseJSON :: Value -> Parser FbUTCTime
parseJSON (A.String Text
t) =
#if MIN_VERSION_time(1,5,0)
    case Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%FT%T%z" (Text -> String
T.unpack Text
t) of
#else
    case parseTime defaultTimeLocale "%FT%T%z" (T.unpack t) of
#endif
      Just UTCTime
d -> FbUTCTime -> Parser FbUTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> FbUTCTime
FbUTCTime UTCTime
d)
      Maybe UTCTime
_ -> String -> Parser FbUTCTime
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser FbUTCTime) -> String -> Parser FbUTCTime
forall a b. (a -> b) -> a -> b
$ String
"could not parse FbUTCTime string " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t
  parseJSON (A.Number Scientific
n) =
    FbUTCTime -> Parser FbUTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (FbUTCTime -> Parser FbUTCTime) -> FbUTCTime -> Parser FbUTCTime
forall a b. (a -> b) -> a -> b
$ UTCTime -> FbUTCTime
FbUTCTime (UTCTime -> FbUTCTime) -> UTCTime -> FbUTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger (Integer -> POSIXTime) -> Integer -> POSIXTime
forall a b. (a -> b) -> a -> b
$ Scientific -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Scientific
n
  parseJSON Value
_ =
    String -> Parser FbUTCTime
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
      String
"could not parse FbUTCTime from something which is not a string or number"

-- | An exception that may be thrown by functions on this
-- package.  Includes any information provided by Facebook.
data FacebookException =
    -- | An exception coming from Facebook.
    FacebookException { FacebookException -> Text
fbeType    :: Text
                      , FacebookException -> Text
fbeMessage :: Text
                      }
    -- | An exception coming from the @fb@ package's code.
  | FbLibraryException { fbeMessage :: Text }
    deriving (FacebookException -> FacebookException -> Bool
(FacebookException -> FacebookException -> Bool)
-> (FacebookException -> FacebookException -> Bool)
-> Eq FacebookException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FacebookException -> FacebookException -> Bool
$c/= :: FacebookException -> FacebookException -> Bool
== :: FacebookException -> FacebookException -> Bool
$c== :: FacebookException -> FacebookException -> Bool
Eq, Eq FacebookException
Eq FacebookException
-> (FacebookException -> FacebookException -> Ordering)
-> (FacebookException -> FacebookException -> Bool)
-> (FacebookException -> FacebookException -> Bool)
-> (FacebookException -> FacebookException -> Bool)
-> (FacebookException -> FacebookException -> Bool)
-> (FacebookException -> FacebookException -> FacebookException)
-> (FacebookException -> FacebookException -> FacebookException)
-> Ord FacebookException
FacebookException -> FacebookException -> Bool
FacebookException -> FacebookException -> Ordering
FacebookException -> FacebookException -> FacebookException
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FacebookException -> FacebookException -> FacebookException
$cmin :: FacebookException -> FacebookException -> FacebookException
max :: FacebookException -> FacebookException -> FacebookException
$cmax :: FacebookException -> FacebookException -> FacebookException
>= :: FacebookException -> FacebookException -> Bool
$c>= :: FacebookException -> FacebookException -> Bool
> :: FacebookException -> FacebookException -> Bool
$c> :: FacebookException -> FacebookException -> Bool
<= :: FacebookException -> FacebookException -> Bool
$c<= :: FacebookException -> FacebookException -> Bool
< :: FacebookException -> FacebookException -> Bool
$c< :: FacebookException -> FacebookException -> Bool
compare :: FacebookException -> FacebookException -> Ordering
$ccompare :: FacebookException -> FacebookException -> Ordering
$cp1Ord :: Eq FacebookException
Ord, Int -> FacebookException -> ShowS
[FacebookException] -> ShowS
FacebookException -> String
(Int -> FacebookException -> ShowS)
-> (FacebookException -> String)
-> ([FacebookException] -> ShowS)
-> Show FacebookException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FacebookException] -> ShowS
$cshowList :: [FacebookException] -> ShowS
show :: FacebookException -> String
$cshow :: FacebookException -> String
showsPrec :: Int -> FacebookException -> ShowS
$cshowsPrec :: Int -> FacebookException -> ShowS
Show, ReadPrec [FacebookException]
ReadPrec FacebookException
Int -> ReadS FacebookException
ReadS [FacebookException]
(Int -> ReadS FacebookException)
-> ReadS [FacebookException]
-> ReadPrec FacebookException
-> ReadPrec [FacebookException]
-> Read FacebookException
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FacebookException]
$creadListPrec :: ReadPrec [FacebookException]
readPrec :: ReadPrec FacebookException
$creadPrec :: ReadPrec FacebookException
readList :: ReadS [FacebookException]
$creadList :: ReadS [FacebookException]
readsPrec :: Int -> ReadS FacebookException
$creadsPrec :: Int -> ReadS FacebookException
Read, Typeable)

instance A.FromJSON FacebookException where
    parseJSON :: Value -> Parser FacebookException
parseJSON (A.Object Object
v) =
        Text -> Text -> FacebookException
FacebookException (Text -> Text -> FacebookException)
-> Parser Text -> Parser (Text -> FacebookException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"type"
                          Parser (Text -> FacebookException)
-> Parser Text -> Parser FacebookException
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"message"
    parseJSON Value
_ = Parser FacebookException
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance E.Exception FacebookException where