diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,7 @@ +# Change log + +google-oauth2-easy uses [Semantic Versioning][]. +The change log is available through the [releases on GitHub][]. + +[Semantic Versioning]: http://semver.org/spec/v2.0.0.html +[releases on GitHub]: https://github.com/githubuser/google-oauth2-easy/releases diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,30 @@ +Copyright (c) 2018, Joe Vargas + +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 Joe Vargas 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.A diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +# google-oauth2-easy diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,7 @@ +-- This script is used to build and install your package. Typically you don't +-- need to change it. The Cabal documentation has more information about this +-- file: . +import qualified Distribution.Simple + +main :: IO () +main = Distribution.Simple.defaultMain diff --git a/benchmark/Main.hs b/benchmark/Main.hs new file mode 100644 --- /dev/null +++ b/benchmark/Main.hs @@ -0,0 +1,6 @@ +-- You can benchmark your code quickly and effectively with Criterion. See its +-- website for help: . +import Criterion.Main + +main :: IO () +main = defaultMain [bench "const" (whnf const ())] diff --git a/google-oauth2-easy.cabal b/google-oauth2-easy.cabal new file mode 100644 --- /dev/null +++ b/google-oauth2-easy.cabal @@ -0,0 +1,80 @@ +-- This file has been generated from package.yaml by hpack version 0.20.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 15faf95dc4b17f2c955e679d24fce822a2ce9e5a3ebdc5fe17b1f1205b8cd508 + +name: google-oauth2-easy +version: 0.0.0 +synopsis: Opininated use of Google Authentication for ease +description: Easy Google Authentication integration using the Authorization Code Grant and Refresh Token +category: Network +homepage: https://github.com/jxv/google-oauth2-easy#readme +bug-reports: https://github.com/jxv/google-oauth2-easy/issues +author: Joe Vargas +maintainer: Joe Vargas +license: BSD3 +license-file: LICENSE.md +build-type: Simple +cabal-version: >= 1.10 + +extra-source-files: + CHANGELOG.md + LICENSE.md + package.yaml + README.md + stack.yaml + +source-repository head + type: git + location: https://github.com/jxv/google-oauth2-easy + +library + hs-source-dirs: + library + ghc-options: -Wall + build-depends: + aeson + , base >=4.7 && <5 + , http-api-data + , http-client + , mtl + , servant + , servant-client + , text + , text-conversions + , unordered-containers + exposed-modules: + Google.Authentication.Easy + other-modules: + Paths_google_oauth2_easy + default-language: Haskell2010 + +test-suite google-oauth2-easy-test-suite + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: + test-suite + ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N + build-depends: + base + , google-oauth2-easy + , tasty + , tasty-hspec + other-modules: + Paths_google_oauth2_easy + default-language: Haskell2010 + +benchmark google-oauth2-easy-benchmarks + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: + benchmark + ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N + build-depends: + base + , criterion + , google-oauth2-easy + other-modules: + Paths_google_oauth2_easy + default-language: Haskell2010 diff --git a/library/Google/Authentication/Easy.hs b/library/Google/Authentication/Easy.hs new file mode 100644 --- /dev/null +++ b/library/Google/Authentication/Easy.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +module Google.Authentication.Easy + ( Service(..) + , callPostTokenInfo' + , callPostToken' + , AccessTokenForm(..) + , PostTokenBody(..) + , PostTokenInfoResponse(..) + , RefreshTokenResp(..) + , RefreshTokenBody(..) + , AuthorizationCodeResp(..) + , AuthorizationCodeBody(..) + , ServantError + , Manager + ) where + +import qualified Data.HashMap.Lazy as HML (singleton, fromList) +import Control.Applicative ((<|>)) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Monad.Reader (MonadReader, asks) +import Data.Aeson +import Data.Text +import Data.Text.Conversions +import Data.Proxy +import GHC.Generics (Generic) +import Network.HTTP.Client (Manager) +import Servant.API +import Servant.Client +import Web.FormUrlEncoded (Form(..), ToForm(..)) + +apiBaseUrl :: BaseUrl +apiBaseUrl = BaseUrl Https "www.googleapis.com" 443 "" + +type Api = "oauth2" :> (("v3" :> PostTokenInfo) :<|> ("v4" :> PostToken)) + +type PostTokenInfo = "tokeninfo" :> ReqBody '[FormUrlEncoded] AccessTokenForm :> Post '[JSON] PostTokenInfoResponse +type PostToken = "token" :> ReqBody '[FormUrlEncoded] PostTokenBody :> Post '[JSON] PostTokenResponse + +data AccessTokenForm = AccessTokenForm + { access_token :: Text + } deriving (Show, Eq) + +instance ToForm AccessTokenForm where + toForm form = Form $ HML.singleton "access_token" [toText $ (access_token :: AccessTokenForm -> Text) form] + +data PostTokenInfoResponse = PostTokenInfoResponse + { azp :: Text + , aud :: Text + , sub :: Text + , scope :: Text + , exp :: Text + , expires_in :: Text + , email :: Text + , email_verified :: Text + , access_type :: Text + } deriving (Show, Eq, Generic) + +instance FromJSON PostTokenInfoResponse + +data PostTokenBody + = PostTokenBody'AuthorizationCodeBody AuthorizationCodeBody + | PostTokenBody'RefreshTokenBody RefreshTokenBody + deriving (Show, Eq) + +instance ToForm PostTokenBody where + toForm (PostTokenBody'AuthorizationCodeBody body) = toForm body + toForm (PostTokenBody'RefreshTokenBody body) = toForm body + +data AuthorizationCodeBody = AuthorizationCodeBody + { code :: Text + , client_id :: Text + , client_secret :: Text + , redirect_uri :: Text -- "https://www.camp47.com" + , grant_type :: Text -- "authorization_code" + } deriving (Show, Eq, Generic) + +instance ToJSON AuthorizationCodeBody + +instance ToForm AuthorizationCodeBody where + toForm AuthorizationCodeBody{code,client_id,client_secret,redirect_uri,grant_type} = Form $ HML.fromList + [ ("code", [toText code]) + , ("client_id", [toText client_id]) + , ("client_secret", [toText client_secret]) + , ("redirect_uri", [toText redirect_uri]) + , ("grant_type", [toText grant_type]) + ] + +data RefreshTokenBody = RefreshTokenBody + { refresh_token :: Text + , client_id :: Text + , client_secret :: Text + , grant_type :: Text -- "refresh_token" + } deriving (Show, Eq, Generic) + +instance ToForm RefreshTokenBody where + toForm RefreshTokenBody{refresh_token,client_id,client_secret,grant_type} = Form $ HML.fromList + [ ("refresh_token", [toText refresh_token]) + , ("client_id", [toText client_id]) + , ("client_secret", [toText client_secret]) + , ("grant_type", [toText grant_type]) + ] + +data PostTokenResponse + = PostTokenResponse'AuthorizationCodeResp AuthorizationCodeResp + | PostTokenResponse'RefreshTokenResp RefreshTokenResp + deriving (Show, Eq) + +instance FromJSON PostTokenResponse where + parseJSON v = + (PostTokenResponse'AuthorizationCodeResp <$> parseJSON v) <|> + (PostTokenResponse'RefreshTokenResp <$> parseJSON v) + +data AuthorizationCodeResp = AuthorizationCodeResp + { access_token :: Text + , expires_in :: Int + , token_type :: Text + , refresh_token :: Text + , id_token :: Text + } deriving (Show, Eq, Generic) + +instance FromJSON AuthorizationCodeResp + +data RefreshTokenResp = RefreshTokenResp + { access_token :: Text + , expires_in :: Int + , token_type :: Text + } deriving (Show, Eq, Generic) + +instance FromJSON RefreshTokenResp + +api :: Proxy Api +api = Proxy + +postTokenInfo :: AccessTokenForm -> ClientM PostTokenInfoResponse +postToken :: PostTokenBody -> ClientM PostTokenResponse +postTokenInfo :<|> postToken = client api + +class Monad m => Service m where + callPostTokenInfo :: AccessTokenForm -> m (Either ServantError PostTokenInfoResponse) + callPostToken :: PostTokenBody -> m (Either ServantError PostTokenResponse) + + +callPostTokenInfo' :: (MonadIO m, MonadReader r m) => (r -> Manager) -> AccessTokenForm -> m (Either ServantError PostTokenInfoResponse) +callPostTokenInfo' getManager accessTokenForm = do + manager <- asks getManager + liftIO $ runClientM (postTokenInfo accessTokenForm) (ClientEnv manager apiBaseUrl) + +callPostToken' :: (MonadIO m, MonadReader r m) => (r -> Manager) -> PostTokenBody -> m (Either ServantError PostTokenResponse) +callPostToken' getManager authorizationCodeForm = do + manager <- asks getManager + liftIO $ runClientM (postToken authorizationCodeForm) (ClientEnv manager apiBaseUrl) + + diff --git a/package.yaml b/package.yaml new file mode 100644 --- /dev/null +++ b/package.yaml @@ -0,0 +1,60 @@ +name: google-oauth2-easy +version: '0.0.0' +github: jxv/google-oauth2-easy +license: BSD3 +license-file: LICENSE.md +author: Joe Vargas +maintainer: Joe Vargas +synopsis: Opininated use of Google Authentication for ease +description: Easy Google Authentication integration using the Authorization Code Grant and Refresh Token +category: Network + +extra-source-files: +- CHANGELOG.md +- LICENSE.md +- package.yaml +- README.md +- stack.yaml + +ghc-options: -Wall + +library: + dependencies: + - base >=4.7 && <5 + - aeson + - unordered-containers + - http-api-data + - http-client + - mtl + - servant + - servant-client + - text + - text-conversions + source-dirs: library + +benchmarks: + google-oauth2-easy-benchmarks: + source-dirs: benchmark + main: Main.hs + dependencies: + - base + - google-oauth2-easy + - criterion + ghc-options: + - -rtsopts + - -threaded + - -with-rtsopts=-N + +tests: + google-oauth2-easy-test-suite: + source-dirs: test-suite + main: Main.hs + dependencies: + - base + - google-oauth2-easy + - tasty + - tasty-hspec + ghc-options: + - -rtsopts + - -threaded + - -with-rtsopts=-N diff --git a/stack.yaml b/stack.yaml new file mode 100644 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,66 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-10.8 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.6" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/test-suite/Main.hs b/test-suite/Main.hs new file mode 100644 --- /dev/null +++ b/test-suite/Main.hs @@ -0,0 +1,17 @@ +-- Tasty makes it easy to test your code. It is a test framework that can +-- combine many different types of tests into one suite. See its website for +-- help: . +import qualified Test.Tasty +-- Hspec is one of the providers for Tasty. It provides a nice syntax for +-- writing tests. Its website has more info: . +import Test.Tasty.Hspec + +main :: IO () +main = do + test <- testSpec "google-oauth2-easy" spec + Test.Tasty.defaultMain test + +spec :: Spec +spec = parallel $ do + it "is trivially true" $ do + True `shouldBe` True