{-# 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 Text
tuAccessToken :: Maybe AccessTokenData
  , TestUser -> Maybe Text
tuLoginUrl :: Maybe Text
  , TestUser -> Maybe Text
tuEmail :: Maybe Text
  , TestUser -> Maybe Text
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
$c== :: TestUser -> TestUser -> Bool
== :: TestUser -> TestUser -> Bool
$c/= :: TestUser -> TestUser -> Bool
/= :: 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
$ccompare :: TestUser -> TestUser -> Ordering
compare :: TestUser -> TestUser -> Ordering
$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
>= :: TestUser -> TestUser -> Bool
$cmax :: TestUser -> TestUser -> TestUser
max :: TestUser -> TestUser -> TestUser
$cmin :: TestUser -> TestUser -> TestUser
min :: TestUser -> TestUser -> 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
$cshowsPrec :: Int -> TestUser -> ShowS
showsPrec :: Int -> TestUser -> ShowS
$cshow :: TestUser -> String
show :: TestUser -> String
$cshowList :: [TestUser] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS TestUser
readsPrec :: Int -> ReadS TestUser
$creadList :: ReadS [TestUser]
readList :: ReadS [TestUser]
$creadPrec :: ReadPrec TestUser
readPrec :: ReadPrec TestUser
$creadListPrec :: ReadPrec [TestUser]
readListPrec :: ReadPrec [TestUser]
Read, Typeable)

instance A.FromJSON TestUser where
  parseJSON :: Value -> Parser TestUser
parseJSON (A.Object Object
v) =
    UserId
-> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> TestUser
TestUser (UserId
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> TestUser)
-> Parser UserId
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> 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 Text -> Maybe Text -> Maybe Text -> Maybe Text -> TestUser)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> TestUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"access_token" Parser (Maybe Text -> Maybe Text -> Maybe Text -> TestUser)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> TestUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"login_url" Parser (Maybe Text -> Maybe Text -> TestUser)
-> Parser (Maybe Text) -> Parser (Maybe Text -> TestUser)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"email" Parser (Maybe Text -> TestUser)
-> Parser (Maybe Text) -> Parser TestUser
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"password"
  parseJSON Value
_ = Parser TestUser
forall a. Parser a
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 Text
ctuName :: Maybe Text
  , CreateTestUser -> Maybe Text
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 Text -> Maybe Text -> CreateTestUser
CreateTestUser CreateTestUserInstalled
forall a. Default a => a
def Maybe Text
forall a. Default a => a
def Maybe Text
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 Text
name Maybe Text
locale) =
  CreateTestUserInstalled -> [Argument]
forInst CreateTestUserInstalled
installed [Argument] -> [Argument] -> [Argument]
forall a. [a] -> [a] -> [a]
++ ByteString -> Maybe Text -> [Argument]
forall {a}. SimpleType a => ByteString -> Maybe a -> [Argument]
forField ByteString
"name" Maybe Text
name [Argument] -> [Argument] -> [Argument]
forall a. [a] -> [a] -> [a]
++ ByteString -> Maybe Text -> [Argument]
forall {a}. SimpleType a => ByteString -> Maybe a -> [Argument]
forField ByteString
"locale" Maybe Text
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 :: forall (m :: * -> *).
(MonadResource m, MonadUnliftIO m, MonadThrow m, MonadIO m) =>
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
  Text
-> [Argument] -> Maybe AppAccessToken -> FacebookT Auth m TestUser
forall (m :: * -> *) a anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m, FromJSON a) =>
Text
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m a
getObject (Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Credentials -> Text
appId Credentials
creds Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/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 :: forall (m :: * -> *).
(MonadResource m, MonadUnliftIO m, MonadThrow m, MonadIO m) =>
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
  Text
-> [Argument]
-> Maybe AppAccessToken
-> FacebookT Auth m (Pager TestUser)
forall (m :: * -> *) a anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m, FromJSON a) =>
Text
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m a
getObject (Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Credentials -> Text
appId Credentials
creds Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadThrow m, MonadResource m, MonadIO m) =>
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
  Text -> [Argument] -> Maybe AppAccessToken -> FacebookT Auth m Bool
forall (m :: * -> *) anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
Text
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m Bool
getObjectBool
    (Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Credentials -> Text
appId Credentials
creds) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/accounts/test-users")
    [(ByteString
"uid", Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ UserId -> Text
idCode (UserId -> Text) -> UserId -> Text
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 :: forall (m :: * -> *).
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
TestUser -> AppAccessToken -> FacebookT Auth m Bool
removeTestUser TestUser
testUser AppAccessToken
_token = do
  Text -> [Argument] -> Maybe AppAccessToken -> FacebookT Auth m Bool
forall (m :: * -> *) anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
Text
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m Bool
getObjectBool
    (Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (UserId -> Text
idCode (UserId -> Text) -> UserId -> Text
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 :: forall (m :: * -> *).
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
TestUser -> TestUser -> FacebookT Auth m ()
makeFriendConn (TestUser {tuAccessToken :: TestUser -> Maybe Text
tuAccessToken = Maybe Text
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
$
  Text -> FacebookException
FbLibraryException
    Text
"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 Text
tuAccessToken = Maybe Text
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
$
  Text -> FacebookException
FbLibraryException
    Text
"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 Text
tuAccessToken = (Just Text
token1)}) (TestUser {tuId :: TestUser -> UserId
tuId = UserId
id2
                                                                    ,tuAccessToken :: TestUser -> Maybe Text
tuAccessToken = (Just Text
token2)}) = do
  let friendReq :: UserId -> UserId -> a -> FacebookT anyAuth m Bool
friendReq UserId
userId1 UserId
userId2 a
token =
        Text
-> [Argument]
-> Maybe (AccessToken Any)
-> FacebookT anyAuth m Bool
forall (m :: * -> *) anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
Text
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m Bool
getObjectBool
          (Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UserId -> Text
idCode UserId
userId1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/friends/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UserId -> Text
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 -> Text -> 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 Text
token1
  Bool
r2 <- UserId -> UserId -> Text -> 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 Text
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
$ Text -> FacebookException
FbLibraryException Text
"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
$ Text -> FacebookException
FbLibraryException Text
"Couldn't accept friend request."
  () -> FacebookT Auth m ()
forall a. a -> FacebookT Auth m a
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
  Text
tokenData <- TestUser -> Maybe Text
tuAccessToken TestUser
t
  let farFuture :: UTCTime
farFuture = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day
ModifiedJulianDay Integer
100000) DiffTime
0
  UserAccessToken -> Maybe UserAccessToken
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (UserId -> Text -> UTCTime -> UserAccessToken
UserAccessToken (TestUser -> UserId
tuId TestUser
t) Text
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 :: forall (m :: * -> *) anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
Text
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m Bool
getObjectBool Text
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 <- Text
-> Maybe (AccessToken anyKind)
-> [Argument]
-> FacebookT anyAuth (ResourceT m) Request
forall (m :: * -> *) anyKind anyAuth.
MonadIO m =>
Text
-> Maybe (AccessToken anyKind)
-> [Argument]
-> FacebookT anyAuth m Request
fbreq Text
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 a. a -> FacebookT anyAuth (ResourceT m) a
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 a. a -> FacebookT anyAuth (ResourceT m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) Bool -> FacebookT anyAuth (ResourceT m) Bool
forall a. a -> FacebookT anyAuth (ResourceT m) a
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 a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
status)
        Value
val