google-oauth2-for-cli (empty) → 0.1.0.0
raw patch · 7 files changed
+243/−0 lines, 7 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, directory, filepath, google-oauth2-for-cli, hspec, http-types, req, time, wai, warp
Files
- LICENSE +30/−0
- README.md +10/−0
- Setup.hs +2/−0
- google-oauth2-for-cli.cabal +45/−0
- src/Network/Google/OAuth2.hs +139/−0
- test/Network/Google/OAuth2Spec.hs +16/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright ishiy (c) 2017++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 ishiy 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.
+ README.md view
@@ -0,0 +1,10 @@+# Google OAuth2 for CLI+Get Google OAuth2 for CLI tools++## Usage++## Other packages++- [google-oauth2](https://github.com/pbrisbin/google-oauth2)++It has silimar API. It uses [Manual and Copy Paste](https://developers.google.com/identity/protocols/OAuth2InstalledApp#redirect-uri_alternative) to get the authorization code, while this uses [Loopback IP Address](https://developers.google.com/identity/protocols/OAuth2InstalledApp#redirect-uri_loopback).
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ google-oauth2-for-cli.cabal view
@@ -0,0 +1,45 @@+name: google-oauth2-for-cli+version: 0.1.0.0+synopsis: Get Google OAuth2 token for CLI tools+description: Please see README.md+homepage: https://github.com/ishiy1993/google-oauth2-for-cli#readme+license: BSD3+license-file: LICENSE+author: ishiy+maintainer: y.ishihara.1993@gmail.com+copyright: Copyright: (c) 2016 ishiy+category: Web+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Network.Google.OAuth2+ build-depends: base >= 4.7 && < 5+ , aeson+ , bytestring+ , directory+ , filepath+ , http-types+ , req+ , time+ , wai+ , warp+ default-language: Haskell2010+ ghc-options: -Wall++Test-Suite spec+ Type: exitcode-stdio-1.0+ Default-Language: Haskell2010+ Hs-Source-Dirs: test+ Ghc-Options: -Wall+ Main-Is: Spec.hs+ other-modules: Network.Google.OAuth2Spec+ Build-Depends: base+ , hspec+ , google-oauth2-for-cli++source-repository head+ type: git+ location: https://github.com/ishiy1993/google-oauth2-for-cli
+ src/Network/Google/OAuth2.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+module Network.Google.OAuth2+ ( getToken+ , OAuth2Client(..)+ , Scope+ , AccessToken+ ) where++import Control.Concurrent+import Control.Exception (onException, throwIO)+import Control.Monad (join)+import Data.Aeson+import qualified Data.ByteString.Char8 as B+import Data.Monoid ((<>))+import Data.Time+import Network.HTTP.Types (renderSimpleQuery, status200)+import Network.HTTP.Req+import Network.Wai+import Network.Wai.Handler.Warp+import System.Directory+import System.Exit+import System.FilePath+import System.IO (hPutStrLn, stderr)++getToken :: OAuth2Client -> FilePath -> [Scope] -> IO AccessToken+getToken c tokenFile scopes = do+ b <- doesFileExist tokenFile+ if b then readToken c tokenFile else downloadToken c tokenFile scopes++readToken :: OAuth2Client -> FilePath -> IO AccessToken+readToken c tokenFile = do+ t <- read <$> readFile tokenFile+ let e = fromIntegral $ expiresIn t - 5+ now <- getCurrentTime+ mt <- getModificationTime tokenFile+ if now < addUTCTime e mt+ then return $ B.pack $ accessToken t+ else do+ t' <- getNewTokenInfo c (refreshToken t)+ saveTokenInfo tokenFile t'+ return $ B.pack $ accessToken t'++getNewTokenInfo :: OAuth2Client -> RefreshToken -> IO TokenInfo+getNewTokenInfo c rt = do+ let body = ReqBodyUrlEnc $+ "refresh_token" =: rt <>+ "client_id" =: clientId c <>+ "client_secret" =: clientSecret c <>+ "grant_type" =: ("refresh_token" :: String)+ res <- req POST tokenUrl body jsonResponse mempty+ let t' = responseBody res+ return $ t' { refreshToken = rt }++saveTokenInfo :: FilePath -> TokenInfo -> IO ()+saveTokenInfo tokenFile t = do+ createDirectoryIfMissing True $ takeDirectory tokenFile+ writeFile tokenFile (show t)++downloadToken :: OAuth2Client -> FilePath -> [Scope] -> IO AccessToken+downloadToken c tokenFile scopes = do+ code <- getCode c scopes+ t <- exchangeCode c code+ saveTokenInfo tokenFile t+ return $ B.pack $ accessToken t++getCode :: OAuth2Client -> [Scope] -> IO Code+getCode c scopes = do+ let authUri = "https://accounts.google.com/o/oauth2/v2/auth"+ q = renderSimpleQuery True+ [ ("scope", B.pack $ unwords scopes)+ , ("redirect_uri", B.pack redirectUri)+ , ("response_type", "code")+ , ("client_id", B.pack $ clientId c)+ ]+ putStrLn "Open the following uri in your browser:"+ putStrLn $ B.unpack $ authUri <> q+ m <- newEmptyMVar+ _ <- forkIO $ run serverPort (app m)+ `onException` do+ hPutStrLn stderr $ "Unable to use port " ++ show serverPort+ putMVar m Nothing+ mc <- takeMVar m+ case mc of+ Nothing -> die "Unable to get code"+ Just code -> return code++app :: MVar (Maybe Code) -> Application+app m request respond = do+ putMVar m $ B.unpack <$> join (lookup "code" $ queryString request)+ respond $ responseLBS status200+ [("Content-Type", "text/plain")]+ "Return your app"++exchangeCode :: OAuth2Client -> Code -> IO TokenInfo+exchangeCode c code = do+ let body = ReqBodyUrlEnc $+ "code" =: code <>+ "client_id" =: clientId c <>+ "client_secret" =: clientSecret c <>+ "redirect_uri" =: redirectUri <>+ "grant_type" =: ("authorization_code" :: String)+ res <- req POST tokenUrl body jsonResponse mempty+ return $ responseBody res++tokenUrl :: Url 'Https+tokenUrl = https "accounts.google.com" /: "o" /: "oauth2" /: "token"++serverPort :: Port+serverPort = 8017++redirectUri :: String+redirectUri = "http://127.0.0.1:" ++ show serverPort++data OAuth2Client = OAuth2Client+ { clientId :: String+ , clientSecret :: String+ } deriving (Show, Read)++type AccessToken = B.ByteString+type RefreshToken = String+type Code = String++type Scope = String++data TokenInfo = TokenInfo+ { accessToken :: String+ , refreshToken :: String+ , expiresIn :: Int+ } deriving (Show, Read)++instance FromJSON TokenInfo where+ parseJSON (Object v) = TokenInfo <$> v .: "access_token"+ <*> v .:? "refresh_token" .!= ""+ <*> v .: "expires_in"+ parseJSON _ = mempty++instance MonadHttp IO where+ handleHttpException = throwIO
+ test/Network/Google/OAuth2Spec.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Google.OAuth2Spec where++import Test.Hspec+import Network.Google.OAuth2++spec :: Spec+spec =+ describe "getToken" $+ it "returns the access token" $ do+ let tokenFile = "token.info"+ token = "TokenInfo {accessToken = \"access_token\", refreshToken = \"refresh_token\", expiresIn = 3600}"+ c = OAuth2Client "client_id" "client_secret"+ writeFile tokenFile token+ getToken c tokenFile [] `shouldReturn` "access_token"+
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}