twhs (empty) → 0.1.0.3

raw patch · 9 files changed

+255/−0 lines, 9 filesdep +QuickCheckdep +ansi-terminaldep +authenticate-oauthsetup-changed

Dependencies added: QuickCheck, ansi-terminal, authenticate-oauth, base, bytestring, case-insensitive, conduit, containers, data-default, hspec, http-conduit, lens, monad-control, monad-logger, network, resourcet, text, transformers, transformers-base, twhs, twitter-conduit

Files

• LICENSE +1/−0
• Setup.hs +2/−0
• Web/Twitter/Twhs.hs +4/−0
• Web/Twitter/Twhs/Common.hs +109/−0
• Web/Twitter/Twhs/Config.hs +6/−0
• main.hs +41/−0
• test/Spec.hs +1/−0
• test/TwhsSpec.hs +12/−0
• twhs.cabal +79/−0

@@ -0,0 +1,1 @@+

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -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

@@ -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) <> "\""+    ]

@@ -0,0 +1,6 @@+module Web.Twitter.Twhs.Config (oauthConsumerKey, oauthConsumerSecret) where++oauthConsumerKey :: String+oauthConsumerKey = "UoNgjgh43ukUCkKBtCAFNYg96"+oauthConsumerSecret :: String+oauthConsumerSecret = "IEuzxBR7ykDtB9iEy7UkipQyzKmtLksd5gMSTzmsYXOgQsl5XD"

@@ -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+

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -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"

@@ -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 <https://github.com/suzuki-shin/twhs/blob/master/README.md>+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