{-# LANGUAGE OverloadedStrings #-}

-- | Functions to sign HTTP requests with oAuth
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

-- | Sign a request using your OAuth dev token, as stored in a config file.
-- Uses the IO monad because signatures require a timestamp
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

-- | Sign a request using a 'Config' object, avoiding the need to read token/key from file
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

-- | Create an OAuth api key from two ByteStrings.
oAuthMem :: BS.ByteString -- ^ API key
         -> BS.ByteString -- ^ API secret
         -> 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 -- ^ Token
              -> BS.ByteString -- ^ Token secret
              -> Credential
credentialMem :: ByteString -> ByteString -> Credential
credentialMem = ByteString -> ByteString -> Credential
newCredential

-- | Create an OAuth api key from config data in a file
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)

-- | Given a filepath, parse the contents of the file and return a configuration.
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)

-- | Create a new credential from a token and token secret
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