murmur (empty) → 0.0.0.1

raw patch · 6 files changed

+253/−0 lines, 6 filesdep +authenticate-oauthdep +basedep +bytestringsetup-changed

Dependencies added: authenticate-oauth, base, bytestring, conduit, conduit-extra, data-default, directory, http-conduit, lens, murmur, optparse-declarative, resourcet, text, transformers, twitter-conduit, twitter-types-lens

Files

LICENSE +30/−0
Setup.hs +2/−0
app/Main.hs +72/−0
murmur.cabal +57/−0
src/Web/Twitter/Murmur.hs +90/−0
test/Spec.hs +2/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright TokiwoOusaka (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

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

+ app/Main.hs view

@@ -0,0 +1,72 @@+{-# LANGUAGE DataKinds #-}+module Main where+import Web.Twitter.Conduit+import Web.Twitter.Murmur +import Control.Monad.IO.Class+import Options.Declarative+import System.Directory++main :: IO ()+main = run_ $ Group "Simple twitter CLI client"+  [ subCmd "home" cmdHome+  , subCmd "post" cmdPost+  , subCmd "mentions" cmdMention+  , subCmd "reply" cmdReply+  , subCmd "auth" cmdAuth+  ]+  +cmdHome :: Cmd "Show your home timeline" ()+cmdHome = liftIO $ do+  twInfo <- readTWInfo+  showHomeTimeline twInfo++cmdPost :: Arg "MESSAGE" String -> Cmd "Post new tweet" ()+cmdPost msg = liftIO $ do+  twInfo <- readTWInfo+  postTweet twInfo $ get msg++cmdMention :: Cmd "Show mentions for you" ()+cmdMention = liftIO $ do+  twInfo <- readTWInfo+  showMentionsTimeline twInfo  ++cmdReply :: Flag "i" '["Id"] "StatusID" "Target tweet id" Integer +  -> Arg "MESSAGE" String -> Cmd "Post new tweet" ()+cmdReply id msg = liftIO $ do+  twInfo <- readTWInfo+  postWithReplyId twInfo (get msg) $ get id++cmdAuth :: Cmd "Authentication twitter account" ()+cmdAuth = liftIO $ do+  twInfo <- getTWInfo murAuth+  twInfoFileName >>= flip writeFile (show twInfo)++----++readTWInfo :: IO TWInfo+readTWInfo = twInfoFileName >>= readFile >>= return . read++twInfoFileName :: IO String+twInfoFileName = do+  homeDir <- getHomeDirectory+  createDirectoryIfMissing False $ homeDir ++ "/.murmur"+  return $ homeDir ++ "/.murmur/twInfo"++----++murAuth :: MurmurAuth +murAuth = MurmurAuth+  { murConsumerKey= consumerKey+  , murConsumerSecret = consumerSecret+  , murGetPINAction = \url -> do+      putStrLn $ "Access '" ++ url ++ "' for Accept. And type PIN code here."+      getLine+  }++-- 俺はおまいらがコレを悪用したりしないって信じてる+consumerKey :: String+consumerKey = "KfczaBGJTRNFT7NdhT4DJg"++consumerSecret :: String+consumerSecret = "HpExCp1ndUyHC3TzEyTtGZHSfYlo3BgP0kr2t3VtI8"+

+ murmur.cabal view

@@ -0,0 +1,57 @@+name:                murmur+version:             0.0.0.1+synopsis:            Initial project template from stack+description:         Please see README.md+homepage:            http://github.com/tokiwoousaka/murmur#readme+license:             BSD3+license-file:        LICENSE+author:              Author name here+maintainer:          example@example.com+copyright:           2016 Author name here+category:            Web+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Web.Twitter.Murmur+  build-depends:       base >= 4.7 && < 5+                     , twitter-conduit+                     , twitter-types-lens+                     , text+                     , bytestring+                     , authenticate-oauth+                     , http-conduit+                     , resourcet+                     , conduit+                     , conduit-extra+                     , transformers+                     , data-default+                     , lens+  default-language:    Haskell2010++executable mur+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , murmur+                     , twitter-conduit+                     , optparse-declarative+                     , transformers+                     , directory+  default-language:    Haskell2010++test-suite murmur-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , murmur+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/githubuser/murmur

+ src/Web/Twitter/Murmur.hs view

@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+module Web.Twitter.Murmur where+import Control.Lens+import System.IO+import Data.Conduit+import qualified Data.Conduit.List as CL+import Data.Conduit.Binary (sinkHandle)+import Data.Default+import Web.Authenticate.OAuth+import Web.Twitter.Conduit+import Web.Twitter.Types.Lens+import Network.HTTP.Conduit as NC+import Control.Monad.Trans.Resource+import Control.Monad.IO.Class+import Control.Applicative+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.ByteString.Char8 as B8++data MurmurAuth = MurmurAuth+  { murConsumerKey :: String+  , murConsumerSecret :: String+  , murGetPINAction :: String -> IO String+  }++mur2OAuth :: MurmurAuth -> OAuth+mur2OAuth mur = twitterOAuth+  { oauthConsumerKey = B8.pack $ murConsumerKey mur+  , oauthConsumerSecret = B8.pack $ murConsumerSecret mur+  }++----++getTWInfo :: MurmurAuth -> IO TWInfo+getTWInfo mur = do+  mgr <- newManager tlsManagerSettings+  let oauth = mur2OAuth mur+  -- ** 権限取得処理 ** --+  accTkn <- runResourceT $ do+    -- リクエストトークン取得+    tempCred <- getTemporaryCredential oauth mgr+    let url = authorizeUrl oauth tempCred+    -- PINコードの取得+    pin <- B8.pack <$> liftIO (murGetPINAction mur url)+    -- リクエストトークン認可、アクセストークン取得+    getAccessToken oauth (insert "oauth_verifier" pin tempCred) mgr+  -- twInfoの取得+  return $ setCredential oauth accTkn def++-------- -- Post+postTweet :: TWInfo -> String -> IO ()+postTweet twInfo tweet = post twInfo (update $ T.pack tweet)++postWithReplyId :: TWInfo -> String -> Integer -> IO ()+postWithReplyId twInfo tweet id = +  let req = (update $ T.pack tweet) & inReplyToStatusId ?~ id+  in post twInfo req++post :: TWInfo -> APIRequest n Status -> IO ()+post twInfo req = do+  mgr <- newManager tlsManagerSettings+  runResourceT $ call twInfo mgr req+  return ()++-- GetTimeline+showMentionsTimeline :: TWInfo -> IO ()+showMentionsTimeline = showTimeline mentionsTimeline++showHomeTimeline :: TWInfo -> IO ()+showHomeTimeline = showTimeline homeTimeline++showTimeline :: HasMaxIdParam (APIRequest a [Status]) => APIRequest a [Status] -> TWInfo -> IO ()+showTimeline status twInfo = do+  mgr <- newManager tlsManagerSettings+  runResourceT $ do+    let src = sourceWithMaxId twInfo mgr status+    src $= CL.isolate 20 $$ CL.mapM_ putTweetLn++putTweetLn :: MonadIO m => Status -> m ()+putTweetLn st = liftIO . T.putStrLn . T.concat $ +  [ T.pack . show $ st^.statusId+  , "【"+  , st^.statusUser.userName+  , "("+  , st^.statusUser.userScreenName+  , ")】"+  , st^.statusText+  ]+

+ test/Spec.hs view

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"