tonatona-google-server-api (empty) → 0.1.0.0

raw patch · 11 files changed

+322/−0 lines, 11 filesdep +Globdep +basedep +doctestsetup-changed

Dependencies added: Glob, base, doctest, google-server-api, monad-logger, persistent, persistent-sqlite, resource-pool, servant-client, tonalude, tonaparser, tonatona

Files

• LICENSE +21/−0
• README.md +1/−0
• Setup.hs +2/−0
• src/Tonatona/Google.hs +82/−0
• src/Tonatona/Google/Client.hs +31/−0
• src/Tonatona/Google/Form.hs +5/−0
• src/Tonatona/Google/Internal.hs +15/−0
• src/Tonatona/Google/Response.hs +5/−0
• test/DocTest.hs +58/−0
• test/Spec.hs +8/−0
• tonatona-google-server-api.cabal +94/−0

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018 Kadzuya Okamoto https://arow.info++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,1 @@+# tonatona-google-server-api

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

@@ -0,0 +1,82 @@+module Tonatona.Google+  ( run+  , Dsl+  , DslBackend+  , Config+  , ServantError+  , JWT+  , JWT.Scope(..)+  ) where++import Tonalude++import qualified Google.Client as Client+import qualified Google.Form as Form+import Google.JWT (JWT)+import qualified Google.JWT as JWT+import Google.Response (Token)+import qualified Google.Response as Response+import Servant.Client (ServantError)++import Tonatona (HasConfig(..), HasParser(..))+import TonaParser (Parser, (.||), argLong, envVar, liftWith, requiredVal)+import Tonatona.Google.Internal++-- | Main function.+run ::+     (HasConfig env Config)+  => (ServantError -> RIO env a)+  -- ^ Error handler+  -> [JWT.Scope]+  -> Dsl env a+  -> RIO env a+run errorHandler scopes query = do+  Config {..} <- asks config+  eToken <- liftIO $ Client.getToken (Just delegationEmail) jwt scopes+  case eToken of+    Left err -> errorHandler err+    Right token ->+      runReaderT query (DslBackend token) `catch` errorHandler+++------------+-- Config --+------------++data Config = Config+  { serviceKeyFile :: ServiceKeyFile+  , jwt :: JWT+  , delegationEmail :: JWT.Email+  }++newtype ServiceKeyFile = ServiceKeyFile { unServiceKeyFile :: FilePath }+  deriving (Eq, Read, Show)++instance HasParser ServiceKeyFile where+  parser = ServiceKeyFile <$>+    requiredVal+      "File path to service key file (Example: \"gmail-3abc452de.json\")"+      ( argLong "service-key-file" .|| envVar "SERVICE_KEY_FILE")++parseJwt :: ServiceKeyFile -> Parser JWT+parseJwt (ServiceKeyFile fp) = do+  mjwt <- liftIO $ JWT.readServiceKeyFile fp+  case mjwt of+    Nothing ->+      error $ "Failed to parse service key file: " <> fp+    Just jwt ->+      pure jwt++parseEmail :: Parser JWT.Email+parseEmail = JWT.Email <$>+  requiredVal+    "Email account to use for delegation."+    ( argLong "delegation-email" .|| envVar "DELEGATION_EMAIL")++instance HasParser Config where+  parser = do+    keyFile <- parser+    Config+      <$> pure keyFile+      <*> parseJwt keyFile+      <*> parseEmail

@@ -0,0 +1,31 @@+{- |+Module      :  Tonatona.Google.Client++Define functions to call Google APIs.+-}+module Tonatona.Google.Client+  ( postCalendarEvent+  , postGmailSend+  ) where++import Tonalude+import qualified Google.Client as Client+import qualified Google.Form as Form+import qualified Google.Response as Response+import Tonatona.Google.Internal++postCalendarEvent :: Form.CalendarEvent -> Dsl env Response.CalendarEvent+postCalendarEvent event = do+  t <- asks token+  res <- liftIO $ Client.postCalendarEvent t event+  case res of+    Left err -> throwM err+    Right resp -> pure resp++postGmailSend :: Form.Email -> Dsl env Response.GmailSend+postGmailSend email = do+  t <- asks token+  res <- liftIO $ Client.postGmailSend t email+  case res of+    Left err -> throwM err+    Right resp -> pure resp

@@ -0,0 +1,5 @@+module Tonatona.Google.Form+  ( module Google.Form+  ) where++import Google.Form

@@ -0,0 +1,15 @@+module Tonatona.Google.Internal+  ( Dsl+  , DslBackend(..)+  ) where++import Tonalude+import Google.Response (Token)++type Dsl env+  = ReaderT DslBackend (RIO env)++data DslBackend = DslBackend+  { token :: Token+  }+  deriving (Show, Eq)

@@ -0,0 +1,5 @@+module Tonatona.Google.Response+  ( module Google.Response+  ) where++import Google.Response

@@ -0,0 +1,58 @@+module Main (main) where++import Tonalude++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)++main :: IO ()+main = glob "src/**/*.hs" >>= doDocTest++doDocTest :: [String] -> IO ()+doDocTest options =+  doctest $+    options <>+    ghcExtensions++ghcExtensions :: [String]+ghcExtensions =+    [ "-XAutoDeriveTypeable"+    , "-XBangPatterns"+    , "-XBinaryLiterals"+    , "-XConstraintKinds"+    , "-XDataKinds"+    , "-XDefaultSignatures"+    , "-XDeriveDataTypeable"+    , "-XDeriveFoldable"+    , "-XDeriveFunctor"+    , "-XDeriveGeneric"+    , "-XDeriveTraversable"+    , "-XDoAndIfThenElse"+    , "-XEmptyDataDecls"+    , "-XExistentialQuantification"+    , "-XFlexibleContexts"+    , "-XFlexibleInstances"+    , "-XFunctionalDependencies"+    , "-XGADTs"+    , "-XGeneralizedNewtypeDeriving"+    , "-XInstanceSigs"+    , "-XKindSignatures"+    , "-XLambdaCase"+    , "-XMonadFailDesugaring"+    , "-XMultiParamTypeClasses"+    , "-XMultiWayIf"+    , "-XNamedFieldPuns"+    , "-XNoImplicitPrelude"+    , "-XOverloadedStrings"+    , "-XPartialTypeSignatures"+    , "-XPatternGuards"+    , "-XPolyKinds"+    , "-XRankNTypes"+    , "-XRecordWildCards"+    , "-XScopedTypeVariables"+    , "-XStandaloneDeriving"+    , "-XTupleSections"+    , "-XTypeFamilies"+    , "-XTypeSynonymInstances"+    , "-XViewPatterns"+    ]

@@ -0,0 +1,8 @@+{-# LANGUAGE QuasiQuotes #-}++module Main where++import Tonalude++main :: IO ()+main = pure ()

@@ -0,0 +1,94 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: e2a0ef2de7a9d61ded7db3682aa5bdc07fecf6f72db2398b73483e5061ff42ac++name:           tonatona-google-server-api+version:        0.1.0.0+synopsis:       tonatona plugin for google-server-api+description:    Tonatona plugin for [google-server-api](https://hackage.haskell.org/package/google-server-api). This package provides a tonatona plugin to use Google API for server to server applications.+category:       Database, Library, Tonatona, Web+homepage:       https://github.com/arowM/tonatona-google-server-api#readme+bug-reports:    https://github.com/arowM/tonatona-google-server-api/issues+author:         Kadzuya Okamoto+maintainer:     arow.okamoto+github@gmail.com+copyright:      2019 Kadzuya Okamoto+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/arowM/tonatona-google-server-api++library+  exposed-modules:+      Tonatona.Google+      Tonatona.Google.Client+      Tonatona.Google.Form+      Tonatona.Google.Response+  other-modules:+      Tonatona.Google.Internal+      Paths_tonatona_google_server_api+  hs-source-dirs:+      src+  default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving Strict StrictData TupleSections TypeFamilies TypeSynonymInstances ViewPatterns+  ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , google-server-api >=0.3+    , monad-logger >=0.3+    , persistent >=2.8+    , persistent-sqlite >=2.8+    , resource-pool >=0.2+    , servant-client >=0.13+    , tonalude >=0.1.1+    , tonaparser >=0.1+    , tonatona >=0.1+  default-language: Haskell2010++test-suite doctest+  type: exitcode-stdio-1.0+  main-is: DocTest.hs+  hs-source-dirs:+      test+  default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving Strict StrictData TupleSections TypeFamilies TypeSynonymInstances ViewPatterns+  ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      Glob+    , base >=4.7 && <5+    , doctest+    , google-server-api >=0.3+    , monad-logger >=0.3+    , persistent >=2.8+    , persistent-sqlite >=2.8+    , resource-pool >=0.2+    , servant-client >=0.13+    , tonalude >=0.1.1+    , tonaparser >=0.1+    , tonatona >=0.1+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving Strict StrictData TupleSections TypeFamilies TypeSynonymInstances ViewPatterns+  ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , google-server-api >=0.3+    , monad-logger >=0.3+    , persistent >=2.8+    , persistent-sqlite >=2.8+    , resource-pool >=0.2+    , servant-client >=0.13+    , tonalude >=0.1.1+    , tonaparser >=0.1+    , tonatona+  default-language: Haskell2010