{-# 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 = (. flip signRequestMem) . (>>=) . mkConfig
signRequestMem :: Config -> Request -> IO Request
signRequestMem = uncurry signOAuth
oAuthMem :: BS.ByteString
-> BS.ByteString
-> OAuth
oAuthMem key secret = newOAuth { oauthConsumerKey = key, oauthConsumerSecret = secret, oauthServerName = "api.twitter.com" }
credentialMem :: BS.ByteString
-> BS.ByteString
-> Credential
credentialMem = newCredential
oAuth :: FilePath -> IO OAuth
oAuth filepath = do
secret <- lineByKey "api-sec" <$> getConfigData filepath
key <- lineByKey "api-key" <$> getConfigData filepath
let url = "api.twitter.com"
pure newOAuth { oauthConsumerKey = key , oauthConsumerSecret = secret , oauthServerName = url }
getKey :: HashMap T.Text Node -> T.Text -> BS.ByteString
getKey hm key = case lookup key hm of
(Just (VString k)) -> encodeUtf8 k
(Just _) -> error $ "Key: " <> T.unpack key <> " found in the config file, but it is not a string."
Nothing -> error $ "Key: " <> T.unpack key <> " not found in config file."
mkConfigToml :: FilePath -> IO Config
mkConfigToml filepath = do
t <- TIO.readFile filepath
let hm = case parseTomlDoc ("failed to read .toml at: " <> filepath) t of
Right tab -> tab
Left e -> error (show e)
secret = getKey hm "api-sec"
key = getKey hm "api-key"
tok = getKey hm "tok"
tokSecret = getKey hm "tok-sec"
url = "api.twitter.com"
o = newOAuth { oauthConsumerKey = key , oauthConsumerSecret = secret , oauthServerName = url }
c = newCredential tok tokSecret
pure (o, c)
mkConfig :: FilePath -> IO Config
mkConfig filepath = do
o <- oAuth filepath
c <- credential filepath
pure (o, c)
credential :: FilePath -> IO Credential
credential filepath = newCredential <$> token <*> secretToken
where token = lineByKey "tok" <$> getConfigData filepath
secretToken = lineByKey "tok-sec" <$> getConfigData filepath