{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}

module Facebook.TestUsers
  ( TestUser(..)
  , CreateTestUser(..)
  , CreateTestUserInstalled(..)
  , getTestUsers
  , disassociateTestuser
  , removeTestUser
  , createTestUser
  , makeFriendConn
  , incompleteTestUserAccessToken
  ) where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (unless, mzero)
import Control.Monad.IO.Class
import Data.ByteString.Lazy (fromStrict)
import Data.Default
import Data.Text
import Data.Text.Encoding (encodeUtf8)
import Data.Time (UTCTime(..), Day(..))
import Data.Typeable (Typeable)
import Data.Aeson
import Data.Aeson.Types

import qualified UnliftIO.Exception as E
import qualified Control.Monad.Trans.Resource as R
import qualified Data.Aeson as A
import qualified Data.ByteString.Char8 as B

import Facebook.Auth
import Facebook.Base
import Facebook.Graph
import Facebook.Monad
import Facebook.Types
import Facebook.Pager

-- | A Facebook test user.
-- Ref: https://developers.facebook.com/docs/graph-api/reference/v2.8/app/accounts/test-users
data TestUser = TestUser
  { TestUser -> UserId
tuId :: UserId
  , TestUser -> Maybe AccessTokenData
tuAccessToken :: Maybe AccessTokenData
  , TestUser -> Maybe AccessTokenData
tuLoginUrl :: Maybe Text
  , TestUser -> Maybe AccessTokenData
tuEmail :: Maybe Text
  , TestUser -> Maybe AccessTokenData
tuPassword :: Maybe Text
  } deriving (TestUser -> TestUser -> Bool
(TestUser -> TestUser -> Bool)
-> (TestUser -> TestUser -> Bool) -> Eq TestUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestUser -> TestUser -> Bool
$c/= :: TestUser -> TestUser -> Bool
== :: TestUser -> TestUser -> Bool
$c== :: TestUser -> TestUser -> Bool
Eq, Eq TestUser
Eq TestUser
-> (TestUser -> TestUser -> Ordering)
-> (TestUser -> TestUser -> Bool)
-> (TestUser -> TestUser -> Bool)
-> (TestUser -> TestUser -> Bool)
-> (TestUser -> TestUser -> Bool)
-> (TestUser -> TestUser -> TestUser)
-> (TestUser -> TestUser -> TestUser)
-> Ord TestUser
TestUser -> TestUser -> Bool
TestUser -> TestUser -> Ordering
TestUser -> TestUser -> TestUser
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 :: TestUser -> TestUser -> TestUser
$cmin :: TestUser -> TestUser -> TestUser
max :: TestUser -> TestUser -> TestUser
$cmax :: TestUser -> TestUser -> TestUser
>= :: TestUser -> TestUser -> Bool
$c>= :: TestUser -> TestUser -> Bool
> :: TestUser -> TestUser -> Bool
$c> :: TestUser -> TestUser -> Bool
<= :: TestUser -> TestUser -> Bool
$c<= :: TestUser -> TestUser -> Bool
< :: TestUser -> TestUser -> Bool
$c< :: TestUser -> TestUser -> Bool
compare :: TestUser -> TestUser -> Ordering
$ccompare :: TestUser -> TestUser -> Ordering
$cp1Ord :: Eq TestUser
Ord, Int -> TestUser -> ShowS
[TestUser] -> ShowS
TestUser -> String
(Int -> TestUser -> ShowS)
-> (TestUser -> String) -> ([TestUser] -> ShowS) -> Show TestUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestUser] -> ShowS
$cshowList :: [TestUser] -> ShowS
show :: TestUser -> String
$cshow :: TestUser -> String
showsPrec :: Int -> TestUser -> ShowS
$cshowsPrec :: Int -> TestUser -> ShowS
Show, ReadPrec [TestUser]
ReadPrec TestUser
Int -> ReadS TestUser
ReadS [TestUser]
(Int -> ReadS TestUser)
-> ReadS [TestUser]
-> ReadPrec TestUser
-> ReadPrec [TestUser]
-> Read TestUser
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestUser]
$creadListPrec :: ReadPrec [TestUser]
readPrec :: ReadPrec TestUser
$creadPrec :: ReadPrec TestUser
readList :: ReadS [TestUser]
$creadList :: ReadS [TestUser]
readsPrec :: Int -> ReadS TestUser
$creadsPrec :: Int -> ReadS TestUser
Read, Typeable)

instance A.FromJSON TestUser where
  parseJSON :: Value -> Parser TestUser
parseJSON (A.Object Object
v) =
    UserId
-> Maybe AccessTokenData
-> Maybe AccessTokenData
-> Maybe AccessTokenData
-> Maybe AccessTokenData
-> TestUser
TestUser (UserId
 -> Maybe AccessTokenData
 -> Maybe AccessTokenData
 -> Maybe AccessTokenData
 -> Maybe AccessTokenData
 -> TestUser)
-> Parser UserId
-> Parser
     (Maybe AccessTokenData
      -> Maybe AccessTokenData
      -> Maybe AccessTokenData
      -> Maybe AccessTokenData
      -> TestUser)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser UserId
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"id" Parser
  (Maybe AccessTokenData
   -> Maybe AccessTokenData
   -> Maybe AccessTokenData
   -> Maybe AccessTokenData
   -> TestUser)
-> Parser (Maybe AccessTokenData)
-> Parser
     (Maybe AccessTokenData
      -> Maybe AccessTokenData -> Maybe AccessTokenData -> TestUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe AccessTokenData)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"access_token" Parser
  (Maybe AccessTokenData
   -> Maybe AccessTokenData -> Maybe AccessTokenData -> TestUser)
-> Parser (Maybe AccessTokenData)
-> Parser
     (Maybe AccessTokenData -> Maybe AccessTokenData -> TestUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe AccessTokenData)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"login_url" Parser (Maybe AccessTokenData -> Maybe AccessTokenData -> TestUser)
-> Parser (Maybe AccessTokenData)
-> Parser (Maybe AccessTokenData -> TestUser)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v Object -> Key -> Parser (Maybe AccessTokenData)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"email" Parser (Maybe AccessTokenData -> TestUser)
-> Parser (Maybe AccessTokenData) -> Parser TestUser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v Object -> Key -> Parser (Maybe AccessTokenData)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"password"
  parseJSON Value
_ = Parser TestUser
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Data type used to hold information of a new test user. This type
-- also accepts a Data.Default value.
data CreateTestUser = CreateTestUser
  { CreateTestUser -> CreateTestUserInstalled
ctuInstalled :: CreateTestUserInstalled
  , CreateTestUser -> Maybe AccessTokenData
ctuName :: Maybe Text
  , CreateTestUser -> Maybe AccessTokenData
ctuLocale :: Maybe Text
  }

-- | Specify if the app is to be installed on the new test user.  If
-- it is, then you must tell what permissions should be given.
data CreateTestUserInstalled
  = CreateTestUserNotInstalled
  | CreateTestUserInstalled { CreateTestUserInstalled -> [Permission]
ctuiPermissions :: [Permission]}
  | CreateTestUserFbDefault -- ^ Uses Facebook's default. It seems that this is equivalent to

-- @CreateTestUserInstalled []@, but Facebook's documentation is
-- not clear about it.
-- | Default instance for 'CreateTestUser'.
instance Default CreateTestUser where
  def :: CreateTestUser
def = CreateTestUserInstalled
-> Maybe AccessTokenData -> Maybe AccessTokenData -> CreateTestUser
CreateTestUser CreateTestUserInstalled
forall a. Default a => a
def Maybe AccessTokenData
forall a. Default a => a
def Maybe AccessTokenData
forall a. Default a => a
def

-- | Default instance for 'CreateTestUserInstalled'.
instance Default CreateTestUserInstalled where
  def :: CreateTestUserInstalled
def = CreateTestUserInstalled
CreateTestUserFbDefault

-- | Construct a query from a 'CreateTestUser'.
createTestUserQueryArgs :: CreateTestUser -> [Argument]
createTestUserQueryArgs :: CreateTestUser -> [Argument]
createTestUserQueryArgs (CreateTestUser CreateTestUserInstalled
installed Maybe AccessTokenData
name Maybe AccessTokenData
locale) =
  CreateTestUserInstalled -> [Argument]
forInst CreateTestUserInstalled
installed [Argument] -> [Argument] -> [Argument]
forall a. [a] -> [a] -> [a]
++ ByteString -> Maybe AccessTokenData -> [Argument]
forall a. SimpleType a => ByteString -> Maybe a -> [Argument]
forField ByteString
"name" Maybe AccessTokenData
name [Argument] -> [Argument] -> [Argument]
forall a. [a] -> [a] -> [a]
++ ByteString -> Maybe AccessTokenData -> [Argument]
forall a. SimpleType a => ByteString -> Maybe a -> [Argument]
forField ByteString
"locale" Maybe AccessTokenData
locale
  where
    forInst :: CreateTestUserInstalled -> [Argument]
forInst (CreateTestUserInstalled [Permission]
p) =
      [ByteString
"installed" ByteString -> Bool -> Argument
forall a. SimpleType a => ByteString -> a -> Argument
#= Bool
True, ByteString
"permissions" ByteString -> [Permission] -> Argument
forall a. SimpleType a => ByteString -> a -> Argument
#= [Permission]
p]
    forInst CreateTestUserInstalled
CreateTestUserNotInstalled = [ByteString
"installed" ByteString -> Bool -> Argument
forall a. SimpleType a => ByteString -> a -> Argument
#= Bool
False]
    forInst CreateTestUserInstalled
CreateTestUserFbDefault = []
    forField :: ByteString -> Maybe a -> [Argument]
forField ByteString
_ Maybe a
Nothing = []
    forField ByteString
fieldName (Just a
f) = [ByteString
fieldName ByteString -> a -> Argument
forall a. SimpleType a => ByteString -> a -> Argument
#= a
f]

-- | Create a new test user.
-- Ref: https://developers.facebook.com/docs/graph-api/reference/v2.8/app/accounts/test-users#publish
createTestUser
  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, MonadIO m)
  => CreateTestUser -- ^ How the test user should be
     -- created.
  -> AppAccessToken -- ^ Access token for your app.
  -> FacebookT Auth m TestUser
createTestUser :: CreateTestUser -> AppAccessToken -> FacebookT Auth m TestUser
createTestUser CreateTestUser
userInfo AppAccessToken
token = do
  Credentials
creds <- FacebookT Auth m Credentials
forall (m :: * -> *).
(Monad m, MonadIO m) =>
FacebookT Auth m Credentials
getCreds
  let query :: [Argument]
query = (ByteString
"method", ByteString
"post") Argument -> [Argument] -> [Argument]
forall a. a -> [a] -> [a]
: CreateTestUser -> [Argument]
createTestUserQueryArgs CreateTestUser
userInfo
  AccessTokenData
-> [Argument] -> Maybe AppAccessToken -> FacebookT Auth m TestUser
forall (m :: * -> *) a anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m, FromJSON a) =>
AccessTokenData
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m a
getObject (AccessTokenData
"/" AccessTokenData -> AccessTokenData -> AccessTokenData
forall a. Semigroup a => a -> a -> a
<> Credentials -> AccessTokenData
appId Credentials
creds AccessTokenData -> AccessTokenData -> AccessTokenData
forall a. Semigroup a => a -> a -> a
<> AccessTokenData
"/accounts/test-users") [Argument]
query (AppAccessToken -> Maybe AppAccessToken
forall a. a -> Maybe a
Just AppAccessToken
token)

-- | Get a list of test users.
getTestUsers
  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, MonadIO m)
  => AppAccessToken -- ^ Access token for your app.
  -> FacebookT Auth m (Pager TestUser)
getTestUsers :: AppAccessToken -> FacebookT Auth m (Pager TestUser)
getTestUsers AppAccessToken
token = do
  Credentials
creds <- FacebookT Auth m Credentials
forall (m :: * -> *).
(Monad m, MonadIO m) =>
FacebookT Auth m Credentials
getCreds
  AccessTokenData
-> [Argument]
-> Maybe AppAccessToken
-> FacebookT Auth m (Pager TestUser)
forall (m :: * -> *) a anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m, FromJSON a) =>
AccessTokenData
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m a
getObject (AccessTokenData
"/" AccessTokenData -> AccessTokenData -> AccessTokenData
forall a. Semigroup a => a -> a -> a
<> Credentials -> AccessTokenData
appId Credentials
creds AccessTokenData -> AccessTokenData -> AccessTokenData
forall a. Semigroup a => a -> a -> a
<> AccessTokenData
"/accounts/test-users") [] (AppAccessToken -> Maybe AppAccessToken
forall a. a -> Maybe a
Just AppAccessToken
token)

disassociateTestuser
  :: (R.MonadUnliftIO m, R.MonadThrow m, R.MonadResource m, MonadIO m)
  => TestUser -> AppAccessToken -> FacebookT Auth m Bool
disassociateTestuser :: TestUser -> AppAccessToken -> FacebookT Auth m Bool
disassociateTestuser TestUser
testUser AppAccessToken
_token = do
  Credentials
creds <- FacebookT Auth m Credentials
forall (m :: * -> *).
(Monad m, MonadIO m) =>
FacebookT Auth m Credentials
getCreds
  AccessTokenData
-> [Argument] -> Maybe AppAccessToken -> FacebookT Auth m Bool
forall (m :: * -> *) anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
AccessTokenData
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m Bool
getObjectBool
    (AccessTokenData
"/" AccessTokenData -> AccessTokenData -> AccessTokenData
forall a. Semigroup a => a -> a -> a
<> (Credentials -> AccessTokenData
appId Credentials
creds) AccessTokenData -> AccessTokenData -> AccessTokenData
forall a. Semigroup a => a -> a -> a
<> AccessTokenData
"/accounts/test-users")
    [(ByteString
"uid", AccessTokenData -> ByteString
encodeUtf8 (AccessTokenData -> ByteString) -> AccessTokenData -> ByteString
forall a b. (a -> b) -> a -> b
$ UserId -> AccessTokenData
idCode (UserId -> AccessTokenData) -> UserId -> AccessTokenData
forall a b. (a -> b) -> a -> b
$ TestUser -> UserId
tuId TestUser
testUser), (ByteString
"method", ByteString
"delete")]
    (AppAccessToken -> Maybe AppAccessToken
forall a. a -> Maybe a
Just AppAccessToken
_token)

-- | Remove an existing test user.
removeTestUser
  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)
  => TestUser -- ^ The TestUser to be removed.
  -> AppAccessToken -- ^ Access token for your app (ignored since fb 0.14.7).
  -> FacebookT Auth m Bool
removeTestUser :: TestUser -> AppAccessToken -> FacebookT Auth m Bool
removeTestUser TestUser
testUser AppAccessToken
_token = do
  AccessTokenData
-> [Argument] -> Maybe AppAccessToken -> FacebookT Auth m Bool
forall (m :: * -> *) anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
AccessTokenData
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m Bool
getObjectBool
    (AccessTokenData
"/" AccessTokenData -> AccessTokenData -> AccessTokenData
forall a. Semigroup a => a -> a -> a
<> (UserId -> AccessTokenData
idCode (UserId -> AccessTokenData) -> UserId -> AccessTokenData
forall a b. (a -> b) -> a -> b
$ TestUser -> UserId
tuId TestUser
testUser))
    [(ByteString
"method", ByteString
"delete")]
    (AppAccessToken -> Maybe AppAccessToken
forall a. a -> Maybe a
Just AppAccessToken
_token)

-- | Make a friend connection between two test users.
--
-- This is how Facebook's API work: two calls must be made. The first
-- call has the format: \"\/userA_id\/friends\/userB_id\" with the
-- access token of user A as query parameter. The second call has the
-- format: \"\/userB_id\/friends\/userA_id\" with the access token of
-- user B as query parameter. The first call creates a friend request
-- and the second call accepts the friend request.
makeFriendConn
  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)
  => TestUser -> TestUser -> FacebookT Auth m ()
makeFriendConn :: TestUser -> TestUser -> FacebookT Auth m ()
makeFriendConn (TestUser {tuAccessToken :: TestUser -> Maybe AccessTokenData
tuAccessToken = Maybe AccessTokenData
Nothing}) TestUser
_ =
  FacebookException -> FacebookT Auth m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO (FacebookException -> FacebookT Auth m ())
-> FacebookException -> FacebookT Auth m ()
forall a b. (a -> b) -> a -> b
$
  AccessTokenData -> FacebookException
FbLibraryException
    AccessTokenData
"The test user passed on the first argument doesn't have a token. Both users must have a token."
makeFriendConn TestUser
_ (TestUser {tuAccessToken :: TestUser -> Maybe AccessTokenData
tuAccessToken = Maybe AccessTokenData
Nothing}) =
  FacebookException -> FacebookT Auth m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO (FacebookException -> FacebookT Auth m ())
-> FacebookException -> FacebookT Auth m ()
forall a b. (a -> b) -> a -> b
$
  AccessTokenData -> FacebookException
FbLibraryException
    AccessTokenData
"The test user passed on the second argument doesn't have a token. Both users must have a token."
makeFriendConn (TestUser {tuId :: TestUser -> UserId
tuId = UserId
id1
                         ,tuAccessToken :: TestUser -> Maybe AccessTokenData
tuAccessToken = (Just AccessTokenData
token1)}) (TestUser {tuId :: TestUser -> UserId
tuId = UserId
id2
                                                                    ,tuAccessToken :: TestUser -> Maybe AccessTokenData
tuAccessToken = (Just AccessTokenData
token2)}) = do
  let friendReq :: UserId -> UserId -> a -> FacebookT anyAuth m Bool
friendReq UserId
userId1 UserId
userId2 a
token =
        AccessTokenData
-> [Argument]
-> Maybe (AccessToken Any)
-> FacebookT anyAuth m Bool
forall (m :: * -> *) anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
AccessTokenData
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m Bool
getObjectBool
          (AccessTokenData
"/" AccessTokenData -> AccessTokenData -> AccessTokenData
forall a. Semigroup a => a -> a -> a
<> UserId -> AccessTokenData
idCode UserId
userId1 AccessTokenData -> AccessTokenData -> AccessTokenData
forall a. Semigroup a => a -> a -> a
<> AccessTokenData
"/friends/" AccessTokenData -> AccessTokenData -> AccessTokenData
forall a. Semigroup a => a -> a -> a
<> UserId -> AccessTokenData
idCode UserId
userId2)
          [ByteString
"method" ByteString -> ByteString -> Argument
forall a. SimpleType a => ByteString -> a -> Argument
#= (ByteString
"post" :: B.ByteString), ByteString
"access_token" ByteString -> a -> Argument
forall a. SimpleType a => ByteString -> a -> Argument
#= a
token]
          Maybe (AccessToken Any)
forall a. Maybe a
Nothing
  Bool
r1 <- UserId -> UserId -> AccessTokenData -> FacebookT Auth m Bool
forall (m :: * -> *) a anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m, SimpleType a) =>
UserId -> UserId -> a -> FacebookT anyAuth m Bool
friendReq UserId
id1 UserId
id2 AccessTokenData
token1
  Bool
r2 <- UserId -> UserId -> AccessTokenData -> FacebookT Auth m Bool
forall (m :: * -> *) a anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m, SimpleType a) =>
UserId -> UserId -> a -> FacebookT anyAuth m Bool
friendReq UserId
id2 UserId
id1 AccessTokenData
token2
  Bool -> FacebookT Auth m () -> FacebookT Auth m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
r1 (FacebookT Auth m () -> FacebookT Auth m ())
-> FacebookT Auth m () -> FacebookT Auth m ()
forall a b. (a -> b) -> a -> b
$ FacebookException -> FacebookT Auth m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO (FacebookException -> FacebookT Auth m ())
-> FacebookException -> FacebookT Auth m ()
forall a b. (a -> b) -> a -> b
$ AccessTokenData -> FacebookException
FbLibraryException AccessTokenData
"Couldn't make friend request."
  Bool -> FacebookT Auth m () -> FacebookT Auth m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
r2 (FacebookT Auth m () -> FacebookT Auth m ())
-> FacebookT Auth m () -> FacebookT Auth m ()
forall a b. (a -> b) -> a -> b
$ FacebookException -> FacebookT Auth m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO (FacebookException -> FacebookT Auth m ())
-> FacebookException -> FacebookT Auth m ()
forall a b. (a -> b) -> a -> b
$ AccessTokenData -> FacebookException
FbLibraryException AccessTokenData
"Couldn't accept friend request."
  () -> FacebookT Auth m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Create an 'UserAccessToken' from a 'TestUser'.  It's incomplete
-- because it will not have the right expiration time.
incompleteTestUserAccessToken :: TestUser -> Maybe UserAccessToken
incompleteTestUserAccessToken :: TestUser -> Maybe UserAccessToken
incompleteTestUserAccessToken TestUser
t = do
  AccessTokenData
tokenData <- TestUser -> Maybe AccessTokenData
tuAccessToken TestUser
t
  let farFuture :: UTCTime
farFuture = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day
ModifiedJulianDay Integer
100000) DiffTime
0
  UserAccessToken -> Maybe UserAccessToken
forall (m :: * -> *) a. Monad m => a -> m a
return (UserId -> AccessTokenData -> UTCTime -> UserAccessToken
UserAccessToken (TestUser -> UserId
tuId TestUser
t) AccessTokenData
tokenData UTCTime
farFuture)

-- | Same as 'getObject', but instead of parsing the result
-- as a JSON, it tries to parse either as "true" or "false".
-- Used only by the Test User API bindings.
getObjectBool
  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)
  => Text
     -- ^ Path (should begin with a slash @\/@).
  -> [Argument]
     -- ^ Arguments to be passed to Facebook.
  -> Maybe (AccessToken anyKind)
     -- ^ Optional access token.
  -> FacebookT anyAuth m Bool
getObjectBool :: AccessTokenData
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m Bool
getObjectBool AccessTokenData
path [Argument]
query Maybe (AccessToken anyKind)
mtoken =
  FacebookT anyAuth (ResourceT m) Bool -> FacebookT anyAuth m Bool
forall (m :: * -> *) anyAuth a.
(MonadResource m, MonadUnliftIO m) =>
FacebookT anyAuth (ResourceT m) a -> FacebookT anyAuth m a
runResourceInFb (FacebookT anyAuth (ResourceT m) Bool -> FacebookT anyAuth m Bool)
-> FacebookT anyAuth (ResourceT m) Bool -> FacebookT anyAuth m Bool
forall a b. (a -> b) -> a -> b
$
  do Request
req <- AccessTokenData
-> Maybe (AccessToken anyKind)
-> [Argument]
-> FacebookT anyAuth (ResourceT m) Request
forall (m :: * -> *) anyKind anyAuth.
MonadIO m =>
AccessTokenData
-> Maybe (AccessToken anyKind)
-> [Argument]
-> FacebookT anyAuth m Request
fbreq AccessTokenData
path Maybe (AccessToken anyKind)
mtoken [Argument]
query
     Response (ConduitT () ByteString (ResourceT m) ())
response <- Request
-> FacebookT
     anyAuth
     (ResourceT m)
     (Response (ConduitT () ByteString (ResourceT m) ()))
forall (m :: * -> *) anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
Request
-> FacebookT anyAuth m (Response (ConduitT () ByteString m ()))
fbhttp Request
req
     ByteString
bs <- Response (ConduitT () ByteString (ResourceT m) ())
-> FacebookT anyAuth (ResourceT m) ByteString
forall (m :: * -> *) anyAuth.
Monad m =>
Response (ConduitT () ByteString m ())
-> FacebookT anyAuth m ByteString
asBS Response (ConduitT () ByteString (ResourceT m) ())
response
     let Maybe Value
respJson :: Maybe Value = ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> ByteString
fromStrict ByteString
bs)
     FacebookT anyAuth (ResourceT m) Bool
-> (Value -> FacebookT anyAuth (ResourceT m) Bool)
-> Maybe Value
-> FacebookT anyAuth (ResourceT m) Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
       (Bool -> FacebookT anyAuth (ResourceT m) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
       (\Value
val -> FacebookT anyAuth (ResourceT m) Bool
-> (Bool -> FacebookT anyAuth (ResourceT m) Bool)
-> Maybe Bool
-> FacebookT anyAuth (ResourceT m) Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> FacebookT anyAuth (ResourceT m) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) Bool -> FacebookT anyAuth (ResourceT m) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return ((Value -> Parser Bool) -> Value -> Maybe Bool
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser Bool
isTrue Value
val))
       Maybe Value
respJson
  where
    isTrue :: Value -> Parser Bool
    isTrue :: Value -> Parser Bool
isTrue Value
val =
      String -> (Object -> Parser Bool) -> Value -> Parser Bool
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
        String
"success"
        (\Object
obj -> do
           (Bool
status :: Bool) <- Object
obj Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"success"
           Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
status)
        Value
val