{-# LANGUAGE OverloadedStrings #-}
module Web.Tweet.Utils.API (
getRequest
, postRequest
, getRequestMem
, postRequestMem
, urlString
, strEncode ) where
import Control.Monad ((<=<))
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.Char
import Data.Maybe
import qualified Data.Text as T
import Data.Text.Encoding
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Network.HTTP.Types.Status (statusCode)
import Web.Authenticate.OAuth
import Web.Tweet.Sign
import Web.Tweet.Types
getRequestMem :: String -> Config -> IO BSL.ByteString
getRequestMem :: String -> Config -> IO ByteString
getRequestMem String
urlStr Config
config = do
Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
Request
initialRequest <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
urlStr
Request
request <- Config -> Request -> IO Request
signRequestMem Config
config (Request -> IO Request) -> Request -> IO Request
forall a b. (a -> b) -> a -> b
$ Request
initialRequest { method :: Method
method = Method
"GET" }
Request -> Manager -> IO ByteString
responseBS Request
request Manager
manager
getRequest :: String -> FilePath -> IO BSL.ByteString
getRequest :: String -> String -> IO ByteString
getRequest String
str = String -> Config -> IO ByteString
getRequestMem String
str (Config -> IO ByteString)
-> (String -> IO Config) -> String -> IO ByteString
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO Config
mkConfigToml
postRequest :: String -> FilePath -> IO BSL.ByteString
postRequest :: String -> String -> IO ByteString
postRequest String
str = String -> Config -> IO ByteString
postRequestMem String
str (Config -> IO ByteString)
-> (String -> IO Config) -> String -> IO ByteString
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO Config
mkConfigToml
postRequestMem :: String -> Config -> IO BSL.ByteString
postRequestMem :: String -> Config -> IO ByteString
postRequestMem String
urlStr Config
config = do
Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
Request
initialRequest <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
urlStr
Request
request <- Config -> Request -> IO Request
signRequestMem Config
config (Request -> IO Request) -> Request -> IO Request
forall a b. (a -> b) -> a -> b
$ Request
initialRequest { method :: Method
method = Method
"POST" }
Request -> Manager -> IO ByteString
responseBS Request
request Manager
manager
responseBS :: Request -> Manager -> IO BSL.ByteString
responseBS :: Request -> Manager -> IO ByteString
responseBS Request
request Manager
manager = do
Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
httpLbs Request
request Manager
manager
let code :: Int
code = Status -> Int
statusCode (Status -> Int) -> Status -> Int
forall a b. (a -> b) -> a -> b
$ Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
response
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ if Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
200 then String
"" else String
"failed :(\n error code: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
code String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> ByteString
forall body. Response body -> body
responseBody (Response ByteString -> IO ByteString)
-> Response ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString
response
urlString :: Tweet -> String
urlString :: Tweet -> String
urlString Tweet
tweet = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"?status="
, Method -> String
BS.unpack (Tweet -> Method
tweetEncode Tweet
tweet)
, String
"&trim_user="
, (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Bool -> String
forall a. Show a => a -> String
show Bool
trim)
, if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Tweet -> Maybe Int
_replyID Tweet
tweet) then String
"&in_reply_to_status_id=" else String
""
, String
reply ]
where trim :: Bool
trim = Bool
False
reply :: String
reply = String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Int -> String
forall a. Show a => a -> String
show (Tweet -> Maybe Int
_replyID Tweet
tweet)
strEncode :: String -> String
strEncode :: String -> String
strEncode = Method -> String
BS.unpack (Method -> String) -> (String -> Method) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Method
paramEncode (Method -> Method) -> (String -> Method) -> String -> Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Method
encodeUtf8 (Text -> Method) -> (String -> Text) -> String -> Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
tweetEncode :: Tweet -> BS.ByteString
Tweet
tweet = Method -> Method
paramEncode (Method -> Method) -> (Text -> Method) -> Text -> Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Method
encodeUtf8 (Text -> Method) -> Text -> Method
forall a b. (a -> b) -> a -> b
$ Text
handleStr Text -> Text -> Text
`T.append` Text
content
where content :: Text
content = String -> Text
T.pack (String -> Text) -> (Tweet -> String) -> Tweet -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweet -> String
_status (Tweet -> Text) -> Tweet -> Text
forall a b. (a -> b) -> a -> b
$ Tweet
tweet
handleStr :: Text
handleStr = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. [a] -> [a] -> [a]
(++) String
"@") [String]
hs
hs :: [String]
hs = Tweet -> [String]
_handles Tweet
tweet