{-# LANGUAGE OverloadedStrings #-}
module Web.Tweet.Sign ( signRequest
, signRequestMem
, mkConfig
, mkConfigToml
, oAuthMem
, credentialMem ) where
import Data.ByteString as BS
import Data.HashMap.Lazy
import Data.Monoid
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Text.IO as TIO
import Network.HTTP.Client
import Prelude hiding (lookup)
import Text.Toml
import Web.Authenticate.OAuth
import Web.Tweet.Types
import Web.Tweet.Utils
signRequest :: FilePath -> Request -> IO Request
signRequest :: FilePath -> Request -> IO Request
signRequest = (((Config -> IO Request) -> IO Request)
-> (Request -> Config -> IO Request) -> Request -> IO Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Request -> IO Request)
-> Request -> Config -> IO Request
forall a b c. (a -> b -> c) -> b -> a -> c
flip Config -> Request -> IO Request
signRequestMem) (((Config -> IO Request) -> IO Request) -> Request -> IO Request)
-> (FilePath -> (Config -> IO Request) -> IO Request)
-> FilePath
-> Request
-> IO Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Config -> (Config -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) (IO Config -> (Config -> IO Request) -> IO Request)
-> (FilePath -> IO Config)
-> FilePath
-> (Config -> IO Request)
-> IO Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Config
mkConfig
signRequestMem :: Config -> Request -> IO Request
signRequestMem :: Config -> Request -> IO Request
signRequestMem = (OAuth -> Credential -> Request -> IO Request)
-> Config -> Request -> IO Request
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry OAuth -> Credential -> Request -> IO Request
forall (m :: * -> *).
MonadIO m =>
OAuth -> Credential -> Request -> m Request
signOAuth
oAuthMem :: BS.ByteString
-> BS.ByteString
-> OAuth
oAuthMem :: ByteString -> ByteString -> OAuth
oAuthMem ByteString
key ByteString
secret = OAuth
newOAuth { oauthConsumerKey :: ByteString
oauthConsumerKey = ByteString
key, oauthConsumerSecret :: ByteString
oauthConsumerSecret = ByteString
secret, oauthServerName :: FilePath
oauthServerName = FilePath
"api.twitter.com" }
credentialMem :: BS.ByteString
-> BS.ByteString
-> Credential
credentialMem :: ByteString -> ByteString -> Credential
credentialMem = ByteString -> ByteString -> Credential
newCredential
oAuth :: FilePath -> IO OAuth
oAuth :: FilePath -> IO OAuth
oAuth FilePath
filepath = do
ByteString
secret <- ByteString -> [(ByteString, ByteString)] -> ByteString
lineByKey ByteString
"api-sec" ([(ByteString, ByteString)] -> ByteString)
-> IO [(ByteString, ByteString)] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [(ByteString, ByteString)]
getConfigData FilePath
filepath
ByteString
key <- ByteString -> [(ByteString, ByteString)] -> ByteString
lineByKey ByteString
"api-key" ([(ByteString, ByteString)] -> ByteString)
-> IO [(ByteString, ByteString)] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [(ByteString, ByteString)]
getConfigData FilePath
filepath
let url :: FilePath
url = FilePath
"api.twitter.com"
OAuth -> IO OAuth
forall (f :: * -> *) a. Applicative f => a -> f a
pure OAuth
newOAuth { oauthConsumerKey :: ByteString
oauthConsumerKey = ByteString
key , oauthConsumerSecret :: ByteString
oauthConsumerSecret = ByteString
secret , oauthServerName :: FilePath
oauthServerName = FilePath
url }
getKey :: HashMap T.Text Node -> T.Text -> BS.ByteString
getKey :: HashMap Text Node -> Text -> ByteString
getKey HashMap Text Node
hm Text
key = case Text -> HashMap Text Node -> Maybe Node
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup Text
key HashMap Text Node
hm of
(Just (VString Text
k)) -> Text -> ByteString
encodeUtf8 Text
k
(Just Node
_) -> FilePath -> ByteString
forall a. HasCallStack => FilePath -> a
error (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
"Key: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
key FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" found in the config file, but it is not a string."
Maybe Node
Nothing -> FilePath -> ByteString
forall a. HasCallStack => FilePath -> a
error (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
"Key: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
key FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" not found in config file."
mkConfigToml :: FilePath -> IO Config
mkConfigToml :: FilePath -> IO Config
mkConfigToml FilePath
filepath = do
Text
t <- FilePath -> IO Text
TIO.readFile FilePath
filepath
let hm :: HashMap Text Node
hm = case FilePath -> Text -> Either TomlError (HashMap Text Node)
parseTomlDoc (FilePath
"failed to read .toml at: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
filepath) Text
t of
Right HashMap Text Node
tab -> HashMap Text Node
tab
Left TomlError
e -> FilePath -> HashMap Text Node
forall a. HasCallStack => FilePath -> a
error (TomlError -> FilePath
forall a. Show a => a -> FilePath
show TomlError
e)
secret :: ByteString
secret = HashMap Text Node -> Text -> ByteString
getKey HashMap Text Node
hm Text
"api-sec"
key :: ByteString
key = HashMap Text Node -> Text -> ByteString
getKey HashMap Text Node
hm Text
"api-key"
tok :: ByteString
tok = HashMap Text Node -> Text -> ByteString
getKey HashMap Text Node
hm Text
"tok"
tokSecret :: ByteString
tokSecret = HashMap Text Node -> Text -> ByteString
getKey HashMap Text Node
hm Text
"tok-sec"
url :: FilePath
url = FilePath
"api.twitter.com"
o :: OAuth
o = OAuth
newOAuth { oauthConsumerKey :: ByteString
oauthConsumerKey = ByteString
key , oauthConsumerSecret :: ByteString
oauthConsumerSecret = ByteString
secret , oauthServerName :: FilePath
oauthServerName = FilePath
url }
c :: Credential
c = ByteString -> ByteString -> Credential
newCredential ByteString
tok ByteString
tokSecret
Config -> IO Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OAuth
o, Credential
c)
mkConfig :: FilePath -> IO Config
mkConfig :: FilePath -> IO Config
mkConfig FilePath
filepath = do
OAuth
o <- FilePath -> IO OAuth
oAuth FilePath
filepath
Credential
c <- FilePath -> IO Credential
credential FilePath
filepath
Config -> IO Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OAuth
o, Credential
c)
credential :: FilePath -> IO Credential
credential :: FilePath -> IO Credential
credential FilePath
filepath = ByteString -> ByteString -> Credential
newCredential (ByteString -> ByteString -> Credential)
-> IO ByteString -> IO (ByteString -> Credential)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
token IO (ByteString -> Credential) -> IO ByteString -> IO Credential
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO ByteString
secretToken
where token :: IO ByteString
token = ByteString -> [(ByteString, ByteString)] -> ByteString
lineByKey ByteString
"tok" ([(ByteString, ByteString)] -> ByteString)
-> IO [(ByteString, ByteString)] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [(ByteString, ByteString)]
getConfigData FilePath
filepath
secretToken :: IO ByteString
secretToken = ByteString -> [(ByteString, ByteString)] -> ByteString
lineByKey ByteString
"tok-sec" ([(ByteString, ByteString)] -> ByteString)
-> IO [(ByteString, ByteString)] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [(ByteString, ByteString)]
getConfigData FilePath
filepath