{-#LANGUAGE DeriveDataTypeable#-}
{-#LANGUAGE FlexibleContexts#-}
{-#LANGUAGE OverloadedStrings#-}
{-#LANGUAGE CPP#-}

module Facebook.Base
    ( fbreq
    , ToSimpleQuery(..)
    , asJson
    , asJsonHelper
    , asBS
    , FacebookException(..)
    , fbhttp
    , fbhttpHelper
    , httpCheck
    ) where

import Control.Applicative
import Control.Monad.IO.Class (MonadIO)
import Data.ByteString.Char8 (ByteString)
import Data.Text (Text)

import qualified UnliftIO.Exception as E
import Control.Monad.Trans.Class (MonadTrans)
import qualified Control.Monad.Trans.Resource as R
import qualified Data.Aeson as A
import qualified Data.Attoparsec.ByteString.Char8 as AT
import qualified Data.ByteString as B
import qualified Data.Conduit as C
import Data.Conduit ((.|))
import qualified Data.Conduit.Attoparsec as C
import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Binary as CB
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Network.HTTP.Conduit as H
import qualified Network.HTTP.Types as HT
import qualified Data.ByteString.Lazy as L
#if DEBUG
import Control.Monad.IO.Class (MonadIO, liftIO)
import Text.Printf (printf)
#endif


import Facebook.Types
import Facebook.Monad

-- | A plain 'H.Request' to a Facebook API.  Use this instead of
-- 'def' when creating new 'H.Request'@s@ for Facebook.
fbreq :: MonadIO m
      => Text                        -- ^ Path. Should start from "/".
      -> Maybe (AccessToken anyKind) -- ^ Access token.
      -> HT.SimpleQuery              -- ^ Parameters.
      -> FacebookT anyAuth m H.Request
fbreq :: Text
-> Maybe (AccessToken anyKind)
-> SimpleQuery
-> FacebookT anyAuth m Request
fbreq Text
path Maybe (AccessToken anyKind)
mtoken SimpleQuery
query = do

    Text
apiVersion <- FacebookT anyAuth m Text
forall (m :: * -> *) anyAuth. MonadIO m => FacebookT anyAuth m Text
getApiVersion
    Maybe Credentials
creds      <- FacebookT anyAuth m (Maybe Credentials)
forall (m :: * -> *) anyAuth.
Monad m =>
FacebookT anyAuth m (Maybe Credentials)
getMCreds

    let appSecretProofAdder :: Maybe (AccessToken anykind) -> SimpleQuery -> SimpleQuery
appSecretProofAdder = case Maybe Credentials
creds of
          Just c :: Credentials
c@( Credentials Text
_ Text
_ Text
_ Bool
True ) -> Credentials
-> Maybe (AccessToken anykind) -> SimpleQuery -> SimpleQuery
forall anykind.
Credentials
-> Maybe (AccessToken anykind) -> SimpleQuery -> SimpleQuery
addAppSecretProof Credentials
c
          Maybe Credentials
_ -> (SimpleQuery -> SimpleQuery)
-> Maybe (AccessToken anykind) -> SimpleQuery -> SimpleQuery
forall a b. a -> b -> a
const SimpleQuery -> SimpleQuery
forall a. a -> a
id 


    (FbTier -> Request) -> FacebookT anyAuth m Request
forall (m :: * -> *) a anyAuth.
Monad m =>
(FbTier -> a) -> FacebookT anyAuth m a
withTier ((FbTier -> Request) -> FacebookT anyAuth m Request)
-> (FbTier -> Request) -> FacebookT anyAuth m Request
forall a b. (a -> b) -> a -> b
$ \FbTier
tier ->
      let host :: ByteString
host = case FbTier
tier of
                   FbTier
Production -> ByteString
"graph.facebook.com"
                   FbTier
Beta ->  ByteString
"graph.beta.facebook.com"
      in Request
H.defaultRequest { secure :: Bool
H.secure        = Bool
True
             , host :: ByteString
H.host          = ByteString
host
             , port :: Int
H.port          = Int
443
             , path :: ByteString
H.path          = Text -> ByteString
TE.encodeUtf8 (Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
apiVersion Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path)
             , redirectCount :: Int
H.redirectCount = Int
3
             , queryString :: ByteString
H.queryString   =
                 Bool -> SimpleQuery -> ByteString
HT.renderSimpleQuery Bool
False
                 (SimpleQuery -> ByteString) -> SimpleQuery -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe (AccessToken anyKind) -> SimpleQuery -> SimpleQuery
forall anykind.
Maybe (AccessToken anykind) -> SimpleQuery -> SimpleQuery
appSecretProofAdder Maybe (AccessToken anyKind)
mtoken (SimpleQuery -> SimpleQuery) -> SimpleQuery -> SimpleQuery
forall a b. (a -> b) -> a -> b
$ (SimpleQuery -> SimpleQuery)
-> (AccessToken anyKind -> SimpleQuery -> SimpleQuery)
-> Maybe (AccessToken anyKind)
-> SimpleQuery
-> SimpleQuery
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SimpleQuery -> SimpleQuery
forall a. a -> a
id AccessToken anyKind -> SimpleQuery -> SimpleQuery
forall a. ToSimpleQuery a => a -> SimpleQuery -> SimpleQuery
tsq Maybe (AccessToken anyKind)
mtoken SimpleQuery
query
#if MIN_VERSION_http_client(0,5,0)
             , responseTimeout :: ResponseTimeout
H.responseTimeout = Int -> ResponseTimeout
H.responseTimeoutMicro Int
120000000 -- 2 minutes
#else
             , H.responseTimeout = Just 120000000 -- 2 minutes
#endif
             }


-- | Internal class for types that may be passed on queries to
-- Facebook's API.
class ToSimpleQuery a where
    -- | Prepend to the given query the parameters necessary to
    -- pass this data type to Facebook.
    tsq :: a -> HT.SimpleQuery -> HT.SimpleQuery
    tsq a
_ = SimpleQuery -> SimpleQuery
forall a. a -> a
id

instance ToSimpleQuery Credentials where
    tsq :: Credentials -> SimpleQuery -> SimpleQuery
tsq Credentials
creds = (:) (ByteString
"client_id",     Credentials -> ByteString
appIdBS     Credentials
creds) (SimpleQuery -> SimpleQuery)
-> (SimpleQuery -> SimpleQuery) -> SimpleQuery -> SimpleQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (:) (ByteString
"client_secret", Credentials -> ByteString
appSecretBS Credentials
creds)

instance ToSimpleQuery (AccessToken anyKind) where
    tsq :: AccessToken anyKind -> SimpleQuery -> SimpleQuery
tsq AccessToken anyKind
token = (:) (ByteString
"access_token", Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ AccessToken anyKind -> Text
forall anyKind. AccessToken anyKind -> Text
accessTokenData AccessToken anyKind
token)


-- | Converts a plain 'H.Response' coming from 'H.http' into a
-- JSON value.
asJson :: (MonadIO m, MonadTrans t, R.MonadThrow m, A.FromJSON a) =>
          H.Response (C.ConduitT () ByteString m ())
       -> t m a
asJson :: Response (ConduitT () ByteString m ()) -> t m a
asJson = m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> t m a)
-> (Response (ConduitT () ByteString m ()) -> m a)
-> Response (ConduitT () ByteString m ())
-> t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (ConduitT () ByteString m ()) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadThrow m, FromJSON a) =>
Response (ConduitT () ByteString m ()) -> m a
asJsonHelper

asJsonHelper :: (MonadIO m, R.MonadThrow m, A.FromJSON a) =>
                H.Response (C.ConduitT () ByteString m ())
             -> m a
asJsonHelper :: Response (ConduitT () ByteString m ()) -> m a
asJsonHelper Response (ConduitT () ByteString m ())
response = do
#if DEBUG
  bs <- H.responseBody response C.$$+- fmap L.fromChunks CL.consume
  _ <- liftIO $ printf "asJsonHelper: %s\n" (show bs)
  val <- either (fail . ("asJsonHelper: A.decode returned " ++)) return (A.eitherDecode bs)
#else
  Value
val <- ConduitT () Void m Value -> m Value
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
C.runConduit (ConduitT () Void m Value -> m Value)
-> ConduitT () Void m Value -> m Value
forall a b. (a -> b) -> a -> b
$ (Response (ConduitT () ByteString m ())
-> ConduitT () ByteString m ()
forall body. Response body -> body
H.responseBody Response (ConduitT () ByteString m ())
response) ConduitT () ByteString m ()
-> ConduitM ByteString Void m Value -> ConduitT () Void m Value
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Parser ByteString Value -> ConduitM ByteString Void m Value
forall a (m :: * -> *) b o.
(AttoparsecInput a, MonadThrow m) =>
Parser a b -> ConduitT a o m b
C.sinkParser Parser ByteString Value
A.json'
#endif
  case Value -> Result a
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
val of
    A.Success a
r -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
    A.Error String
str ->
        FacebookException -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO (FacebookException -> m a) -> FacebookException -> m a
forall a b. (a -> b) -> a -> b
$ Text -> FacebookException
FbLibraryException (Text -> FacebookException) -> Text -> FacebookException
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
             [ Text
"Facebook.Base.asJson: could not parse "
             , Text
" Facebook's response as a JSON value ("
             , String -> Text
T.pack String
str, Text
")" ]


-- | Converts a plain 'H.Response' into a string 'ByteString'.
asBS :: (Monad m) =>
        H.Response (C.ConduitT () ByteString m ())
     -> FacebookT anyAuth m ByteString
asBS :: Response (ConduitT () ByteString m ())
-> FacebookT anyAuth m ByteString
asBS Response (ConduitT () ByteString m ())
response = m ByteString -> FacebookT anyAuth m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> FacebookT anyAuth m ByteString)
-> m ByteString -> FacebookT anyAuth m ByteString
forall a b. (a -> b) -> a -> b
$ ConduitT () Void m ByteString -> m ByteString
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
C.runConduit (ConduitT () Void m ByteString -> m ByteString)
-> ConduitT () Void m ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Response (ConduitT () ByteString m ())
-> ConduitT () ByteString m ()
forall body. Response body -> body
H.responseBody Response (ConduitT () ByteString m ())
response ConduitT () ByteString m ()
-> ConduitM ByteString Void m ByteString
-> ConduitT () Void m ByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ([ByteString] -> ByteString)
-> ConduitT ByteString Void m [ByteString]
-> ConduitM ByteString Void m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ByteString] -> ByteString
B.concat ConduitT ByteString Void m [ByteString]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume


-- | Same as 'H.http', but tries to parse errors and throw
-- meaningful 'FacebookException'@s@.
fbhttp :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m) =>
          H.Request
       -> FacebookT anyAuth m (H.Response (C.ConduitT () ByteString m ()))
fbhttp :: Request
-> FacebookT anyAuth m (Response (ConduitT () ByteString m ()))
fbhttp Request
req = do
  Manager
manager <- FacebookT anyAuth m Manager
forall (m :: * -> *) anyAuth.
Monad m =>
FacebookT anyAuth m Manager
getManager
  m (Response (ConduitT () ByteString m ()))
-> FacebookT anyAuth m (Response (ConduitT () ByteString m ()))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Manager -> Request -> m (Response (ConduitT () ByteString m ()))
forall (m :: * -> *).
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
Manager -> Request -> m (Response (ConduitT () ByteString m ()))
fbhttpHelper Manager
manager Request
req)

fbhttpHelper :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m) =>
                H.Manager
             -> H.Request
             -> m (H.Response (C.ConduitT () ByteString m ()))
fbhttpHelper :: Manager -> Request -> m (Response (ConduitT () ByteString m ()))
fbhttpHelper Manager
manager Request
req = do
#if MIN_VERSION_http_client(0,5,0)
  let req' :: Request
req' = Request
req { checkResponse :: Request -> Response BodyReader -> IO ()
H.checkResponse = \Request
_ Response BodyReader
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () }
#else
  let req' = req { H.checkStatus = \_ _ _ -> Nothing }
#endif
#if DEBUG
  _ <- liftIO $ printf "fbhttp doing request\n\tmethod: %s\n\tsecure: %s\n\thost: %s\n\tport: %s\n\tpath: %s\n\tqueryString: %s\n\trequestHeaders: %s\n" (show $ H.method req') (show $ H.secure req') (show $ H.host req') (show $ H.port req') (show $ H.path req') (show $ H.queryString req') (show $ H.requestHeaders req')
#endif
  Response (ConduitT () ByteString m ())
response <- Request -> Manager -> m (Response (ConduitT () ByteString m ()))
forall (m :: * -> *) i.
MonadResource m =>
Request -> Manager -> m (Response (ConduitM i ByteString m ()))
H.http Request
req' Manager
manager
  let status :: Status
status  = Response (ConduitT () ByteString m ()) -> Status
forall body. Response body -> Status
H.responseStatus    Response (ConduitT () ByteString m ())
response
      headers :: ResponseHeaders
headers = Response (ConduitT () ByteString m ()) -> ResponseHeaders
forall body. Response body -> ResponseHeaders
H.responseHeaders   Response (ConduitT () ByteString m ())
response
#if DEBUG
  _ <- liftIO $ printf "fbhttp response status: %s\n" (show status)
#endif
  if Status -> Bool
isOkay Status
status
    then Response (ConduitT () ByteString m ())
-> m (Response (ConduitT () ByteString m ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Response (ConduitT () ByteString m ())
response
    else do
#if MIN_VERSION_http_client(0,5,0)
      ByteString
fullResp <- ConduitT () Void m ByteString -> m ByteString
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
C.runConduit (ConduitT () Void m ByteString -> m ByteString)
-> ConduitT () Void m ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ (Response (ConduitT () ByteString m ())
-> ConduitT () ByteString m ()
forall body. Response body -> body
H.responseBody Response (ConduitT () ByteString m ())
response) ConduitT () ByteString m ()
-> ConduitM ByteString Void m ByteString
-> ConduitT () Void m ByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void m ByteString
forall (m :: * -> *) o.
Monad m =>
ConduitT ByteString o m ByteString
CB.sinkLbs
      let res' :: Response ()
res' = (ConduitT () ByteString m () -> ())
-> Response (ConduitT () ByteString m ()) -> Response ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> ConduitT () ByteString m () -> ()
forall a b. a -> b -> a
const ()) Response (ConduitT () ByteString m ())
response
      let statusexc :: HttpException
statusexc = Request -> HttpExceptionContent -> HttpException
H.HttpExceptionRequest Request
req (HttpExceptionContent -> HttpException)
-> HttpExceptionContent -> HttpException
forall a b. (a -> b) -> a -> b
$ Response () -> ByteString -> HttpExceptionContent
H.StatusCodeException Response ()
res' (ByteString -> ByteString
L.toStrict ByteString
fullResp)
#else
      let cookies = H.responseCookieJar response
      let statusexc = H.StatusCodeException status headers cookies
#endif

      Either SomeException FacebookException
val <- m FacebookException -> m (Either SomeException FacebookException)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
E.try (m FacebookException -> m (Either SomeException FacebookException))
-> m FacebookException
-> m (Either SomeException FacebookException)
forall a b. (a -> b) -> a -> b
$ Response (ConduitT () ByteString m ()) -> m FacebookException
forall (m :: * -> *) a.
(MonadIO m, MonadThrow m, FromJSON a) =>
Response (ConduitT () ByteString m ()) -> m a
asJsonHelper Response (ConduitT () ByteString m ())
response
      case Either SomeException FacebookException
val :: Either E.SomeException FacebookException of
        Right FacebookException
fbexc -> FacebookException -> m (Response (ConduitT () ByteString m ()))
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO FacebookException
fbexc
        Left SomeException
_ -> do
          case Parser FacebookException -> ByteString -> Result FacebookException
forall a. Parser a -> ByteString -> Result a
AT.parse Parser FacebookException
wwwAuthenticateParser (ByteString -> Result FacebookException)
-> Maybe ByteString -> Maybe (Result FacebookException)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
               HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"WWW-Authenticate" ResponseHeaders
headers of
            Just (AT.Done ByteString
_ FacebookException
fbexc) -> FacebookException -> m (Response (ConduitT () ByteString m ()))
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO FacebookException
fbexc
            Maybe (Result FacebookException)
_                      -> HttpException -> m (Response (ConduitT () ByteString m ()))
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO HttpException
statusexc


-- | Try to parse the @WWW-Authenticate@ header of a Facebook
-- response.
wwwAuthenticateParser :: AT.Parser FacebookException
wwwAuthenticateParser :: Parser FacebookException
wwwAuthenticateParser =
    Text -> Text -> FacebookException
FacebookException (Text -> Text -> FacebookException)
-> Parser ByteString ByteString
-> Parser ByteString (Text -> Text -> FacebookException)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  ByteString -> Parser ByteString ByteString
AT.string ByteString
"OAuth \"Facebook Platform\" "
                      Parser ByteString (Text -> Text -> FacebookException)
-> Parser ByteString Text
-> Parser ByteString (Text -> FacebookException)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
text
                      Parser ByteString (Text -> FacebookException)
-> Parser ByteString Char
-> Parser ByteString (Text -> FacebookException)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Char -> Parser ByteString Char
AT.char Char
' '
                      Parser ByteString (Text -> FacebookException)
-> Parser ByteString Text -> Parser FacebookException
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
text
    where
      text :: Parser ByteString Text
text  = String -> Text
T.pack (String -> Text)
-> Parser ByteString Char -> Parser ByteString (String -> Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
AT.char Char
'"' Parser ByteString (String -> Text)
-> Parser ByteString String -> Parser ByteString Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Char -> Parser ByteString String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ByteString Char
tchar Parser ByteString Text
-> Parser ByteString Char -> Parser ByteString Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
AT.char Char
'"'
      tchar :: Parser ByteString Char
tchar = (Char -> Parser ByteString Char
AT.char Char
'\\' Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char
AT.anyChar) Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString Char
AT.notChar Char
'"'


-- | Send a @HEAD@ request just to see if the resposne status
-- code is 2XX (returns @True@) or not (returns @False@).
httpCheck :: (R.MonadResource m, R.MonadUnliftIO m) =>
             H.Request
          -> FacebookT anyAuth m Bool

httpCheck :: Request -> FacebookT anyAuth m Bool
httpCheck Request
req = 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
  Manager
manager <- FacebookT anyAuth (ResourceT m) Manager
forall (m :: * -> *) anyAuth.
Monad m =>
FacebookT anyAuth m Manager
getManager
  let req' :: Request
req' = Request
req { method :: ByteString
H.method      = ByteString
HT.methodHead
#if MIN_VERSION_http_client(0,5,0)
     , checkResponse :: Request -> Response BodyReader -> IO ()
H.checkResponse = \Request
_ Response BodyReader
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
     , H.checkStatus = \_ _ _ -> Nothing
#endif
  }
  Status -> Bool
isOkay (Status -> Bool)
-> (Response ByteString -> Status) -> Response ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> Status
forall body. Response body -> Status
H.responseStatus (Response ByteString -> Bool)
-> FacebookT anyAuth (ResourceT m) (Response ByteString)
-> FacebookT anyAuth (ResourceT m) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResourceT m (Response ByteString)
-> FacebookT anyAuth (ResourceT m) (Response ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Request -> Manager -> ResourceT m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
H.httpLbs Request
req' Manager
manager)
  -- Yes, we use httpLbs above so that we don't have to worry
  -- about consuming the responseBody.  Note that the
  -- responseBody should be empty since we're using HEAD, but
  -- I don't know if this is guaranteed.


-- | @True@ if the the 'Status' is ok (i.e. @2XX@).
isOkay :: HT.Status -> Bool
isOkay :: Status -> Bool
isOkay Status
status =
  let sc :: Int
sc = Status -> Int
HT.statusCode Status
status
  in Int
200 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sc Bool -> Bool -> Bool
&& Int
sc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
300