diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,1 @@ + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Web/Twitter/Twhs.hs b/Web/Twitter/Twhs.hs new file mode 100644 --- /dev/null +++ b/Web/Twitter/Twhs.hs @@ -0,0 +1,4 @@ +module Web.Twitter.Twhs (module X) where +import Web.Twitter.Twhs.Common as X +import Web.Twitter.Twhs.Command as X +import Web.Twitter.Twhs.Option as X diff --git a/Web/Twitter/Twhs/Common.hs b/Web/Twitter/Twhs/Common.hs new file mode 100644 --- /dev/null +++ b/Web/Twitter/Twhs/Common.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} + +module Web.Twitter.Twhs.Common ( + oauthPin + , runTwitterFromEnv' + ) where + +import Web.Twitter.Conduit + +import Web.Authenticate.OAuth as OA +import qualified Network.URI as URI +import Network.HTTP.Conduit +import qualified Data.Map as M +import qualified Data.ByteString.Char8 as S8 +import qualified Data.CaseInsensitive as CI +import Control.Applicative +import Control.Monad.IO.Class +import Control.Monad.Base +import Control.Monad.Trans.Resource +import System.Environment +import Control.Monad.Logger +import Control.Lens +import Data.Maybe +import Data.Monoid +import System.IO (hFlush, stdout) +import qualified Data.Conduit as C + +import qualified Web.Twitter.Twhs.Config as Config (oauthConsumerKey, oauthConsumerSecret) + +getOAuthTokens :: IO (OAuth, Credential) +getOAuthTokens = do + accessToken <- getEnv' "OAUTH_ACCESS_TOKEN" + accessSecret <- getEnv' "OAUTH_ACCESS_SECRET" + let consumerKey = S8.pack Config.oauthConsumerKey + consumerSecret = S8.pack Config.oauthConsumerSecret + oauth = twitterOAuth + { oauthConsumerKey = consumerKey + , oauthConsumerSecret = consumerSecret + } + cred = Credential + [ ("oauth_token", accessToken) + , ("oauth_token_secret", accessSecret) + ] + return (oauth, cred) + where + getEnv' = (S8.pack <$>) . getEnv + +getProxyEnv :: IO (Maybe Proxy) +getProxyEnv = do + env <- M.fromList . over (mapped . _1) CI.mk <$> getEnvironment + let u = M.lookup "https_proxy" env <|> + M.lookup "http_proxy" env <|> + M.lookup "proxy" env >>= URI.parseURI >>= URI.uriAuthority + return $ Proxy <$> (S8.pack . URI.uriRegName <$> u) <*> (parsePort . URI.uriPort <$> u) + where + parsePort :: String -> Int + parsePort [] = 8080 + parsePort (':':xs) = read xs + parsePort xs = error $ "port number parse failed " ++ xs + +runTwitterFromEnv :: (MonadIO m, MonadBaseControl IO m) => TW (ResourceT m) a -> m a +runTwitterFromEnv task = do + pr <- liftBase getProxyEnv + (oa, cred) <- liftBase getOAuthTokens + let env = (setCredential oa cred def) { twProxy = pr } + runTW env task + +runTwitterFromEnv' :: (MonadIO m, MonadBaseControl IO m) => TW (ResourceT (NoLoggingT m)) a -> m a +runTwitterFromEnv' = runNoLoggingT . runTwitterFromEnv + + +getTokens :: IO OAuth +getTokens = do + let consumerKey = Config.oauthConsumerKey + consumerSecret = Config.oauthConsumerSecret + return $ twitterOAuth { + oauthConsumerKey = S8.pack consumerKey + , oauthConsumerSecret = S8.pack consumerSecret + , oauthCallback = Just "oob" + } + +authorize :: (MonadBaseControl IO m, C.MonadResource m) + => OAuth -- ^ OAuth Consumer key and secret + -> Manager + -> m Credential +authorize oauth mgr = do + cred <- OA.getTemporaryCredential oauth mgr + let url = OA.authorizeUrl oauth cred + pin <- getPIN url + OA.getAccessToken oauth (OA.insert "oauth_verifier" pin cred) mgr + where + getPIN url = liftIO $ do + putStrLn $ "browse URL: " ++ url + putStr "> what was the PIN twitter provided you with? " + hFlush stdout + S8.getLine + +oauthPin :: IO () +oauthPin = do + tokens <- getTokens + Credential cred <- liftIO $ withManager $ authorize tokens + print cred + + S8.putStrLn . S8.intercalate "\n" $ + [ "export OAUTH_ACCESS_TOKEN=\"" <> fromMaybe "" (lookup "oauth_token" cred) <> "\"" + , "export OAUTH_ACCESS_SECRET=\"" <> fromMaybe "" (lookup "oauth_token_secret" cred) <> "\"" + ] diff --git a/Web/Twitter/Twhs/Config.hs b/Web/Twitter/Twhs/Config.hs new file mode 100644 --- /dev/null +++ b/Web/Twitter/Twhs/Config.hs @@ -0,0 +1,6 @@ +module Web.Twitter.Twhs.Config (oauthConsumerKey, oauthConsumerSecret) where + +oauthConsumerKey :: String +oauthConsumerKey = "UoNgjgh43ukUCkKBtCAFNYg96" +oauthConsumerSecret :: String +oauthConsumerSecret = "IEuzxBR7ykDtB9iEy7UkipQyzKmtLksd5gMSTzmsYXOgQsl5XD" diff --git a/main.hs b/main.hs new file mode 100644 --- /dev/null +++ b/main.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +module Main where + +import Control.Applicative ((<$>)) +import Data.Maybe (isJust) +import System.Environment (lookupEnv, getArgs) +import qualified Data.Text as T + +import Web.Twitter.Twhs + +main :: IO () +main = do + aTokenExists <- isJust <$> lookupEnv "OAUTH_ACCESS_TOKEN" + aSecretExists <- isJust <$> lookupEnv "OAUTH_ACCESS_SECRET" + if aTokenExists && aSecretExists + then action + else oauthPin + +action :: IO () +action = do + argv <- getArgs + (opt, mess) <- compilerOpts argv + let status = (T.intercalate " " . map T.pack) mess + num = optNum opt + case optReplyTo opt of + Just replyTo -> reply replyTo status + Nothing -> case optUserTimeLine opt of + Just uname -> userTL uname num + Nothing -> if optMentionTimeLine opt + then mentionTL num + else case optRetweet opt of + Just rtId -> retweet rtId + Nothing -> case optFavTo opt of + Just favTo -> fav favTo + Nothing | optHelp opt -> showHelp + | null mess -> homeTL num + | otherwise -> tweet status + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/TwhsSpec.hs b/test/TwhsSpec.hs new file mode 100644 --- /dev/null +++ b/test/TwhsSpec.hs @@ -0,0 +1,12 @@ +module TwhsSpec where + +import Test.Hspec +import Test.QuickCheck +import Control.Exception (evaluate) +import Web.Twitter.Twhs + +spec :: Spec +spec = do + describe "hoge" $ do + it "return hoge" $ do + "hoge" `shouldBe` "hoge" diff --git a/twhs.cabal b/twhs.cabal new file mode 100644 --- /dev/null +++ b/twhs.cabal @@ -0,0 +1,79 @@ +-- Initial twhs.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/ + +name: twhs +version: 0.1.0.3 +synopsis: CLI twitter client. +description: See +homepage: https://github.com/suzuki-shin/twhs +license: MIT +license-file: LICENSE +author: SUZUKI Shinichiro +maintainer: shinichiro.su@gmail.com +-- copyright: +category: Web +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +library + ghc-options: -Wall + exposed-modules: Web.Twitter.Twhs + , Web.Twitter.Twhs.Common + , Web.Twitter.Twhs.Config + , Paths_twhs + build-depends: base >=4.6 && <4.7 + , twitter-conduit + , authenticate-oauth >=1.4.0.8 + , transformers + , resourcet + , monad-control + , monad-logger + , data-default + , bytestring + , text + , conduit + , http-conduit + , lens + , transformers-base + , case-insensitive + , containers + , network + , ansi-terminal + default-language: Haskell2010 + +executable twhs + main-is: main.hs + -- other-extensions: + build-depends: base >=4.6 && <4.7 + , twitter-conduit + , authenticate-oauth >=1.4.0.8 + , transformers + , resourcet + , monad-control + , monad-logger + , data-default + , bytestring + , text + , conduit + , http-conduit + , lens + , transformers-base + , case-insensitive + , containers + , network + , ansi-terminal + -- hs-source-dirs: + default-language: Haskell2010 + +test-suite spec + type: exitcode-stdio-1.0 + default-language: Haskell2010 + other-modules: TwhsSpec + hs-source-dirs: test + ghc-options: -Wall + main-is: Spec.hs + build-depends: base + , hspec >= 1.3 + , QuickCheck + , twhs