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

    module Facebook.Auth
      ( getAppAccessToken
      , getUserAccessTokenStep1
      , getUserAccessTokenStep2
      , getUserLogoutUrl
      , extendUserAccessToken
      , RedirectUrl
      , Permission
      , unPermission
      , hasExpired
      , isValid
      , parseSignedRequest
      , debugToken
      , DebugToken(..)
      ) where
    #if __GLASGOW_HASKELL__ <= 784
    import Control.Applicative
    #endif
    import Control.Monad (guard, mzero)
    import Control.Monad.IO.Class
    import Control.Monad.Trans.Maybe (MaybeT(..))
    import qualified Control.Monad.Trans.Resource as R
    import Crypto.Hash.Algorithms (SHA256)
    import Crypto.MAC.HMAC (HMAC(..), hmac)
    import Data.Aeson ((.:))
    import qualified Data.Aeson as AE
    import Data.Aeson.Parser (json')
    import qualified Data.Aeson.Types as AE
    import qualified Data.Attoparsec.ByteString.Char8 as AB
    import Data.ByteArray (ScrubbedBytes, convert)
    import Data.ByteArray.Encoding (Base(..), convertFromBase)
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Char8 as B8
    import qualified Data.List as L
    import Data.Maybe (fromMaybe)
    import Data.String (IsString(..))
    import Data.Text (Text)
    import qualified Data.Text as T
    import qualified Data.Text.Encoding as TE
    import qualified Data.Text.Encoding.Error as TE
    import Data.Time (UTCTime, addUTCTime, getCurrentTime)
    import Data.Typeable (Typeable)
    import qualified Network.HTTP.Types as HT
    import qualified UnliftIO.Exception as E

    import Facebook.Base
    import Facebook.Monad
    import Facebook.Types

    -- | Get an app access token from Facebook using your
    -- credentials.
    -- Ref: https://developers.facebook.com/docs/facebook-login/manually-build-a-login-flow
    getAppAccessToken ::
         (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, MonadIO m)
      => FacebookT Auth m AppAccessToken
    getAppAccessToken :: FacebookT Auth m AppAccessToken
    getAppAccessToken =
      FacebookT Auth (ResourceT m) AppAccessToken
    -> FacebookT Auth m AppAccessToken
    forall (m :: * -> *) anyAuth a.
    (MonadResource m, MonadUnliftIO m) =>
    FacebookT anyAuth (ResourceT m) a -> FacebookT anyAuth m a
    runResourceInFb (FacebookT Auth (ResourceT m) AppAccessToken
     -> FacebookT Auth m AppAccessToken)
    -> FacebookT Auth (ResourceT m) AppAccessToken
    -> FacebookT Auth m AppAccessToken
    forall a b. (a -> b) -> a -> b
    $ do
        Credentials
    creds <- FacebookT Auth (ResourceT m) Credentials
    forall (m :: * -> *).
    (Monad m, MonadIO m) =>
    FacebookT Auth m Credentials
    getCreds
        Request
    req <-
          Text
    -> Maybe (AccessToken Any)
    -> SimpleQuery
    -> FacebookT Auth (ResourceT m) Request
    forall (m :: * -> *) anyKind anyAuth.
    MonadIO m =>
    Text
    -> Maybe (AccessToken anyKind)
    -> SimpleQuery
    -> FacebookT anyAuth m Request
    fbreq "/oauth/access_token" Maybe (AccessToken Any)
    forall a. Maybe a
    Nothing (SimpleQuery -> FacebookT Auth (ResourceT m) Request)
    -> SimpleQuery -> FacebookT Auth (ResourceT m) Request
    forall a b. (a -> b) -> a -> b
    $
          Credentials -> SimpleQuery -> SimpleQuery
    forall a. ToSimpleQuery a => a -> SimpleQuery -> SimpleQuery
    tsq Credentials
    creds [("grant_type", "client_credentials")]
        Response (ConduitT () ByteString (ResourceT m) ())
    response <- Request
    -> FacebookT
         Auth
         (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
        (Value
    token :: AE.Value) <- Response (ConduitT () ByteString (ResourceT m) ())
    -> FacebookT Auth (ResourceT m) Value
    forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
    (MonadIO m, MonadTrans t, MonadThrow m, FromJSON a) =>
    Response (ConduitT () ByteString m ()) -> t m a
    asJson Response (ConduitT () ByteString (ResourceT m) ())
    response
        case (Value -> Parser Text) -> Value -> Maybe Text
    forall a b. (a -> Parser b) -> a -> Maybe b
    AE.parseMaybe Value -> Parser Text
    tokenParser Value
    token of
          Just appToken :: Text
    appToken -> AppAccessToken -> FacebookT Auth (ResourceT m) AppAccessToken
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AppAccessToken -> FacebookT Auth (ResourceT m) AppAccessToken)
    -> AppAccessToken -> FacebookT Auth (ResourceT m) AppAccessToken
    forall a b. (a -> b) -> a -> b
    $ Text -> AppAccessToken
    AppAccessToken Text
    appToken
          _ ->
            FacebookException -> FacebookT Auth (ResourceT m) AppAccessToken
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    E.throwIO (FacebookException -> FacebookT Auth (ResourceT m) AppAccessToken)
    -> FacebookException -> FacebookT Auth (ResourceT m) AppAccessToken
    forall a b. (a -> b) -> a -> b
    $
            Text -> FacebookException
    FbLibraryException ("Unable to parse: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> (String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Value -> String
    forall a. Show a => a -> String
    show Value
    token))
      where
        tokenParser :: AE.Value -> AE.Parser AccessTokenData
        tokenParser :: Value -> Parser Text
    tokenParser val :: Value
    val =
          String -> (Object -> Parser Text) -> Value -> Parser Text
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
    AE.withObject
            "accessToken"
            (\obj :: Object
    obj -> do
               (Text
    token :: Text) <- Object
    obj Object -> Text -> Parser Text
    forall a. FromJSON a => Object -> Text -> Parser a
    AE..: "access_token"
               Text -> Parser Text
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    token)
            Value
    val

    -- | The first step to get an user access token.  Returns the
    -- Facebook URL you should redirect you user to.  Facebook will
    -- authenticate the user, authorize your app and then redirect
    -- the user back into the provider 'RedirectUrl'.
    getUserAccessTokenStep1 ::
         (Monad m, MonadIO m)
      => RedirectUrl
      -> [Permission]
      -> FacebookT Auth m Text
    getUserAccessTokenStep1 :: Text -> [Permission] -> FacebookT Auth m Text
    getUserAccessTokenStep1 redirectUrl :: Text
    redirectUrl perms :: [Permission]
    perms = do
      Credentials
    creds <- FacebookT Auth m Credentials
    forall (m :: * -> *).
    (Monad m, MonadIO m) =>
    FacebookT Auth m Credentials
    getCreds
      Text
    apiVersion <- FacebookT Auth m Text
    forall (m :: * -> *) anyAuth. MonadIO m => FacebookT anyAuth m Text
    getApiVersion
      (FbTier -> Text) -> FacebookT Auth m Text
    forall (m :: * -> *) a anyAuth.
    Monad m =>
    (FbTier -> a) -> FacebookT anyAuth m a
    withTier ((FbTier -> Text) -> FacebookT Auth m Text)
    -> (FbTier -> Text) -> FacebookT Auth m Text
    forall a b. (a -> b) -> a -> b
    $ \tier :: FbTier
    tier ->
        let urlBase :: Text
    urlBase =
              case FbTier
    tier of
                Production ->
                  "https://www.facebook.com/" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    apiVersion Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                  "/dialog/oauth?client_id="
                Beta ->
                  "https://www.beta.facebook.com/" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    apiVersion Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                  "/dialog/oauth?client_id="
         in [Text] -> Text
    T.concat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $
            Text
    urlBase Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :
            Credentials -> Text
    appId Credentials
    creds Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :
            "&redirect_uri=" Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :
            Text
    redirectUrl Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :
            (case [Permission]
    perms of
               [] -> []
               _ -> "&scope=" Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    L.intersperse "," ((Permission -> Text) -> [Permission] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Permission -> Text
    unPermission [Permission]
    perms))

    -- | The second step to get an user access token.  If the user is
    -- successfully authenticate and they authorize your application,
    -- then they'll be redirected back to the 'RedirectUrl' you've
    -- passed to 'getUserAccessTokenStep1'.  You should take the
    -- request query parameters passed to your 'RedirectUrl' and give
    -- to this function that will complete the user authentication
    -- flow and give you an @'UserAccessToken'@.
    getUserAccessTokenStep2 ::
         (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, MonadIO m)
      => RedirectUrl -- ^ Should be exactly the same
         -- as in 'getUserAccessTokenStep1'.
      -> [Argument] -- ^ Query parameters.
      -> FacebookT Auth m UserAccessToken
    getUserAccessTokenStep2 :: Text -> SimpleQuery -> FacebookT Auth m UserAccessToken
    getUserAccessTokenStep2 redirectUrl :: Text
    redirectUrl query :: SimpleQuery
    query =
      case SimpleQuery
    query of
        [code :: Argument
    code@("code", _)] ->
          FacebookT Auth (ResourceT m) UserAccessToken
    -> FacebookT Auth m UserAccessToken
    forall (m :: * -> *) anyAuth a.
    (MonadResource m, MonadUnliftIO m) =>
    FacebookT anyAuth (ResourceT m) a -> FacebookT anyAuth m a
    runResourceInFb (FacebookT Auth (ResourceT m) UserAccessToken
     -> FacebookT Auth m UserAccessToken)
    -> FacebookT Auth (ResourceT m) UserAccessToken
    -> FacebookT Auth m UserAccessToken
    forall a b. (a -> b) -> a -> b
    $
          -- Get the access token data through Facebook's OAuth.
           do
            UTCTime
    now <- IO UTCTime -> FacebookT Auth (ResourceT m) UTCTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
            Credentials
    creds <- FacebookT Auth (ResourceT m) Credentials
    forall (m :: * -> *).
    (Monad m, MonadIO m) =>
    FacebookT Auth m Credentials
    getCreds
            Request
    req <-
              Text
    -> Maybe (AccessToken Any)
    -> SimpleQuery
    -> FacebookT Auth (ResourceT m) Request
    forall (m :: * -> *) anyKind anyAuth.
    MonadIO m =>
    Text
    -> Maybe (AccessToken anyKind)
    -> SimpleQuery
    -> FacebookT anyAuth m Request
    fbreq "/oauth/access_token" Maybe (AccessToken Any)
    forall a. Maybe a
    Nothing (SimpleQuery -> FacebookT Auth (ResourceT m) Request)
    -> SimpleQuery -> FacebookT Auth (ResourceT m) Request
    forall a b. (a -> b) -> a -> b
    $
              Credentials -> SimpleQuery -> SimpleQuery
    forall a. ToSimpleQuery a => a -> SimpleQuery -> SimpleQuery
    tsq Credentials
    creds [Argument
    code, ("redirect_uri", Text -> ByteString
    TE.encodeUtf8 Text
    redirectUrl)]
            Response (ConduitT () ByteString (ResourceT m) ())
    response <- Request
    -> FacebookT
         Auth
         (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
            (Value
    userToken :: AE.Value) <- Response (ConduitT () ByteString (ResourceT m) ())
    -> FacebookT Auth (ResourceT m) Value
    forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
    (MonadIO m, MonadTrans t, MonadThrow m, FromJSON a) =>
    Response (ConduitT () ByteString m ()) -> t m a
    asJson Response (ConduitT () ByteString (ResourceT m) ())
    response
            let (token :: Text
    token, expire :: UTCTime
    expire) = UTCTime -> Value -> (Text, UTCTime)
    userAccessTokenParser UTCTime
    now Value
    userToken
             -- Get user's ID throught Facebook's graph.
            Response (ConduitT () ByteString (ResourceT m) ())
    userResponse <-
              Request
    -> FacebookT
         Auth
         (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
     -> FacebookT
          Auth
          (ResourceT m)
          (Response (ConduitT () ByteString (ResourceT m) ())))
    -> FacebookT Auth (ResourceT m) Request
    -> FacebookT
         Auth
         (ResourceT m)
         (Response (ConduitT () ByteString (ResourceT m) ()))
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<
              Text
    -> Maybe UserAccessToken
    -> SimpleQuery
    -> FacebookT Auth (ResourceT m) Request
    forall (m :: * -> *) anyKind anyAuth.
    MonadIO m =>
    Text
    -> Maybe (AccessToken anyKind)
    -> SimpleQuery
    -> FacebookT anyAuth m Request
    fbreq
                "/me"
                (UserAccessToken -> Maybe UserAccessToken
    forall a. a -> Maybe a
    Just (UserId -> Text -> UTCTime -> UserAccessToken
    UserAccessToken "invalid id" Text
    token UTCTime
    expire))
                [("fields", "id")]
            (UserId
    userId :: UserId) <- Response (ConduitT () ByteString (ResourceT m) ())
    -> FacebookT Auth (ResourceT m) UserId
    forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
    (MonadIO m, MonadTrans t, MonadThrow m, FromJSON a) =>
    Response (ConduitT () ByteString m ()) -> t m a
    asJson Response (ConduitT () ByteString (ResourceT m) ())
    userResponse
            UserAccessToken -> FacebookT Auth (ResourceT m) UserAccessToken
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UserAccessToken -> FacebookT Auth (ResourceT m) UserAccessToken)
    -> UserAccessToken -> FacebookT Auth (ResourceT m) UserAccessToken
    forall a b. (a -> b) -> a -> b
    $ UserId -> Text -> UTCTime -> UserAccessToken
    UserAccessToken UserId
    userId Text
    token UTCTime
    expire
        _ ->
          let [error_ :: ByteString
    error_, errorReason :: ByteString
    errorReason, errorDescr :: ByteString
    errorDescr] =
                (ByteString -> ByteString) -> [ByteString] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map
                  (ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe "" (Maybe ByteString -> ByteString)
    -> (ByteString -> Maybe ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> SimpleQuery -> Maybe ByteString)
    -> SimpleQuery -> ByteString -> Maybe ByteString
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ByteString -> SimpleQuery -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup SimpleQuery
    query)
                  ["error", "error_reason", "error_description"]
              errorType :: Text
    errorType = [Text] -> Text
    T.concat [ByteString -> Text
    t ByteString
    error_, " (", ByteString -> Text
    t ByteString
    errorReason, ")"]
              t :: ByteString -> Text
    t = OnDecodeError -> ByteString -> Text
    TE.decodeUtf8With OnDecodeError
    TE.lenientDecode
           in FacebookException -> FacebookT Auth m UserAccessToken
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    E.throwIO (FacebookException -> FacebookT Auth m UserAccessToken)
    -> FacebookException -> FacebookT Auth m UserAccessToken
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> FacebookException
    FacebookException Text
    errorType (ByteString -> Text
    t ByteString
    errorDescr)

    -- | Attoparsec parser for user access tokens returned by
    -- Facebook as a query string.  Returns an user access token with
    -- a broken 'UserId'.
    userAccessTokenParser ::
         UTCTime -- ^ 'getCurrentTime'
      -> AE.Value
      -> (AccessTokenData, UTCTime)
    userAccessTokenParser :: UTCTime -> Value -> (Text, UTCTime)
    userAccessTokenParser now :: UTCTime
    now val :: Value
    val =
      case (Value -> Parser (Text, UTCTime)) -> Value -> Maybe (Text, UTCTime)
    forall a b. (a -> Parser b) -> a -> Maybe b
    AE.parseMaybe Value -> Parser (Text, UTCTime)
    tokenParser Value
    val of
        Just (token :: Text
    token, parser :: UTCTime
    parser) -> (Text
    token, UTCTime
    parser)
        _ -> String -> (Text, UTCTime)
    forall a. HasCallStack => String -> a
    error (String -> (Text, UTCTime)) -> String -> (Text, UTCTime)
    forall a b. (a -> b) -> a -> b
    $ "userAccessTokenParser: failed to parse " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Value -> String
    forall a. Show a => a -> String
    show Value
    val
      where
        toExpire :: Int -> UTCTime
    toExpire expt :: Int
    expt = NominalDiffTime -> UTCTime -> UTCTime
    addUTCTime (Int -> NominalDiffTime
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    expt) UTCTime
    now
        tokenParser :: AE.Value -> AE.Parser (AccessTokenData, UTCTime)
        tokenParser :: Value -> Parser (Text, UTCTime)
    tokenParser value :: Value
    value =
          String
    -> (Object -> Parser (Text, UTCTime))
    -> Value
    -> Parser (Text, UTCTime)
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
    AE.withObject
            "accessToken"
            (\obj :: Object
    obj -> do
               (Text
    token :: Text) <- Object
    obj Object -> Text -> Parser Text
    forall a. FromJSON a => Object -> Text -> Parser a
    AE..: "access_token"
               (Int
    expires_in :: Int) <- Object
    obj Object -> Text -> Parser Int
    forall a. FromJSON a => Object -> Text -> Parser a
    AE..: "expires_in"
               (Text, UTCTime) -> Parser (Text, UTCTime)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text
    token, Int -> UTCTime
    toExpire Int
    expires_in))
            Value
    value

    -- | The URL an user should be redirected to in order to log them
    -- out of their Facebook session.  Facebook will then redirect
    -- the user to the provided URL after logging them out.  Note
    -- that, at the time of this writing, Facebook's policies require
    -- you to log the user out of Facebook when they ask to log out
    -- of your site.
    --
    -- Note also that Facebook may refuse to redirect the user to the
    -- provided URL if their user access token is invalid.  In order
    -- to prevent this bug, we suggest that you use 'isValid' before
    -- redirecting the user to the URL provided by 'getUserLogoutUrl'
    -- since this function doesn't do any validity checks.
    getUserLogoutUrl ::
         Monad m
      => UserAccessToken
         -- ^ The user's access token.
      -> RedirectUrl
         -- ^ URL the user should be directed to in
         -- your site domain.
      -> FacebookT Auth m Text -- ^ Logout URL in
    -- @https:\/\/www.facebook.com\/@ (or on
    -- @https:\/\/www.beta.facebook.com\/@ when
    -- using the beta tier).
    getUserLogoutUrl :: UserAccessToken -> Text -> FacebookT Auth m Text
    getUserLogoutUrl (UserAccessToken _ data_ :: Text
    data_ _) next :: Text
    next = do
      (FbTier -> Text) -> FacebookT Auth m Text
    forall (m :: * -> *) a anyAuth.
    Monad m =>
    (FbTier -> a) -> FacebookT anyAuth m a
    withTier ((FbTier -> Text) -> FacebookT Auth m Text)
    -> (FbTier -> Text) -> FacebookT Auth m Text
    forall a b. (a -> b) -> a -> b
    $ \tier :: FbTier
    tier ->
        let urlBase :: ByteString
    urlBase =
              case FbTier
    tier of
                Production -> "https://www.facebook.com/logout.php?"
                Beta -> "https://www.beta.facebook.com/logout.php?"
         in ByteString -> Text
    TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
    forall a b. (a -> b) -> a -> b
    $
            ByteString
    urlBase ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <>
            Bool -> Query -> ByteString
    HT.renderQuery
              Bool
    False
              [ ("next", ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (Text -> ByteString
    TE.encodeUtf8 Text
    next))
              , ("access_token", ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (Text -> ByteString
    TE.encodeUtf8 Text
    data_))
              ]

    -- | URL where the user is redirected to after Facebook
    -- authenticates the user authorizes your application.  This URL
    -- should be inside the domain registered for your Facebook
    -- application.
    type RedirectUrl = Text

    -- | A permission that is asked for the user when he authorizes
    -- your app.  Please refer to Facebook's documentation at
    -- <https://developers.facebook.com/docs/reference/api/permissions/>
    -- to see which permissions are available.
    --
    -- This is a @newtype@ of 'Text' that supports only 'IsString'.
    -- This means that to create a 'Permission' you should use the
    -- @OverloadedStrings@ language extension.  For example,
    --
    -- > {-# LANGUAGE OverloadedStrings #-}
    -- >
    -- > perms :: [Permission]
    -- > perms = ["user_about_me", "email", "offline_access"]
    newtype Permission =
      Permission
        { Permission -> Text
    unPermission :: Text
        -- ^ Retrieves the 'Text' back from a 'Permission'.  Most of
        -- the time you won't need to use this function, but you may
        -- need it if you're a library author.
        }
      deriving (Permission -> Permission -> Bool
    (Permission -> Permission -> Bool)
    -> (Permission -> Permission -> Bool) -> Eq Permission
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Permission -> Permission -> Bool
    $c/= :: Permission -> Permission -> Bool
    == :: Permission -> Permission -> Bool
    $c== :: Permission -> Permission -> Bool
    Eq, Eq Permission
    Eq Permission =>
    (Permission -> Permission -> Ordering)
    -> (Permission -> Permission -> Bool)
    -> (Permission -> Permission -> Bool)
    -> (Permission -> Permission -> Bool)
    -> (Permission -> Permission -> Bool)
    -> (Permission -> Permission -> Permission)
    -> (Permission -> Permission -> Permission)
    -> Ord Permission
    Permission -> Permission -> Bool
    Permission -> Permission -> Ordering
    Permission -> Permission -> Permission
    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 :: Permission -> Permission -> Permission
    $cmin :: Permission -> Permission -> Permission
    max :: Permission -> Permission -> Permission
    $cmax :: Permission -> Permission -> Permission
    >= :: Permission -> Permission -> Bool
    $c>= :: Permission -> Permission -> Bool
    > :: Permission -> Permission -> Bool
    $c> :: Permission -> Permission -> Bool
    <= :: Permission -> Permission -> Bool
    $c<= :: Permission -> Permission -> Bool
    < :: Permission -> Permission -> Bool
    $c< :: Permission -> Permission -> Bool
    compare :: Permission -> Permission -> Ordering
    $ccompare :: Permission -> Permission -> Ordering
    $cp1Ord :: Eq Permission
    Ord)

    instance Show Permission where
      show :: Permission -> String
    show = Text -> String
    forall a. Show a => a -> String
    show (Text -> String) -> (Permission -> Text) -> Permission -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Permission -> Text
    unPermission

    instance IsString Permission where
      fromString :: String -> Permission
    fromString = Text -> Permission
    Permission (Text -> Permission) -> (String -> Text) -> String -> Permission
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    forall a. IsString a => String -> a
    fromString

    -- | @True@ if the access token has expired, otherwise @False@.
    hasExpired :: (Functor m, MonadIO m) => AccessToken anyKind -> m Bool
    hasExpired :: AccessToken anyKind -> m Bool
    hasExpired token :: AccessToken anyKind
    token =
      case AccessToken anyKind -> Maybe UTCTime
    forall anyKind. AccessToken anyKind -> Maybe UTCTime
    accessTokenExpires AccessToken anyKind
    token of
        Nothing -> Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        Just expTime :: UTCTime
    expTime -> (UTCTime -> UTCTime -> Bool
    forall a. Ord a => a -> a -> Bool
    >= UTCTime
    expTime) (UTCTime -> Bool) -> m UTCTime -> m Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO UTCTime -> m UTCTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime

    -- | @True@ if the access token is valid.  An expired access
    -- token is not valid (see 'hasExpired').  However, a non-expired
    -- access token may not be valid as well.  For example, in the
    -- case of an user access token, they may have changed their
    -- password, logged out from Facebook or blocked your app.
    isValid ::
         (R.MonadResource m, R.MonadUnliftIO m)
      => AccessToken anyKind
      -> FacebookT anyAuth m Bool
    isValid :: AccessToken anyKind -> FacebookT anyAuth m Bool
    isValid token :: AccessToken anyKind
    token = do
      Bool
    expired <- AccessToken anyKind -> FacebookT anyAuth m Bool
    forall (m :: * -> *) anyKind.
    (Functor m, MonadIO m) =>
    AccessToken anyKind -> m Bool
    hasExpired AccessToken anyKind
    token
      if Bool
    expired
        then Bool -> FacebookT anyAuth m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        else let page :: Text
    page =
                   case AccessToken anyKind
    token of
                     UserAccessToken _ _ _ -> "/me"
                     -- Documented way of checking if the token is valid,
                     -- see <https://developers.facebook.com/blog/post/500/>.
                     AppAccessToken _ -> "/19292868552"
                 -- This is Facebook's page on Facebook.  While
                 -- this behaviour is undocumented, it will
                 -- return a "400 Bad Request" status code
                 -- whenever the access token is invalid.  It
                 -- will actually work with user access tokens,
                 -- too, but they have another, better way of
                 -- being checked.
              in Request -> FacebookT anyAuth m Bool
    forall (m :: * -> *) anyAuth.
    (MonadResource m, MonadUnliftIO m) =>
    Request -> FacebookT anyAuth m Bool
    httpCheck (Request -> FacebookT anyAuth m Bool)
    -> FacebookT anyAuth m Request -> FacebookT anyAuth m Bool
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Text
    -> Maybe (AccessToken anyKind)
    -> SimpleQuery
    -> FacebookT anyAuth m Request
    forall (m :: * -> *) anyKind anyAuth.
    MonadIO m =>
    Text
    -> Maybe (AccessToken anyKind)
    -> SimpleQuery
    -> FacebookT anyAuth m Request
    fbreq Text
    page (AccessToken anyKind -> Maybe (AccessToken anyKind)
    forall a. a -> Maybe a
    Just AccessToken anyKind
    token) []

    -- | Extend the expiration time of an user access token (see
    -- <https://developers.facebook.com/docs/offline-access-deprecation/>,
    -- <https://developers.facebook.com/roadmap/offline-access-removal/>).
    -- Only short-lived user access tokens may extended into
    -- long-lived user access tokens, you must get a new short-lived
    -- user access token if you need to extend a long-lived
    -- one.  Returns @Left exc@ if there is an error while extending,
    -- or @Right token@ with the new user access token (which could
    -- have the same data and expiration time as before, but you
    -- can't assume this).  Note that expired access tokens can't be
    -- extended, only valid tokens.
    extendUserAccessToken ::
         (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m, MonadIO m)
      => UserAccessToken
      -> FacebookT Auth m (Either FacebookException UserAccessToken)
    extendUserAccessToken :: UserAccessToken
    -> FacebookT Auth m (Either FacebookException UserAccessToken)
    extendUserAccessToken token :: UserAccessToken
    token@(UserAccessToken uid :: UserId
    uid data_ :: Text
    data_ _) = do
      Bool
    expired <- UserAccessToken -> FacebookT Auth m Bool
    forall (m :: * -> *) anyKind.
    (Functor m, MonadIO m) =>
    AccessToken anyKind -> m Bool
    hasExpired UserAccessToken
    token
      if Bool
    expired
        then Either FacebookException UserAccessToken
    -> FacebookT Auth m (Either FacebookException UserAccessToken)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FacebookException -> Either FacebookException UserAccessToken
    forall a b. a -> Either a b
    Left FacebookException
    hasExpiredExc)
        else FacebookT Auth m (Either FacebookException UserAccessToken)
    tryToExtend
      where
        tryToExtend :: FacebookT Auth m (Either FacebookException UserAccessToken)
    tryToExtend =
          FacebookT
      Auth (ResourceT m) (Either FacebookException UserAccessToken)
    -> FacebookT Auth m (Either FacebookException UserAccessToken)
    forall (m :: * -> *) anyAuth a.
    (MonadResource m, MonadUnliftIO m) =>
    FacebookT anyAuth (ResourceT m) a -> FacebookT anyAuth m a
    runResourceInFb (FacebookT
       Auth (ResourceT m) (Either FacebookException UserAccessToken)
     -> FacebookT Auth m (Either FacebookException UserAccessToken))
    -> FacebookT
         Auth (ResourceT m) (Either FacebookException UserAccessToken)
    -> FacebookT Auth m (Either FacebookException UserAccessToken)
    forall a b. (a -> b) -> a -> b
    $ do
            Credentials
    creds <- FacebookT Auth (ResourceT m) Credentials
    forall (m :: * -> *).
    (Monad m, MonadIO m) =>
    FacebookT Auth m Credentials
    getCreds
            Request
    req <-
              Text
    -> Maybe (AccessToken Any)
    -> SimpleQuery
    -> FacebookT Auth (ResourceT m) Request
    forall (m :: * -> *) anyKind anyAuth.
    MonadIO m =>
    Text
    -> Maybe (AccessToken anyKind)
    -> SimpleQuery
    -> FacebookT anyAuth m Request
    fbreq "/oauth/access_token" Maybe (AccessToken Any)
    forall a. Maybe a
    Nothing (SimpleQuery -> FacebookT Auth (ResourceT m) Request)
    -> SimpleQuery -> FacebookT Auth (ResourceT m) Request
    forall a b. (a -> b) -> a -> b
    $
              Credentials -> SimpleQuery -> SimpleQuery
    forall a. ToSimpleQuery a => a -> SimpleQuery -> SimpleQuery
    tsq
                Credentials
    creds
                [ ("grant_type", "fb_exchange_token")
                , ("fb_exchange_token", Text -> ByteString
    TE.encodeUtf8 Text
    data_)
                ]
            Response (ConduitT () ByteString (ResourceT m) ())
    response <- Request
    -> FacebookT
         Auth
         (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
            Either FacebookException Value
    userToken <- FacebookT Auth (ResourceT m) Value
    -> FacebookT Auth (ResourceT m) (Either FacebookException Value)
    forall (m :: * -> *) e a.
    (MonadUnliftIO m, Exception e) =>
    m a -> m (Either e a)
    E.try (FacebookT Auth (ResourceT m) Value
     -> FacebookT Auth (ResourceT m) (Either FacebookException Value))
    -> FacebookT Auth (ResourceT m) Value
    -> FacebookT Auth (ResourceT m) (Either FacebookException Value)
    forall a b. (a -> b) -> a -> b
    $ Response (ConduitT () ByteString (ResourceT m) ())
    -> FacebookT Auth (ResourceT m) Value
    forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
    (MonadIO m, MonadTrans t, MonadThrow m, FromJSON a) =>
    Response (ConduitT () ByteString m ()) -> t m a
    asJson Response (ConduitT () ByteString (ResourceT m) ())
    response
            case Either FacebookException Value
    userToken of
              Right val :: Value
    val -> do
                UTCTime
    now <- IO UTCTime -> FacebookT Auth (ResourceT m) UTCTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
                let (extendedtoken :: Text
    extendedtoken, expire :: UTCTime
    expire) = UTCTime -> Value -> (Text, UTCTime)
    userAccessTokenParser UTCTime
    now Value
    val
                Either FacebookException UserAccessToken
    -> FacebookT
         Auth (ResourceT m) (Either FacebookException UserAccessToken)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either FacebookException UserAccessToken
     -> FacebookT
          Auth (ResourceT m) (Either FacebookException UserAccessToken))
    -> Either FacebookException UserAccessToken
    -> FacebookT
         Auth (ResourceT m) (Either FacebookException UserAccessToken)
    forall a b. (a -> b) -> a -> b
    $ UserAccessToken -> Either FacebookException UserAccessToken
    forall a b. b -> Either a b
    Right (UserAccessToken -> Either FacebookException UserAccessToken)
    -> UserAccessToken -> Either FacebookException UserAccessToken
    forall a b. (a -> b) -> a -> b
    $ UserId -> Text -> UTCTime -> UserAccessToken
    UserAccessToken UserId
    uid Text
    extendedtoken UTCTime
    expire
              Left exc :: FacebookException
    exc -> Either FacebookException UserAccessToken
    -> FacebookT
         Auth (ResourceT m) (Either FacebookException UserAccessToken)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FacebookException -> Either FacebookException UserAccessToken
    forall a b. a -> Either a b
    Left FacebookException
    exc)
        hasExpiredExc :: FacebookException
    hasExpiredExc =
          [Text] -> FacebookException
    mkExc
            [ "the user access token has already expired, "
            , "so I'll not try to extend it."
            ]
        mkExc :: [Text] -> FacebookException
    mkExc = Text -> FacebookException
    FbLibraryException (Text -> FacebookException)
    -> ([Text] -> Text) -> [Text] -> FacebookException
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> Text
    T.concat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ("extendUserAccessToken: " Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :)

    -- | Parses a Facebook signed request
    -- (<https://developers.facebook.com/docs/authentication/signed_request/>),
    -- verifies its authencity and integrity using the HMAC and
    -- decodes its JSON object.
    parseSignedRequest ::
         (AE.FromJSON a, Monad m, MonadIO m)
      => B8.ByteString -- ^ Encoded Facebook signed request
      -> FacebookT Auth m (Maybe a)
    parseSignedRequest :: ByteString -> FacebookT Auth m (Maybe a)
    parseSignedRequest signedRequest :: ByteString
    signedRequest =
      MaybeT (FacebookT Auth m) a -> FacebookT Auth m (Maybe a)
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT (FacebookT Auth m) a -> FacebookT Auth m (Maybe a))
    -> MaybeT (FacebookT Auth m) a -> FacebookT Auth m (Maybe a)
    forall a b. (a -> b) -> a -> b
    $
      -- Split, decode and JSON-parse
       do
        let (encodedSignature :: ByteString
    encodedSignature, encodedUnparsedPayloadWithDot :: ByteString
    encodedUnparsedPayloadWithDot) =
              (Char -> Bool) -> ByteString -> Argument
    B8.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '.') ByteString
    signedRequest
        ('.', encodedUnparsedPayload :: ByteString
    encodedUnparsedPayload) <-
          FacebookT Auth m (Maybe (Char, ByteString))
    -> MaybeT (FacebookT Auth m) (Char, ByteString)
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (FacebookT Auth m (Maybe (Char, ByteString))
     -> MaybeT (FacebookT Auth m) (Char, ByteString))
    -> FacebookT Auth m (Maybe (Char, ByteString))
    -> MaybeT (FacebookT Auth m) (Char, ByteString)
    forall a b. (a -> b) -> a -> b
    $ Maybe (Char, ByteString)
    -> FacebookT Auth m (Maybe (Char, ByteString))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> Maybe (Char, ByteString)
    B8.uncons ByteString
    encodedUnparsedPayloadWithDot)
        ScrubbedBytes
    signature <-
          Either String ScrubbedBytes
    -> MaybeT (FacebookT Auth m) ScrubbedBytes
    forall (m :: * -> *) a b. Monad m => Either a b -> MaybeT m b
    eitherToMaybeT (Either String ScrubbedBytes
     -> MaybeT (FacebookT Auth m) ScrubbedBytes)
    -> Either String ScrubbedBytes
    -> MaybeT (FacebookT Auth m) ScrubbedBytes
    forall a b. (a -> b) -> a -> b
    $
          Base -> ByteString -> Either String ScrubbedBytes
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    Base -> bin -> Either String bout
    convertFromBase Base
    Base64 (ByteString -> Either String ScrubbedBytes)
    -> ByteString -> Either String ScrubbedBytes
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    addBase64Padding ByteString
    encodedSignature
        ByteString
    unparsedPayload <-
          Either String ByteString -> MaybeT (FacebookT Auth m) ByteString
    forall (m :: * -> *) a b. Monad m => Either a b -> MaybeT m b
    eitherToMaybeT (Either String ByteString -> MaybeT (FacebookT Auth m) ByteString)
    -> Either String ByteString -> MaybeT (FacebookT Auth m) ByteString
    forall a b. (a -> b) -> a -> b
    $
          Base -> ByteString -> Either String ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    Base -> bin -> Either String bout
    convertFromBase Base
    Base64 (ByteString -> Either String ByteString)
    -> ByteString -> Either String ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    addBase64Padding ByteString
    encodedUnparsedPayload
        Value
    payload <- Either String Value -> MaybeT (FacebookT Auth m) Value
    forall (m :: * -> *) a b. Monad m => Either a b -> MaybeT m b
    eitherToMaybeT (Either String Value -> MaybeT (FacebookT Auth m) Value)
    -> Either String Value -> MaybeT (FacebookT Auth m) Value
    forall a b. (a -> b) -> a -> b
    $ Parser Value -> ByteString -> Either String Value
    forall a. Parser a -> ByteString -> Either String a
    AB.parseOnly Parser Value
    json' ByteString
    unparsedPayload
         -- Verify signature
        SignedRequestAlgorithm algo :: Text
    algo <- Value -> MaybeT (FacebookT Auth m) SignedRequestAlgorithm
    forall a (m :: * -> *).
    (FromJSON a, Monad m) =>
    Value -> MaybeT m a
    fromJson Value
    payload
        Bool -> MaybeT (FacebookT Auth m) ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Text
    algo Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == "HMAC-SHA256")
        Credentials
    creds <- FacebookT Auth m Credentials
    -> MaybeT (FacebookT Auth m) Credentials
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift FacebookT Auth m Credentials
    forall (m :: * -> *).
    (Monad m, MonadIO m) =>
    FacebookT Auth m Credentials
    getCreds
        let hmacKey :: ByteString
    hmacKey = Credentials -> ByteString
    credsToHmacKey Credentials
    creds
            expectedSignature :: HMAC SHA256
    expectedSignature = ByteString -> ByteString -> HMAC SHA256
    forall key message a.
    (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
    key -> message -> HMAC a
    hmac ByteString
    hmacKey ByteString
    encodedUnparsedPayload :: HMAC SHA256
        Bool -> MaybeT (FacebookT Auth m) ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard ((ScrubbedBytes
    signature :: ScrubbedBytes) ScrubbedBytes -> ScrubbedBytes -> Bool
    forall a. Eq a => a -> a -> Bool
    == (HMAC SHA256 -> ScrubbedBytes
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    convert HMAC SHA256
    expectedSignature))
         -- Parse user data type
        Value -> MaybeT (FacebookT Auth m) a
    forall a (m :: * -> *).
    (FromJSON a, Monad m) =>
    Value -> MaybeT m a
    fromJson Value
    payload
      where
        eitherToMaybeT :: Monad m => Either a b -> MaybeT m b
        eitherToMaybeT :: Either a b -> MaybeT m b
    eitherToMaybeT = m (Maybe b) -> MaybeT m b
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (m (Maybe b) -> MaybeT m b)
    -> (Either a b -> m (Maybe b)) -> Either a b -> MaybeT m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe b -> m (Maybe b)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe b -> m (Maybe b))
    -> (Either a b -> Maybe b) -> Either a b -> m (Maybe b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Maybe b) -> (b -> Maybe b) -> Either a b -> Maybe b
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe b -> a -> Maybe b
    forall a b. a -> b -> a
    const Maybe b
    forall a. Maybe a
    Nothing) b -> Maybe b
    forall a. a -> Maybe a
    Just
        fromJson :: (AE.FromJSON a, Monad m) => AE.Value -> MaybeT m a
        fromJson :: Value -> MaybeT m a
    fromJson = Either String a -> MaybeT m a
    forall (m :: * -> *) a b. Monad m => Either a b -> MaybeT m b
    eitherToMaybeT (Either String a -> MaybeT m a)
    -> (Value -> Either String a) -> Value -> MaybeT m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Value -> Parser a) -> Value -> Either String a
    forall a b. (a -> Parser b) -> a -> Either String b
    AE.parseEither Value -> Parser a
    forall a. FromJSON a => Value -> Parser a
    AE.parseJSON
        -- credsToHmacKey :: Credentials -> MacKey ctx SHA256
        credsToHmacKey :: Credentials -> ByteString
    credsToHmacKey = Credentials -> ByteString
    appSecretBS

    newtype SignedRequestAlgorithm =
      SignedRequestAlgorithm Text

    instance AE.FromJSON SignedRequestAlgorithm where
      parseJSON :: Value -> Parser SignedRequestAlgorithm
    parseJSON (AE.Object v :: Object
    v) = Text -> SignedRequestAlgorithm
    SignedRequestAlgorithm (Text -> SignedRequestAlgorithm)
    -> Parser Text -> Parser SignedRequestAlgorithm
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Object
    v Object -> Text -> Parser Text
    forall a. FromJSON a => Object -> Text -> Parser a
    .: "algorithm"
      parseJSON _ = Parser SignedRequestAlgorithm
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    -- | The @base64-bytestring@ package provides two different
    -- decoding functions for @base64url@: 'Base64URL.decode' and
    -- 'Base64URL.decodeLenient'.  The former is too strict for us
    -- since Facebook does add padding to its signed requests, but
    -- the latter is too lenient and will accept *anything*.
    --
    -- Instead of being too lenient, we just use this function add
    -- the padding base to the encoded string, thus allowing
    -- 'Base64URL.decode' to chew it.
    addBase64Padding :: B.ByteString -> B.ByteString
    addBase64Padding :: ByteString -> ByteString
    addBase64Padding bs :: ByteString
    bs
      | Int
    drem Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 2 = ByteString
    bs ByteString -> ByteString -> ByteString
    `B.append` "=="
      | Int
    drem Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 3 = ByteString
    bs ByteString -> ByteString -> ByteString
    `B.append` "="
      | Bool
    otherwise = ByteString
    bs
      where
        drem :: Int
    drem = ByteString -> Int
    B.length ByteString
    bs Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` 4

    -- | Get detailed information about an access token.
    debugToken ::
         (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)
      => AppAccessToken -- ^ Your app access token.
      -> AccessTokenData -- ^ The access token you want to debug.
      -> FacebookT Auth m DebugToken
    debugToken :: AppAccessToken -> Text -> FacebookT Auth m DebugToken
    debugToken appToken :: AppAccessToken
    appToken userTokenData :: Text
    userTokenData = do
      Request
    req <-
        Text
    -> Maybe AppAccessToken -> SimpleQuery -> FacebookT Auth m Request
    forall (m :: * -> *) anyKind anyAuth.
    MonadIO m =>
    Text
    -> Maybe (AccessToken anyKind)
    -> SimpleQuery
    -> FacebookT anyAuth m Request
    fbreq "/debug_token" (AppAccessToken -> Maybe AppAccessToken
    forall a. a -> Maybe a
    Just AppAccessToken
    appToken) (SimpleQuery -> FacebookT Auth m Request)
    -> SimpleQuery -> FacebookT Auth m Request
    forall a b. (a -> b) -> a -> b
    $
        [("input_token", Text -> ByteString
    TE.encodeUtf8 Text
    userTokenData)]
      DebugToken
    ret <- Undata DebugToken -> DebugToken
    forall a. Undata a -> a
    undata (Undata DebugToken -> DebugToken)
    -> FacebookT Auth m (Undata DebugToken)
    -> FacebookT Auth m DebugToken
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Response (ConduitT () ByteString m ())
    -> FacebookT Auth m (Undata DebugToken)
    forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
    (MonadIO m, MonadTrans t, MonadThrow m, FromJSON a) =>
    Response (ConduitT () ByteString m ()) -> t m a
    asJson (Response (ConduitT () ByteString m ())
     -> FacebookT Auth m (Undata DebugToken))
    -> FacebookT Auth m (Response (ConduitT () ByteString m ()))
    -> FacebookT Auth m (Undata DebugToken)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Request
    -> FacebookT Auth m (Response (ConduitT () ByteString m ()))
    forall (m :: * -> *) anyAuth.
    (MonadResource m, MonadUnliftIO m, MonadThrow m) =>
    Request
    -> FacebookT anyAuth m (Response (ConduitT () ByteString m ()))
    fbhttp Request
    req)
      let muserToken :: Maybe UserAccessToken
    muserToken =
            UserId -> Text -> UTCTime -> UserAccessToken
    UserAccessToken (UserId -> Text -> UTCTime -> UserAccessToken)
    -> Maybe UserId -> Maybe (Text -> UTCTime -> UserAccessToken)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DebugToken -> Maybe UserId
    dtUserId DebugToken
    ret Maybe (Text -> UTCTime -> UserAccessToken)
    -> Maybe Text -> Maybe (UTCTime -> UserAccessToken)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Text -> Maybe Text
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    userTokenData Maybe (UTCTime -> UserAccessToken)
    -> Maybe UTCTime -> Maybe UserAccessToken
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*>
            DebugToken -> Maybe UTCTime
    dtExpiresAt DebugToken
    ret
      DebugToken -> FacebookT Auth m DebugToken
    forall (m :: * -> *) a. Monad m => a -> m a
    return DebugToken
    ret {dtAccessToken :: Maybe UserAccessToken
    dtAccessToken = Maybe UserAccessToken
    muserToken}

    -- | Helper used in 'debugToken'.  Unfortunately, we can't use 'Pager' here.
    data Undata a =
      Undata
        { Undata a -> a
    undata :: a
        }

    instance AE.FromJSON a => AE.FromJSON (Undata a) where
      parseJSON :: Value -> Parser (Undata a)
    parseJSON (AE.Object v :: Object
    v) = a -> Undata a
    forall a. a -> Undata a
    Undata (a -> Undata a) -> Parser a -> Parser (Undata a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Object
    v Object -> Text -> Parser a
    forall a. FromJSON a => Object -> Text -> Parser a
    AE..: "data"
      parseJSON _ = Parser (Undata a)
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    -- | Detailed information about an access token (cf. 'debugToken').
    data DebugToken =
      DebugToken
        { DebugToken -> Maybe Text
    dtAppId :: Maybe Text
        , DebugToken -> Maybe Text
    dtAppName :: Maybe Text
        , DebugToken -> Maybe UTCTime
    dtExpiresAt :: Maybe UTCTime
        , DebugToken -> Maybe Bool
    dtIsValid :: Maybe Bool
        , DebugToken -> Maybe UTCTime
    dtIssuedAt :: Maybe UTCTime
        , DebugToken -> Maybe [Permission]
    dtScopes :: Maybe [Permission]
        , DebugToken -> Maybe UserId
    dtUserId :: Maybe Id
        , DebugToken -> Maybe UserAccessToken
    dtAccessToken :: Maybe UserAccessToken
        }
      deriving (DebugToken -> DebugToken -> Bool
    (DebugToken -> DebugToken -> Bool)
    -> (DebugToken -> DebugToken -> Bool) -> Eq DebugToken
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: DebugToken -> DebugToken -> Bool
    $c/= :: DebugToken -> DebugToken -> Bool
    == :: DebugToken -> DebugToken -> Bool
    $c== :: DebugToken -> DebugToken -> Bool
    Eq, Eq DebugToken
    Eq DebugToken =>
    (DebugToken -> DebugToken -> Ordering)
    -> (DebugToken -> DebugToken -> Bool)
    -> (DebugToken -> DebugToken -> Bool)
    -> (DebugToken -> DebugToken -> Bool)
    -> (DebugToken -> DebugToken -> Bool)
    -> (DebugToken -> DebugToken -> DebugToken)
    -> (DebugToken -> DebugToken -> DebugToken)
    -> Ord DebugToken
    DebugToken -> DebugToken -> Bool
    DebugToken -> DebugToken -> Ordering
    DebugToken -> DebugToken -> DebugToken
    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 :: DebugToken -> DebugToken -> DebugToken
    $cmin :: DebugToken -> DebugToken -> DebugToken
    max :: DebugToken -> DebugToken -> DebugToken
    $cmax :: DebugToken -> DebugToken -> DebugToken
    >= :: DebugToken -> DebugToken -> Bool
    $c>= :: DebugToken -> DebugToken -> Bool
    > :: DebugToken -> DebugToken -> Bool
    $c> :: DebugToken -> DebugToken -> Bool
    <= :: DebugToken -> DebugToken -> Bool
    $c<= :: DebugToken -> DebugToken -> Bool
    < :: DebugToken -> DebugToken -> Bool
    $c< :: DebugToken -> DebugToken -> Bool
    compare :: DebugToken -> DebugToken -> Ordering
    $ccompare :: DebugToken -> DebugToken -> Ordering
    $cp1Ord :: Eq DebugToken
    Ord, Int -> DebugToken -> String -> String
    [DebugToken] -> String -> String
    DebugToken -> String
    (Int -> DebugToken -> String -> String)
    -> (DebugToken -> String)
    -> ([DebugToken] -> String -> String)
    -> Show DebugToken
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    showList :: [DebugToken] -> String -> String
    $cshowList :: [DebugToken] -> String -> String
    show :: DebugToken -> String
    $cshow :: DebugToken -> String
    showsPrec :: Int -> DebugToken -> String -> String
    $cshowsPrec :: Int -> DebugToken -> String -> String
    Show, Typeable)

    -- | Note: this instance always sets 'dtAccessToken' to
    -- 'Nothing', but 'debugToken' will update this field before
    -- returning the final 'DebugToken'.  This is done because we
    -- need the 'AccessTokenData', which is not part of FB's
    -- response.
    instance AE.FromJSON DebugToken where
      parseJSON :: Value -> Parser DebugToken
    parseJSON (AE.Object v :: Object
    v) =
        Maybe Text
    -> Maybe Text
    -> Maybe UTCTime
    -> Maybe Bool
    -> Maybe UTCTime
    -> Maybe [Permission]
    -> Maybe UserId
    -> Maybe UserAccessToken
    -> DebugToken
    DebugToken (Maybe Text
     -> Maybe Text
     -> Maybe UTCTime
     -> Maybe Bool
     -> Maybe UTCTime
     -> Maybe [Permission]
     -> Maybe UserId
     -> Maybe UserAccessToken
     -> DebugToken)
    -> Parser (Maybe Text)
    -> Parser
         (Maybe Text
          -> Maybe UTCTime
          -> Maybe Bool
          -> Maybe UTCTime
          -> Maybe [Permission]
          -> Maybe UserId
          -> Maybe UserAccessToken
          -> DebugToken)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((UserId -> Text) -> Maybe UserId -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap UserId -> Text
    idCode (Maybe UserId -> Maybe Text)
    -> Parser (Maybe UserId) -> Parser (Maybe Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Object
    v Object -> Text -> Parser (Maybe UserId)
    forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
    AE..:? "app_id") Parser
      (Maybe Text
       -> Maybe UTCTime
       -> Maybe Bool
       -> Maybe UTCTime
       -> Maybe [Permission]
       -> Maybe UserId
       -> Maybe UserAccessToken
       -> DebugToken)
    -> Parser (Maybe Text)
    -> Parser
         (Maybe UTCTime
          -> Maybe Bool
          -> Maybe UTCTime
          -> Maybe [Permission]
          -> Maybe UserId
          -> Maybe UserAccessToken
          -> DebugToken)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*>
        Object
    v Object -> Text -> Parser (Maybe Text)
    forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
    AE..:? "application" Parser
      (Maybe UTCTime
       -> Maybe Bool
       -> Maybe UTCTime
       -> Maybe [Permission]
       -> Maybe UserId
       -> Maybe UserAccessToken
       -> DebugToken)
    -> Parser (Maybe UTCTime)
    -> Parser
         (Maybe Bool
          -> Maybe UTCTime
          -> Maybe [Permission]
          -> Maybe UserId
          -> Maybe UserAccessToken
          -> DebugToken)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*>
        ((FbUTCTime -> UTCTime) -> Maybe FbUTCTime -> Maybe UTCTime
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FbUTCTime -> UTCTime
    unFbUTCTime (Maybe FbUTCTime -> Maybe UTCTime)
    -> Parser (Maybe FbUTCTime) -> Parser (Maybe UTCTime)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Object
    v Object -> Text -> Parser (Maybe FbUTCTime)
    forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
    AE..:? "expires_at") Parser
      (Maybe Bool
       -> Maybe UTCTime
       -> Maybe [Permission]
       -> Maybe UserId
       -> Maybe UserAccessToken
       -> DebugToken)
    -> Parser (Maybe Bool)
    -> Parser
         (Maybe UTCTime
          -> Maybe [Permission]
          -> Maybe UserId
          -> Maybe UserAccessToken
          -> DebugToken)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*>
        Object
    v Object -> Text -> Parser (Maybe Bool)
    forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
    AE..:? "is_valid" Parser
      (Maybe UTCTime
       -> Maybe [Permission]
       -> Maybe UserId
       -> Maybe UserAccessToken
       -> DebugToken)
    -> Parser (Maybe UTCTime)
    -> Parser
         (Maybe [Permission]
          -> Maybe UserId -> Maybe UserAccessToken -> DebugToken)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*>
        ((FbUTCTime -> UTCTime) -> Maybe FbUTCTime -> Maybe UTCTime
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FbUTCTime -> UTCTime
    unFbUTCTime (Maybe FbUTCTime -> Maybe UTCTime)
    -> Parser (Maybe FbUTCTime) -> Parser (Maybe UTCTime)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Object
    v Object -> Text -> Parser (Maybe FbUTCTime)
    forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
    AE..:? "issued_at") Parser
      (Maybe [Permission]
       -> Maybe UserId -> Maybe UserAccessToken -> DebugToken)
    -> Parser (Maybe [Permission])
    -> Parser (Maybe UserId -> Maybe UserAccessToken -> DebugToken)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*>
        (([Text] -> [Permission]) -> Maybe [Text] -> Maybe [Permission]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Text -> Permission) -> [Text] -> [Permission]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Permission
    Permission) (Maybe [Text] -> Maybe [Permission])
    -> Parser (Maybe [Text]) -> Parser (Maybe [Permission])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Object
    v Object -> Text -> Parser (Maybe [Text])
    forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
    AE..:? "scopes") Parser (Maybe UserId -> Maybe UserAccessToken -> DebugToken)
    -> Parser (Maybe UserId)
    -> Parser (Maybe UserAccessToken -> DebugToken)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*>
        Object
    v Object -> Text -> Parser (Maybe UserId)
    forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
    AE..:? "user_id" Parser (Maybe UserAccessToken -> DebugToken)
    -> Parser (Maybe UserAccessToken) -> Parser DebugToken
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*>
        Maybe UserAccessToken -> Parser (Maybe UserAccessToken)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe UserAccessToken
    forall a. Maybe a
    Nothing
      parseJSON _ = Parser DebugToken
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero