packages feed

gogol-core 0.3.0 → 1.0.0.0

raw patch · 14 files changed

Files

− Setup.hs 
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
gogol-core.cabal view
@@ -1,93 +1,77 @@-name:                  gogol-core-version:               0.3.0-synopsis:              Core data types and functionality for Gogol libraries.-homepage:              https://github.com/brendanhay/gogol-bug-reports:           https://github.com/brendanhay/gogol/issues-license:               OtherLicense-license-file:          LICENSE-author:                Brendan Hay-maintainer:            Brendan Hay <brendan.g.hay@gmail.com>-copyright:             Copyright (c) 2015-2016 Brendan Hay-category:              Network, Google, Cloud-build-type:            Simple-extra-source-files:    README.md-cabal-version:         >= 1.10+cabal-version:      2.2+name:               gogol-core+version:            1.0.0.0+synopsis:           Core data types and functionality for Gogol libraries.+homepage:           https://github.com/brendanhay/gogol+bug-reports:        https://github.com/brendanhay/gogol/issues+license:            MPL-2.0+license-file:       LICENSE+author:             Brendan Hay+maintainer:+  Brendan Hay <brendan.g.hay+gogol@gmail.com>, Toni Cebrián <toni@tonicebrian.com> +copyright:          Copyright (c) 2015-2025 Brendan Hay+category:           Google+build-type:         Simple+extra-source-files: README.md description:-    Core data types, functionality and serialisation primitives for-    Gogol related Google Services SDKs.-    .-    The external interface of this library is stable with respect to the-    downstream Gogol libraries, only, and as such is not suitable-    for use in non-Gogol projects.+  Core data types, functionality and serialisation primitives for+  Gogol related Google Services SDKs.+  .+  The external interface of this library is stable with respect to the+  downstream Gogol libraries, only, and as such is not suitable+  for use in non-Gogol projects.  source-repository head-    type:              git-    location:          git://github.com/brendanhay/gogol.git--flag old-locale-    description:       Use old-locale and time < 1.5-    default:           False+  type:     git+  location: git://github.com/brendanhay/gogol.git  library-    default-language:  Haskell2010-    hs-source-dirs:    src--    ghc-options:       -Wall--    exposed-modules:-          Network.Google.Data.Bytes-        , Network.Google.Data.JSON-        , Network.Google.Data.Numeric-        , Network.Google.Data.Time-        , Network.Google.Prelude-        , Network.Google.Types--    build-depends:-          aeson                >= 0.8-        , attoparsec           >= 0.11.3-        , base                 >= 4.7 && < 5-        , bifunctors           >= 0.1-        , bytestring           >= 0.9-        , case-insensitive     >= 1.2-        , conduit              >= 1.1-        , dlist                >= 0.7-        , exceptions           >= 0.6-        , hashable             >= 1.2-        , http-api-data        >= 0.2-        , http-client          >= 0.5 && < 1-        , http-media           >= 0.6-        , http-types           >= 0.8.6-        , lens                 >= 4.4-        , resourcet            >= 1.1-        , scientific           >= 0.3-        , servant              >= 0.4.4-        , text                 >= 1.1-        , unordered-containers >= 0.2.5+  default-language: GHC2021+  hs-source-dirs:   src+  ghc-options:+    -Wall -fwarn-incomplete-uni-patterns+    -fwarn-incomplete-record-updates -funbox-strict-fields+    -fwarn-unused-packages -    if !impl(ghc>=7.9)-        build-depends:-              nats >= 0.1.3+  exposed-modules:+    Gogol.Data.Base64+    Gogol.Data.JSON+    Gogol.Data.Time+    Gogol.Prelude+    Gogol.Types -    if flag(old-locale)-        build-depends:-              old-locale == 1.*-            , time       >= 1.2 && < 1.5-    else-        build-depends:-              time       >= 1.5+  build-depends:+    , aeson                 >=0.8    && <2.3+    , attoparsec            >=0.11.3 && <0.15+    , base                  >=4.12   && <5+    , base64                >=1.0    && <1.1+    , bytestring            >=0.9    && <0.14+    , case-insensitive      >=1.2    && <1.3+    , conduit               >=1.3    && <1.4+    , dlist                 >=0.7    && <1.1+    , exceptions            >=0.6    && <0.12+    , hashable              >=1.2    && <1.6+    , http-api-data         >=0.2    && <0.7+    , http-client           >=0.5    && <1+    , http-media            >=0.6    && <0.9+    , http-types            >=0.8.6  && <0.13+    , lens                  >=4.4    && <5.4+    , resourcet             >=1.1    && <1.4+    , scientific            >=0.3    && <0.4+    , servant               >=0.20.1 && <0.21+    , text                  >=1.1    && <2.2+    , time                  >=1.2    && <2+    , unordered-containers  >=0.2.5  && <0.3  test-suite tests-    type:              exitcode-stdio-1.0-    default-language:  Haskell2010-    hs-source-dirs:    test-    main-is:           Main.hs--    ghc-options:       -Wall -threaded--    other-modules:--    build-depends:-          gogol-core-        , base-        , tasty+  type:             exitcode-stdio-1.0+  default-language: Haskell2010+  hs-source-dirs:   test+  main-is:          Main.hs+  ghc-options:      -Wall -threaded+  other-modules:+  build-depends:+    , base+    , gogol-core+    , tasty
+ src/Gogol/Data/Base64.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- |+-- Module      : Gogol.Data.Base64+-- Copyright   : (c) 2013-2022 Brendan Hay+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Gogol.Data.Base64+  ( Base64 (..),+    _Base64,+  )+where++import Control.Lens (Iso', iso)+import Data.Aeson (FromJSON (..), ToJSON (..))+import Data.Base64.Types qualified as Base64+import Data.ByteString (ByteString)+import Data.ByteString.Base64 qualified as Base64+import Data.Hashable+import Data.Text.Encoding qualified as Text+import GHC.Generics (Generic)+import Gogol.Data.JSON (parseJSONText, toJSONText)+import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))++-- | Raw bytes that will be transparently base64 encoded\/decoded+-- on tramission to\/from a remote API.+newtype Base64 = Base64 {fromBase64 :: ByteString}+  deriving (Eq, Show, Read, Ord, Generic, Hashable)++_Base64 :: Iso' Base64 ByteString+_Base64 = iso fromBase64 Base64++instance ToHttpApiData Base64 where+  toUrlPiece = Base64.extractBase64 . Base64.encodeBase64 . fromBase64+  toQueryParam = Base64.extractBase64 . Base64.encodeBase64 . fromBase64+  toHeader = Base64.extractBase64 . Base64.encodeBase64' . fromBase64++instance FromHttpApiData Base64 where+  parseUrlPiece = fmap Base64 . Base64.decodeBase64Untyped . Text.encodeUtf8+  parseQueryParam = fmap Base64 . Base64.decodeBase64Untyped . Text.encodeUtf8+  parseHeader = fmap Base64 . Base64.decodeBase64Untyped++instance FromJSON Base64 where+  parseJSON = parseJSONText "Base64"++instance ToJSON Base64 where+  toJSON = toJSONText
+ src/Gogol/Data/JSON.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module      : Gogol.Data.JSON+-- Copyright   : (c) 2015-2022 Brendan Hay <brendan.g.hay@gmail.com>+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Gogol.Data.JSON+  ( Value,+    AsText (..),+    parseJSONObject,+    parseJSONText,+    toJSONText,++    -- * Re-exports+    FromJSON (..),+    FromJSONKey (..),+    ToJSON (..),+    ToJSONKey (..),+    withObject,+    emptyObject,+    object,+    (.=),+    (.:),+    (.:?),+    (.!=),+  )+where++import Data.Aeson+import Data.Aeson.Types+import Data.Text qualified as Text+import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))++#if MIN_VERSION_aeson(2,0,0)+import Data.Aeson.KeyMap (KeyMap)+#else+import Data.HashMap.Strict (HashMap)+import Data.Text (Text)+#endif++newtype AsText a = AsText {fromAsText :: a}+  deriving (Eq, Ord, Read, Show, Num, Fractional, ToHttpApiData, FromHttpApiData)++instance (FromJSON a, FromHttpApiData a) => FromJSON (AsText a) where+  parseJSON (String s) = either (fail . Text.unpack) (pure . AsText) (parseQueryParam s)+  parseJSON o = AsText <$> parseJSON o++instance (ToHttpApiData a) => ToJSON (AsText a) where+  toJSON (AsText x) = String (toQueryParam x)++#if MIN_VERSION_aeson(2,0,0)+parseJSONObject :: FromJSON a => KeyMap Value -> Parser a+#else+parseJSONObject :: FromJSON a => HashMap Text Value -> Parser a+#endif+parseJSONObject = parseJSON . toJSON++parseJSONText :: (FromHttpApiData a) => String -> Value -> Parser a+parseJSONText n = withText n (either (fail . f) pure . parseQueryParam)+  where+    f x = n ++ " - " ++ Text.unpack x++toJSONText :: (ToHttpApiData a) => a -> Value+toJSONText = String . toQueryParam
+ src/Gogol/Data/Time.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : Gogol.Data.Time+-- Copyright   : (c) 2015-2022 Brendan Hay <brendan.g.hay@gmail.com>+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Gogol.Data.Time+  ( Time (..),+    Date (..),+    DateTime (..),+    Duration (..),+    _Time,+    _Date,+    _DateTime,+    _Duration,+  )+where++import Control.Lens+import Data.Aeson+import Data.Aeson.Types qualified as Aeson+import Data.Attoparsec.Text+import Data.Bifunctor (first, second)+import Data.Bits ((.&.))+import Data.Char (ord)+import Data.Scientific (Scientific)+import Data.Scientific qualified as Sci+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Lazy qualified as LText+import Data.Text.Lazy.Builder qualified as Build+import Data.Text.Lazy.Builder.Scientific qualified as Sci+import Data.Time+import GHC.Generics+import Web.HttpApiData+  ( FromHttpApiData (..),+    ToHttpApiData (..),+  )++-- | This SHOULD be a time in the format of hh:mm:ss.  It is+-- recommended that you use the "date-time" format instead of "time"+-- unless you need to transfer only the time part.+newtype Time = Time {fromTime :: TimeOfDay}+  deriving (Eq, Ord, Show, Read, Generic)++_Time :: Iso' Time TimeOfDay+_Time = iso fromTime Time++instance ToHttpApiData Time where+  toQueryParam = Text.pack . show . fromTime++instance FromHttpApiData Time where+  parseQueryParam = second Time . parseText timeParser++-- | This SHOULD be a date in the format of YYYY-MM-DD.  It is+-- recommended that you use the "date-time" format instead of "date"+-- unless you need to transfer only the date part.+newtype Date = Date {unDate :: Day}+  deriving (Eq, Ord, Show, Read, Generic, ToHttpApiData, FromHttpApiData)++_Date :: Iso' Date Day+_Date = iso unDate Date++-- | This SHOULD be a date in ISO 8601 format of YYYY-MM-+-- DDThh:mm:ssZ in UTC time. This is the recommended form of date/timestamp.+newtype DateTime = DateTime {unDateTime :: UTCTime}+  deriving (Eq, Ord, Show, Read, Generic, ToHttpApiData, FromHttpApiData)++_DateTime :: Iso' DateTime UTCTime+_DateTime = iso unDateTime DateTime++-- | A duration in seconds with up to nine fractional digits, terminated by 's'.+--+-- /Example/: @"3.5s"@.+newtype Duration = Duration {unDuration :: Scientific}+  deriving (Eq, Ord, Show, Read, Generic)++_Duration :: Iso' Duration Scientific+_Duration = iso unDuration Duration++instance ToHttpApiData Duration where+  toQueryParam =+    LText.toStrict+      . (\seconds -> Build.toLazyText seconds <> "s")+      . Sci.formatScientificBuilder Sci.Fixed (Just 9)+      . unDuration++instance FromHttpApiData Duration where+  parseQueryParam = second Duration . parseText durationParser++instance ToJSON Time where toJSON = String . toQueryParam++instance ToJSON Date where toJSON = String . toQueryParam++instance ToJSON DateTime where toJSON = toJSON . unDateTime++instance ToJSON Duration where toJSON = String . toQueryParam++instance FromJSON Time where+  parseJSON = fmap Time . withText "Time" (run timeParser)++instance FromJSON Date where+  parseJSON = fmap Date . withText "Date" (run dayParser)++instance FromJSON DateTime where+  parseJSON = fmap DateTime . parseJSON++instance FromJSON Duration where+  parseJSON = fmap Duration . withText "Duration" (run durationParser)++parseText :: Parser a -> Text -> Either Text a+parseText p = first Text.pack . parseOnly p++-- | Parse a time of the form @HH:MM:SS@.+timeParser :: Parser TimeOfDay+timeParser = do+  h <- twoDigits <* char ':'+  m <- twoDigits <* char ':'+  s <- twoDigits <&> fromIntegral+  if h < 24 && m < 60 && s < 61+    then pure (TimeOfDay h m s)+    else fail "invalid time"++-- | Parse a date of the form @YYYY-MM-DD@.+dayParser :: Parser Day+dayParser = do+  y <- decimal <* char '-'+  m <- twoDigits <* char '-'+  d <- twoDigits+  maybe (fail "invalid date") pure (fromGregorianValid y m d)++durationParser :: Parser Scientific+durationParser = Sci.fromFloatDigits <$> (double <* char 's')++-- | Parse a two-digit integer (e.g. day of month, hour).+twoDigits :: Parser Int+twoDigits = do+  a <- digit+  b <- digit+  let c2d c = ord c .&. 15+  pure $! c2d a * 10 + c2d b++-- | Run an attoparsec parser as an aeson parser.+run :: Parser a -> Text -> Aeson.Parser a+run p t =+  case parseOnly (p <* endOfInput) t of+    Left err -> fail $ "could not parse date: " ++ err+    Right r -> pure r
+ src/Gogol/Prelude.hs view
@@ -0,0 +1,36 @@+-- |+-- Module      : Gogol.Prelude+-- Copyright   : (c) 2015-2022 Brendan Hay <brendan.g.hay@gmail.com>+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Gogol.Prelude+  ( module Export,+  )+where++import Control.Lens as Export (Lens', lens, mapping, (#), (^.), _Just)+import Data.ByteString as Export (ByteString)+import Data.Data as Export (Data, Typeable)+import Data.Functor as Export ((<&>))+import Data.HashMap.Strict as Export (HashMap)+import Data.Hashable as Export (Hashable, hashWithSalt)+import Data.Int as Export (Int32, Int64)+import Data.Maybe as Export+import Data.Proxy as Export+import Data.Scientific as Export (Scientific)+import Data.Text as Export (Text)+import Data.Time as Export (Day, TimeOfDay, UTCTime)+import Data.Word as Export (Word32, Word64, Word8)+import GHC.Generics as Export (Generic)+import Gogol.Data.Base64 as Export+import Gogol.Data.JSON as Export+import Gogol.Data.Time as Export+import Gogol.Types as Export+import Network.HTTP.Client as Export (RequestBody)+import Numeric.Natural as Export (Natural)+import Servant.API as Export hiding (FromHttpApiData, Header, Headers, IsMember, Link, ResponseHeader, Stream, ToHttpApiData, Union, getResponse)+import Servant.Links as Export hiding (Link)+import Web.HttpApiData as Export (FromHttpApiData (..), ToHttpApiData (..))+import Prelude as Export
+ src/Gogol/Types.hs view
@@ -0,0 +1,680 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module      : Gogol.Types+-- Copyright   : (c) 2015-2022 Brendan Hay <brendan.g.hay@gmail.com>+-- License     : Mozilla Public License, v. 2.0.+-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability   : provisional+-- Portability : non-portable (GHC extensions)+module Gogol.Types where++import Control.Exception.Lens (exception)+import Control.Lens+import Control.Monad.Catch+import Control.Monad.Trans.Resource+import Data.Aeson+import Data.ByteString (ByteString)+import Data.ByteString.Char8 qualified as BS8+import Data.ByteString.Lazy qualified as LBS+import Data.CaseInsensitive qualified as CI+import Data.Coerce+import Data.Conduit+import Data.Conduit.Combinators qualified as Conduit+import Data.DList (DList)+import Data.DList qualified as DList+import Data.Data+import Data.Foldable qualified as Foldable+import Data.Kind (Type)+import Data.String+import Data.Text (Text)+import Data.Text.Encoding qualified as Text+import Data.Text.Lazy.Builder (Builder)+import Data.Text.Lazy.Builder qualified as Build+import GHC.Generics+import GHC.TypeLits+import Network.HTTP.Client (HttpException, RequestBody (..))+import Network.HTTP.Media hiding (Accept)+import Network.HTTP.Types hiding (Header)+import Network.HTTP.Types qualified as HTTP+import Servant.API hiding (Stream)++data AltJSON = AltJSON+  deriving (Eq, Ord, Show, Read, Generic)++instance ToHttpApiData AltJSON where+  toQueryParam = const "json"++data AltMedia = AltMedia+  deriving (Eq, Ord, Show, Read, Generic)++instance ToHttpApiData AltMedia where+  toQueryParam = const "media"++data Multipart = Multipart+  deriving (Eq, Ord, Show, Read, Generic)++instance ToHttpApiData Multipart where+  toQueryParam = const "multipart"++-- | An OAuth2 scope.+newtype OAuthScope = OAuthScope Text+  deriving+    ( Eq,+      Ord,+      Show,+      Read,+      IsString,+      Generic,+      FromHttpApiData,+      ToHttpApiData,+      FromJSON,+      ToJSON+    )++-- | An OAuth2 access token.+newtype AccessToken = AccessToken Text+  deriving+    ( Eq,+      Ord,+      Show,+      Read,+      IsString,+      Generic,+      FromHttpApiData,+      ToHttpApiData,+      FromJSON,+      ToJSON+    )++-- | An OAuth2 refresh token.+newtype RefreshToken = RefreshToken Text+  deriving+    ( Eq,+      Ord,+      Show,+      Read,+      IsString,+      Generic,+      FromHttpApiData,+      ToHttpApiData,+      FromJSON,+      ToJSON+    )++-- | A client identifier.+newtype ClientId = ClientId Text+  deriving+    ( Eq,+      Ord,+      Show,+      Read,+      IsString,+      Generic,+      FromHttpApiData,+      ToHttpApiData,+      FromJSON,+      ToJSON+    )++-- | A service identifier.+newtype ServiceId = ServiceId Text+  deriving+    ( Eq,+      Ord,+      Show,+      Read,+      IsString,+      Generic,+      FromHttpApiData,+      ToHttpApiData,+      FromJSON,+      ToJSON+    )++-- | An opaque client secret.+newtype GSecret = GSecret Text+  deriving+    ( Eq,+      Ord,+      Read,+      IsString,+      Generic,+      FromHttpApiData,+      ToHttpApiData,+      FromJSON,+      ToJSON+    )++instance Show GSecret where+  show = const "*****"++newtype MediaDownload a = MediaDownload a++data MediaUpload a = MediaUpload a GBody++_Coerce :: (Coercible a b, Coercible b a) => Iso' a b+_Coerce = iso coerce coerce++-- | Invalid Iso, exists for ease of composition with the current 'Lens . Iso'+-- chaining to hide internal types from the user.+_Default :: (Monoid a) => Iso' (Maybe a) a+_Default = iso f Just+  where+    f (Just x) = x+    f Nothing = mempty++type Stream = ConduitM () ByteString (ResourceT IO) ()++data Error+  = TransportError HttpException+  | SerializeError SerializeError+  | ServiceError ServiceError+  deriving (Show)++instance Exception Error++data SerializeError = SerializeError'+  { _serializeId :: !ServiceId,+    _serializeHeaders :: [HTTP.Header],+    _serializeStatus :: !Status,+    _serializeMessage :: !String,+    _serializeBody :: !(Maybe LBS.ByteString)+  }+  deriving (Eq, Show)++data ServiceError = ServiceError'+  { _serviceId :: !ServiceId,+    _serviceStatus :: !Status,+    _serviceHeaders :: ![HTTP.Header],+    _serviceBody :: !(Maybe LBS.ByteString)+  }+  deriving (Eq, Show)++class AsError a where+  -- | A general Amazonka error.+  _Error :: Prism' a Error++  {-# MINIMAL _Error #-}++  -- | An error occured while communicating over HTTP with a remote service.+  _TransportError :: Prism' a HttpException++  -- | A serialisation error occured when attempting to deserialise a response.+  _SerializeError :: Prism' a SerializeError++  -- | A service specific error returned by the remote service.+  _ServiceError :: Prism' a ServiceError++  _TransportError = _Error . _TransportError+  _SerializeError = _Error . _SerializeError+  _ServiceError = _Error . _ServiceError++instance AsError SomeException where+  _Error = exception++instance AsError Error where+  _Error = id++  _TransportError = prism TransportError $ \case+    TransportError e -> Right e+    x -> Left x++  _SerializeError = prism SerializeError $ \case+    SerializeError e -> Right e+    x -> Left x++  _ServiceError = prism ServiceError $ \case+    ServiceError e -> Right e+    x -> Left x++data ServiceConfig = ServiceConfig+  { _svcId :: !ServiceId,+    _svcHost :: !ByteString,+    _svcPath :: !Builder,+    _svcPort :: !Int,+    _svcSecure :: !Bool,+    _svcTimeout :: !(Maybe Seconds)+  }++defaultService :: ServiceId -> ByteString -> ServiceConfig+defaultService i h =+  ServiceConfig+    { _svcId = i,+      _svcHost = h,+      _svcPath = mempty,+      _svcPort = 443,+      _svcSecure = True,+      _svcTimeout = Just 70+    }++-- | The remote host name, used for both the IP address to connect to and the+-- host request header.+serviceHost :: Lens' ServiceConfig ByteString+serviceHost = lens _svcHost (\s a -> s {_svcHost = a})++-- | The remote port to connect to.+--+-- Defaults to @443@.+servicePort :: Lens' ServiceConfig Int+servicePort = lens _svcPort (\s a -> s {_svcPort = a})++-- | A path prefix that is prepended to any sent HTTP request.+--+-- Defaults to @mempty@.+servicePath :: Lens' ServiceConfig Builder+servicePath = lens _svcPath (\s a -> s {_svcPath = a})++-- | Whether to use HTTPS/SSL.+--+-- Defaults to @True@.+serviceSecure :: Lens' ServiceConfig Bool+serviceSecure = lens _svcSecure (\s a -> s {_svcSecure = a})++-- | Number of seconds to wait for a response.+serviceTimeout :: Lens' ServiceConfig (Maybe Seconds)+serviceTimeout = lens _svcTimeout (\s a -> s {_svcTimeout = a})++-- | A single part of a (potentially multipart) request body.+--+-- /Note:/ The 'IsString' instance defaults to a @text/plain@ MIME type.+data GBody = GBody !MediaType !RequestBody++instance IsString GBody where+  fromString = GBody ("text" // "plain") . fromString++-- | A lens into the 'MediaType' of a request 'Body'.+bodyContentType :: Lens' GBody MediaType+bodyContentType = lens (\(GBody m _) -> m) (\(GBody _ b) m -> GBody m b)++-- | An intermediary request builder.+data Request = Request+  { _rqPath :: !Builder,+    _rqQuery :: !(DList (ByteString, Maybe ByteString)),+    _rqHeaders :: !(DList (HeaderName, ByteString)),+    _rqBody :: ![GBody]+  }++instance Monoid Request where+  mempty = Request mempty mempty mempty mempty+  mappend = (<>)++instance Semigroup Request where+  a <> b =+    Request+      (_rqPath a <> "/" <> _rqPath b)+      (_rqQuery a <> _rqQuery b)+      (_rqHeaders a <> _rqHeaders b)+      (_rqBody b <> _rqBody a)++appendPath :: Request -> Builder -> Request+appendPath rq x = rq {_rqPath = _rqPath rq <> "/" <> x}++appendPaths :: (ToHttpApiData a) => Request -> [a] -> Request+appendPaths rq = appendPath rq . foldMap (mappend "/" . buildText)++appendQuery :: Request -> ByteString -> Maybe Text -> Request+appendQuery rq k v =+  rq+    { _rqQuery = DList.snoc (_rqQuery rq) (k, Text.encodeUtf8 <$> v)+    }++appendHeader :: Request -> HeaderName -> Maybe Text -> Request+appendHeader rq _ Nothing = rq+appendHeader rq k (Just v) =+  rq+    { _rqHeaders = DList.snoc (_rqHeaders rq) (k, Text.encodeUtf8 v)+    }++setBody :: Request -> [GBody] -> Request+setBody rq bs = rq {_rqBody = bs}++-- | A materialised 'http-client' request and associated response parser.+data GClient a = GClient+  { _cliAccept :: !(Maybe MediaType),+    _cliMethod :: !Method,+    _cliCheck :: !(Status -> Bool),+    _cliService :: !ServiceConfig,+    _cliRequest :: !Request,+    _cliResponse :: !(Stream -> ResourceT IO (Either (String, LBS.ByteString) a))+  }++clientService :: Lens' (GClient a) ServiceConfig+clientService = lens _cliService (\s a -> s {_cliService = a})++mime ::+  (FromStream c a) =>+  Proxy c ->+  Method ->+  [Int] ->+  Request ->+  ServiceConfig ->+  GClient a+mime p = gClient (fromStream p) (Just (contentType p))++discard ::+  Method ->+  [Int] ->+  Request ->+  ServiceConfig ->+  GClient ()+discard = gClient (\b -> runConduit (b .| Conduit.sinkNull) >> pure (Right ())) Nothing++gClient ::+  (Stream -> ResourceT IO (Either (String, LBS.ByteString) a)) ->+  Maybe MediaType ->+  Method ->+  [Int] ->+  Request ->+  ServiceConfig ->+  GClient a+gClient f cs m statuses rq s =+  GClient+    { _cliAccept = cs,+      _cliMethod = m,+      _cliCheck = \status -> fromEnum status `elem` statuses,+      _cliService = s,+      _cliRequest = rq,+      _cliResponse = f+    }++class (Accept c) => ToBody c a where+  toBody :: Proxy c -> a -> GBody++instance ToBody OctetStream ByteString where+  toBody p = GBody (contentType p) . RequestBodyBS++instance ToBody OctetStream LBS.ByteString where+  toBody p = GBody (contentType p) . RequestBodyLBS++instance ToBody PlainText ByteString where+  toBody p = GBody (contentType p) . RequestBodyBS++instance ToBody PlainText LBS.ByteString where+  toBody p = GBody (contentType p) . RequestBodyLBS++instance (ToJSON a) => ToBody JSON a where+  toBody p = GBody (contentType p) . RequestBodyLBS . encode++class (Accept c) => FromStream c a where+  fromStream ::+    Proxy c ->+    Stream ->+    ResourceT IO (Either (String, LBS.ByteString) a)++instance FromStream OctetStream Stream where+  fromStream Proxy = pure . Right++instance (FromJSON a) => FromStream JSON a where+  fromStream Proxy s = do+    bs <- sinkLBS s+    case eitherDecode bs of+      Left e -> pure $! Left (e, bs)+      Right x -> pure $! Right x++class GoogleRequest a where+  type Rs a :: Type+  type Scopes a :: [Symbol]++  requestClient :: a -> GClient (Rs a)++class GoogleClient fn where+  type Fn fn :: Type++  buildClient :: Proxy fn -> Request -> Fn fn++-- | Multiple path captures, with @[xs]@ forming @/<x1>/<x2>/<x2>/...@.+data Captures (s :: Symbol) a++-- | Form a Google style sub-resource, such as @/<capture>:<mode>@.+data CaptureMode (s :: Symbol) (m :: Symbol) a++data MultipartRelated (cs :: [Type]) m++instance+  ( ToBody c m,+    GoogleClient fn+  ) =>+  GoogleClient (MultipartRelated (c ': cs) m :> fn)+  where+  type Fn (MultipartRelated (c ': cs) m :> fn) = m -> GBody -> Fn fn++  buildClient Proxy rq m b =+    buildClient (Proxy :: Proxy fn) $+      setBody rq [toBody (Proxy :: Proxy c) m, b]++instance (GoogleClient fn) => GoogleClient (AltMedia :> fn) where+  type Fn (AltMedia :> fn) = GBody -> Fn fn++  buildClient Proxy rq b =+    buildClient (Proxy :: Proxy fn) $+      setBody rq [b]++instance (KnownSymbol s, GoogleClient fn) => GoogleClient (s :> fn) where+  type Fn (s :> fn) = Fn fn++  buildClient Proxy rq =+    buildClient (Proxy :: Proxy fn) $+      appendPath rq (buildSymbol (Proxy :: Proxy s))++instance (GoogleClient a, GoogleClient b) => GoogleClient (a :<|> b) where+  type Fn (a :<|> b) = Fn a :<|> Fn b++  buildClient Proxy rq =+    buildClient (Proxy :: Proxy a) rq+      :<|> buildClient (Proxy :: Proxy b) rq++instance+  ( KnownSymbol s,+    ToHttpApiData a,+    GoogleClient fn+  ) =>+  GoogleClient (Capture s a :> fn)+  where+  type Fn (Capture s a :> fn) = a -> Fn fn++  buildClient Proxy rq =+    buildClient (Proxy :: Proxy fn)+      . appendPath rq+      . buildText++instance+  ( KnownSymbol s,+    ToHttpApiData a,+    GoogleClient fn+  ) =>+  GoogleClient (Captures s a :> fn)+  where+  type Fn (Captures s a :> fn) = [a] -> Fn fn++  buildClient Proxy rq =+    buildClient (Proxy :: Proxy fn)+      . appendPaths rq++instance+  ( KnownSymbol s,+    KnownSymbol m,+    ToHttpApiData a,+    GoogleClient fn+  ) =>+  GoogleClient (CaptureMode s m a :> fn)+  where+  type Fn (CaptureMode s m a :> fn) = a -> Fn fn++  buildClient Proxy rq x =+    buildClient (Proxy :: Proxy fn)+      . appendPath rq+      $ buildText x <> ":" <> buildSymbol (Proxy :: Proxy m)++instance+  ( KnownSymbol s,+    ToHttpApiData a,+    GoogleClient fn+  ) =>+  GoogleClient (QueryParam s a :> fn)+  where+  type Fn (QueryParam s a :> fn) = Maybe a -> Fn fn++  buildClient Proxy rq mx = buildClient (Proxy :: Proxy fn) $+    case mx of+      Nothing -> rq+      Just x -> appendQuery rq k v+        where+          k = byteSymbol (Proxy :: Proxy s)+          v = Just (toQueryParam x)++instance+  ( KnownSymbol s,+    ToHttpApiData a,+    GoogleClient fn+  ) =>+  GoogleClient (QueryParams s a :> fn)+  where+  type Fn (QueryParams s a :> fn) = [a] -> Fn fn++  buildClient Proxy rq = buildClient (Proxy :: Proxy fn) . Foldable.foldl' go rq+    where+      go r = appendQuery r k . Just . toQueryParam++      k = byteSymbol (Proxy :: Proxy s)++instance+  ( KnownSymbol s,+    ToHttpApiData a,+    GoogleClient fn+  ) =>+  GoogleClient (Header s a :> fn)+  where+  type Fn (Header s a :> fn) = Maybe a -> Fn fn++  buildClient Proxy rq mx = buildClient (Proxy :: Proxy fn) $+    case mx of+      Nothing -> rq+      Just x -> appendHeader rq (CI.mk k) v+        where+          k = byteSymbol (Proxy :: Proxy s)+          v = Just (toQueryParam x)++instance+  ( ToBody c a,+    GoogleClient fn+  ) =>+  GoogleClient (ReqBody (c ': cs) a :> fn)+  where+  type Fn (ReqBody (c ': cs) a :> fn) = a -> Fn fn++  buildClient Proxy rq x =+    buildClient (Proxy :: Proxy fn) $+      setBody rq [toBody (Proxy :: Proxy c) x]++instance {-# OVERLAPPABLE #-} (FromStream c a) => GoogleClient (Get (c ': cs) a) where+  type Fn (Get (c ': cs) a) = ServiceConfig -> GClient a++  buildClient Proxy = mime (Proxy :: Proxy c) methodGet [200, 203]++instance {-# OVERLAPPING #-} GoogleClient (Get (c ': cs) ()) where+  type Fn (Get (c ': cs) ()) = ServiceConfig -> GClient ()++  buildClient Proxy = discard methodGet [204]++instance {-# OVERLAPPABLE #-} (FromStream c a, cs' ~ (c ': cs)) => GoogleClient (Post cs' a) where+  type Fn (Post cs' a) = ServiceConfig -> GClient a++  buildClient Proxy = mime (Proxy :: Proxy c) methodPost [200, 201]++instance {-# OVERLAPPING #-} GoogleClient (Post cs ()) where+  type Fn (Post cs ()) = ServiceConfig -> GClient ()++  buildClient Proxy = discard methodPost [204]++instance {-# OVERLAPPABLE #-} (FromStream c a) => GoogleClient (Put (c ': cs) a) where+  type Fn (Put (c ': cs) a) = ServiceConfig -> GClient a++  buildClient Proxy = mime (Proxy :: Proxy c) methodPut [200, 201]++instance {-# OVERLAPPING #-} GoogleClient (Put (c ': cs) ()) where+  type Fn (Put (c ': cs) ()) = ServiceConfig -> GClient ()++  buildClient Proxy = discard methodPut [204]++instance {-# OVERLAPPABLE #-} (FromStream c a) => GoogleClient (Patch (c ': cs) a) where+  type Fn (Patch (c ': cs) a) = ServiceConfig -> GClient a++  buildClient Proxy = mime (Proxy :: Proxy c) methodPatch [200, 201]++instance {-# OVERLAPPING #-} GoogleClient (Patch (c ': cs) ()) where+  type Fn (Patch (c ': cs) ()) = ServiceConfig -> GClient ()++  buildClient Proxy = discard methodPatch [204]++instance {-# OVERLAPPABLE #-} (FromStream c a) => GoogleClient (Delete (c ': cs) a) where+  type Fn (Delete (c ': cs) a) = ServiceConfig -> GClient a++  buildClient Proxy = mime (Proxy :: Proxy c) methodDelete [200, 202]++instance {-# OVERLAPPING #-} GoogleClient (Delete (c ': cs) ()) where+  type Fn (Delete (c ': cs) ()) = ServiceConfig -> GClient ()++  buildClient Proxy = discard methodDelete [204]++sinkLBS :: Stream -> ResourceT IO LBS.ByteString+sinkLBS = runConduit . (.| Conduit.sinkLazy)++buildText :: (ToHttpApiData a) => a -> Builder+buildText = Build.fromText . toQueryParam++buildSymbol :: forall n proxy. (KnownSymbol n) => proxy n -> Builder+buildSymbol = Build.fromString . symbolVal++byteSymbol :: forall n proxy. (KnownSymbol n) => proxy n -> ByteString+byteSymbol = BS8.pack . symbolVal++-- | An integral value representing seconds.+newtype Seconds = Seconds Int+  deriving+    ( Eq,+      Ord,+      Read,+      Show,+      Enum,+      Num,+      Bounded,+      Integral,+      Real,+      Generic+    )++seconds :: Seconds -> Int+seconds (Seconds n)+  | n < 0 = 0+  | otherwise = n++microseconds :: Seconds -> Int+microseconds = (1000000 *) . seconds++newtype FieldMask = FieldMask {fromFieldMask :: Text}+  deriving+    ( Eq,+      Ord,+      Show,+      Read,+      IsString,+      Generic,+      FromHttpApiData,+      ToHttpApiData,+      FromJSON,+      ToJSON+    )
− src/Network/Google/Data/Bytes.hs 
@@ -1,49 +0,0 @@-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- |--- Module      : Network.Google.Data.Bytes--- Copyright   : (c) 2013-2016 Brendan Hay--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.Google.Data.Bytes-    ( Bytes (..)-    , _Bytes-    ) where--import           Control.Lens             (Iso', iso)-import           Data.Aeson               (FromJSON (..), ToJSON (..))-import           Data.ByteString          (ByteString)-import           Data.Data                (Data, Typeable)-import           Data.Hashable-import qualified Data.Text.Encoding       as Text-import           GHC.Generics             (Generic)-import           Network.Google.Data.JSON (parseJSONText, toJSONText)-import           Web.HttpApiData          (FromHttpApiData (..),-                                           ToHttpApiData (..))--- | Binary data.------ This data is passed to/from the serialisation routines as-is, and any--- particular encoding or decoding (say, base64) is left up to the caller.-newtype Bytes = Bytes { unBytes :: ByteString }-    deriving (Eq, Show, Read, Ord, Data, Typeable, Generic)--instance Hashable Bytes--_Bytes :: Iso' Bytes ByteString-_Bytes = iso unBytes Bytes--instance ToHttpApiData Bytes where-    toQueryParam = Text.decodeUtf8 . unBytes-    toHeader     = unBytes--instance FromHttpApiData Bytes where-    parseQueryParam = pure . Bytes . Text.encodeUtf8-    parseHeader     = pure . Bytes--instance FromJSON Bytes where parseJSON = parseJSONText "Bytes"-instance ToJSON   Bytes where toJSON    = toJSONText
− src/Network/Google/Data/JSON.hs 
@@ -1,75 +0,0 @@-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables        #-}---- |--- Module      : Network.Google.Data.JSON--- Copyright   : (c) 2015-2016 Brendan Hay <brendan.g.hay@gmail.com>--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.Google.Data.JSON-    ( JSONValue-    , Textual  (..)-    , parseJSONObject-    , parseJSONText-    , toJSONText--    -- * Re-exports-    , FromJSON (..)-    , ToJSON   (..)--    , withObject-    , emptyObject-    , object--    , (.=)-    , (.:)-    , (.:?)-    , (.!=)-    ) where--import           Data.Aeson-import           Data.Aeson.Types-import           Data.Data-import           Data.HashMap.Strict (HashMap)-import           Data.Text           (Text)-import qualified Data.Text           as Text-import           Web.HttpApiData     (FromHttpApiData (..), ToHttpApiData (..))--type JSONValue = Value--newtype Textual a = Textual a-    deriving-        ( Eq-        , Ord-        , Read-        , Show-        , Num-        , Fractional-        , Data-        , Typeable-        , ToHttpApiData-        , FromHttpApiData-        )--instance (FromJSON a, FromHttpApiData a) => FromJSON (Textual a) where-    parseJSON (String s) =-        either (fail . Text.unpack) (pure . Textual) (parseQueryParam s)-    parseJSON o          = Textual <$> parseJSON o--instance ToHttpApiData a => ToJSON (Textual a) where-    toJSON (Textual x) = String (toQueryParam x)--parseJSONObject :: FromJSON a => HashMap Text Value -> Parser a-parseJSONObject = parseJSON . Object--parseJSONText :: FromHttpApiData a => String -> Value -> Parser a-parseJSONText n = withText n (either (fail . f) pure . parseQueryParam)-  where-    f x = n ++ " - " ++ Text.unpack x--toJSONText :: ToHttpApiData a => a -> Value-toJSONText = String . toQueryParam
− src/Network/Google/Data/Numeric.hs 
@@ -1,62 +0,0 @@-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE ScopedTypeVariables        #-}---- |--- Module      : Network.Google.Data.Numeric--- Copyright   : (c) 2015-2016 Brendan Hay <brendan.g.hay@gmail.com>--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.Google.Data.Numeric-    ( Nat (..)-    ) where--import           Control.Monad-import           Data.Aeson-import           Data.Data-import           Data.Monoid                ((<>))-import           Data.Scientific-import           Data.Text                  (Text)-import qualified Data.Text                  as Text-import qualified Data.Text.Lazy             as LText-import           Data.Text.Lazy.Builder     (Builder)-import qualified Data.Text.Lazy.Builder     as Build-import qualified Data.Text.Lazy.Builder.Int as Build-import qualified Data.Text.Read             as Read-import           Numeric.Natural-import           Servant.API--newtype Nat = Nat { unNat :: Natural }-    deriving (Eq, Ord, Enum, Show, Read, Num, Real, Integral, Data, Typeable)--instance FromJSON Nat where-    parseJSON = parseJSON >=> go-      where-        go n = case floatingOrInteger n of-            Left  (_ :: Double) -> fail (floatErr n)-            Right i-                | n < 0         -> fail (negateErr n)-                | otherwise     -> return . Nat $ fromInteger i--        floatErr  = mappend "Cannot convert float to Natural: " . show-        negateErr = mappend "Cannot convert negative number to Natural: " . show--instance ToJSON Nat where-    toJSON = Number . flip scientific 0 . toInteger . unNat--instance ToHttpApiData Nat where-    toQueryParam = shortText . Build.decimal--instance FromHttpApiData Nat where-    parseQueryParam t =-        case Read.decimal t of-            Right (x, r) | Text.null r-                -> Right x-            _   -> Left ("Unable to parse natural from: " <> t)--shortText :: Builder -> Text-shortText = LText.toStrict . Build.toLazyTextWith 32
− src/Network/Google/Data/Time.hs 
@@ -1,152 +0,0 @@-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- |--- Module      : Network.Google.Data.Time--- Copyright   : (c) 2015-2016 Brendan Hay <brendan.g.hay@gmail.com>--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.Google.Data.Time-    ( Time'-    , Date'-    , DateTime'-    , Duration--    , _Time-    , _Date-    , _DateTime-    , _Duration-    ) where--import           Data.Monoid                      ((<>))-import           Control.Lens-import           Data.Aeson-import qualified Data.Aeson.Types                  as Aeson-import           Data.Attoparsec.Text-import           Data.Bifunctor                    (first, second)-import           Data.Bits                         ((.&.))-import           Data.Char                         (ord)-import           Data.Data                         (Data, Typeable)-import           Data.Scientific                   (Scientific)-import qualified Data.Scientific                   as Sci-import           Data.Text                         (Text)-import qualified Data.Text                         as Text-import qualified Data.Text.Lazy                    as LText-import qualified Data.Text.Lazy.Builder            as Build-import qualified Data.Text.Lazy.Builder.Scientific as Sci-import           Data.Time-import           GHC.Generics-import           Web.HttpApiData                   (FromHttpApiData (..),-                                                    ToHttpApiData (..))---- | This SHOULD be a time in the format of hh:mm:ss.  It is--- recommended that you use the "date-time" format instead of "time"--- unless you need to transfer only the time part.-newtype Time' = Time' { unTime :: TimeOfDay }-    deriving (Eq, Ord, Show, Read, Generic, Data, Typeable)--_Time :: Iso' Time' TimeOfDay-_Time = iso unTime Time'--instance ToHttpApiData Time' where-    toQueryParam = Text.pack . show . unTime--instance FromHttpApiData Time' where-    parseQueryParam = second Time' . parseText timeParser---- | This SHOULD be a date in the format of YYYY-MM-DD.  It is--- recommended that you use the "date-time" format instead of "date"--- unless you need to transfer only the date part.-newtype Date' = Date' { unDate :: Day }-    deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, ToHttpApiData, FromHttpApiData)--_Date :: Iso' Date' Day-_Date = iso unDate Date'---- | This SHOULD be a date in ISO 8601 format of YYYY-MM---- DDThh:mm:ssZ in UTC time. This is the recommended form of date/timestamp.-newtype DateTime' = DateTime' { unDateTime :: UTCTime }-    deriving (Eq, Ord, Show, Read, Generic, Data, Typeable, ToHttpApiData, FromHttpApiData)--_DateTime :: Iso' DateTime' UTCTime-_DateTime = iso unDateTime DateTime'---- | A duration in seconds with up to nine fractional digits, terminated by 's'.------ /Example/: @"3.5s"@.-newtype Duration = Duration { unDuration :: Scientific }-    deriving (Eq, Ord, Show, Read, Generic, Data, Typeable)--_Duration :: Iso' Duration Scientific-_Duration = iso unDuration Duration--instance ToHttpApiData Duration where-    toQueryParam =-          LText.toStrict-        . (\seconds -> Build.toLazyText seconds <> "s")-        . Sci.formatScientificBuilder Sci.Fixed (Just 9)-        . unDuration--instance FromHttpApiData Duration where-    parseQueryParam = second Duration . parseText durationParser--instance ToJSON Time'     where toJSON = String . toQueryParam-instance ToJSON Date'     where toJSON = String . toQueryParam-instance ToJSON DateTime' where toJSON = toJSON . unDateTime-instance ToJSON Duration  where toJSON = String . toQueryParam--instance FromJSON Time' where-    parseJSON = fmap Time' . withText "time" (run timeParser)--instance FromJSON Date' where-    parseJSON = fmap Date' . withText "date" (run dayParser)--instance FromJSON DateTime' where-    parseJSON = fmap DateTime' . parseJSON--instance FromJSON Duration where-    parseJSON = fmap Duration . withText "duration" (run durationParser)--parseText :: Parser a -> Text -> Either Text a-parseText p = first Text.pack . parseOnly p---- | Parse a time of the form @HH:MM:SS@.-timeParser :: Parser TimeOfDay-timeParser = do-    h <- twoDigits <* char ':'-    m <- twoDigits <* char ':'-    s <- twoDigits <&> fromIntegral-    if h < 24 && m < 60 && s < 61-        then pure (TimeOfDay h m s)-        else fail "invalid time"---- | Parse a date of the form @YYYY-MM-DD@.-dayParser :: Parser Day-dayParser = do-    y <- decimal   <* char '-'-    m <- twoDigits <* char '-'-    d <- twoDigits-    maybe (fail "invalid date") pure (fromGregorianValid y m d)--durationParser :: Parser Scientific-durationParser = Sci.fromFloatDigits <$> (double <* char 's')---- | Parse a two-digit integer (e.g. day of month, hour).-twoDigits :: Parser Int-twoDigits = do-    a <- digit-    b <- digit-    let c2d c = ord c .&. 15-    pure $! c2d a * 10 + c2d b---- | Run an attoparsec parser as an aeson parser.-run :: Parser a -> Text -> Aeson.Parser a-run p t =-    case parseOnly (p <* endOfInput) t of-        Left err -> fail $ "could not parse date: " ++ err-        Right r  -> pure r
− src/Network/Google/Prelude.hs 
@@ -1,38 +0,0 @@--- |--- Module      : Network.Google.Prelude--- Copyright   : (c) 2015-2016 Brendan Hay <brendan.g.hay@gmail.com>--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.Google.Prelude-    ( module Export-    ) where--import Control.Lens        as Export (Lens', lens, mapping, ( # ), (^.), _Just)-import Data.ByteString     as Export (ByteString)-import Data.Data           as Export (Data, Typeable)-import Data.Hashable       as Export (Hashable, hashWithSalt)-import Data.HashMap.Strict as Export (HashMap)-import Data.Int            as Export (Int32, Int64)-import Data.Maybe          as Export-import Data.Monoid         as Export (mempty, (<>))-import Data.Proxy          as Export-import Data.Scientific     as Export (Scientific)-import Data.Text           as Export (Text)-import Data.Time           as Export (Day, TimeOfDay, UTCTime)-import Data.Word           as Export (Word32, Word64, Word8)-import GHC.Generics        as Export (Generic)-import Network.HTTP.Client as Export (RequestBody)-import Numeric.Natural     as Export (Natural)-import Prelude             as Export hiding (product)-import Servant.API         as Export hiding (Headers, Link, getResponse)-import Servant.Utils.Links as Export hiding (Link)-import Web.HttpApiData     as Export (FromHttpApiData (..), ToHttpApiData (..))--import Network.Google.Data.Bytes   as Export-import Network.Google.Data.JSON    as Export-import Network.Google.Data.Numeric as Export-import Network.Google.Data.Time    as Export-import Network.Google.Types        as Export
− src/Network/Google/Types.hs 
@@ -1,653 +0,0 @@-{-# LANGUAGE DataKinds                  #-}-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures             #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE TupleSections              #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE UndecidableInstances       #-}---- |--- Module      : Network.Google.Types--- Copyright   : (c) 2015-2016 Brendan Hay <brendan.g.hay@gmail.com>--- License     : Mozilla Public License, v. 2.0.--- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>--- Stability   : provisional--- Portability : non-portable (GHC extensions)----module Network.Google.Types where--import           Control.Applicative-import           Control.Exception.Lens       (exception)-import           Control.Lens-import           Control.Monad.Catch-import           Control.Monad.Trans.Resource-import           Data.Aeson-import           Data.ByteString              (ByteString)-import qualified Data.ByteString.Char8        as BS8-import qualified Data.ByteString.Lazy         as LBS-import qualified Data.CaseInsensitive         as CI-import           Data.Coerce-import           Data.Conduit-import qualified Data.Conduit.List            as CL-import           Data.Data-import           Data.DList                   (DList)-import qualified Data.DList                   as DList-import           Data.Foldable                (foldMap, foldl')-import           Data.Monoid-import           Data.String-import           Data.Text                    (Text)-import qualified Data.Text.Encoding           as Text-import           Data.Text.Lazy.Builder       (Builder)-import qualified Data.Text.Lazy.Builder       as Build-import           GHC.Generics-import           GHC.TypeLits-import           Network.HTTP.Client          (HttpException, RequestBody (..))-import           Network.HTTP.Media           hiding (Accept)-import           Network.HTTP.Types           hiding (Header)-import qualified Network.HTTP.Types           as HTTP-import           Servant.API-import           Web.HttpApiData--data AltJSON   = AltJSON   deriving (Eq, Ord, Show, Read, Generic, Typeable)-data AltMedia  = AltMedia  deriving (Eq, Ord, Show, Read, Generic, Typeable)-data Multipart = Multipart deriving (Eq, Ord, Show, Read, Generic, Typeable)--instance ToHttpApiData AltJSON   where toQueryParam = const "json"-instance ToHttpApiData AltMedia  where toQueryParam = const "media"-instance ToHttpApiData Multipart where toQueryParam = const "multipart"---- | An OAuth2 scope.-newtype OAuthScope = OAuthScope Text-    deriving-        ( Eq-        , Ord-        , Show-        , Read-        , IsString-        , Generic-        , Typeable-        , FromHttpApiData-        , ToHttpApiData-        , FromJSON-        , ToJSON-        )---- | An OAuth2 access token.-newtype AccessToken = AccessToken Text-    deriving-        ( Eq-        , Ord-        , Show-        , Read-        , IsString-        , Generic-        , Typeable-        , FromHttpApiData-        , ToHttpApiData-        , FromJSON-        , ToJSON-        )---- | An OAuth2 refresh token.-newtype RefreshToken = RefreshToken Text-    deriving-        ( Eq-        , Ord-        , Show-        , Read-        , IsString-        , Generic-        , Typeable-        , FromHttpApiData-        , ToHttpApiData-        , FromJSON-        , ToJSON-        )---- | A client identifier.-newtype ClientId = ClientId Text-    deriving-        ( Eq-        , Ord-        , Show-        , Read-        , IsString-        , Generic-        , Typeable-        , FromHttpApiData-        , ToHttpApiData-        , FromJSON-        , ToJSON-        )---- | A service identifier.-newtype ServiceId = ServiceId Text-    deriving-        ( Eq-        , Ord-        , Show-        , Read-        , IsString-        , Generic-        , Typeable-        , FromHttpApiData-        , ToHttpApiData-        , FromJSON-        , ToJSON-        )---- | An opaque client secret.-newtype Secret = Secret Text-    deriving-        ( Eq-        , Ord-        , Read-        , IsString-        , Generic-        , Typeable-        , FromHttpApiData-        , ToHttpApiData-        , FromJSON-        , ToJSON-        )--instance Show Secret where-    show = const "*****"--newtype MediaDownload a = MediaDownload a-data    MediaUpload   a = MediaUpload   a Body--_Coerce :: (Coercible a b, Coercible b a) => Iso' a b-_Coerce = iso coerce coerce---- | Invalid Iso, exists for ease of composition with the current 'Lens . Iso'--- chaining to hide internal types from the user.-_Default :: Monoid a => Iso' (Maybe a) a-_Default = iso f Just-  where-    f (Just x) = x-    f Nothing  = mempty--type Stream = ResumableSource (ResourceT IO) ByteString--data Error-    = TransportError HttpException-    | SerializeError SerializeError-    | ServiceError   ServiceError-      deriving (Show, Typeable)--instance Exception Error--data SerializeError = SerializeError'-    { _serializeId      :: !ServiceId-    , _serializeHeaders :: [HTTP.Header]-    , _serializeStatus  :: !Status-    , _serializeMessage :: !String-    , _serializeBody    :: !(Maybe LBS.ByteString)-    } deriving (Eq, Show, Typeable)--data ServiceError = ServiceError'-    { _serviceId      :: !ServiceId-    , _serviceStatus  :: !Status-    , _serviceHeaders :: ![HTTP.Header]-    , _serviceBody    :: !(Maybe LBS.ByteString)-    } deriving (Eq, Show, Typeable)--class AsError a where-    -- | A general Amazonka error.-    _Error          :: Prism' a Error-    {-# MINIMAL _Error #-}--    -- | An error occured while communicating over HTTP with a remote service.-    _TransportError :: Prism' a HttpException--    -- | A serialisation error occured when attempting to deserialise a response.-    _SerializeError :: Prism' a SerializeError--    -- | A service specific error returned by the remote service.-    _ServiceError   :: Prism' a ServiceError--    _TransportError = _Error . _TransportError-    _SerializeError = _Error . _SerializeError-    _ServiceError   = _Error . _ServiceError--instance AsError SomeException where-    _Error = exception--instance AsError Error where-    _Error = id--    _TransportError = prism TransportError $ \case-        TransportError e -> Right e-        x                -> Left x--    _SerializeError = prism SerializeError $ \case-        SerializeError e -> Right e-        x                -> Left  x--    _ServiceError = prism ServiceError $ \case-        ServiceError e -> Right e-        x              -> Left  x--data ServiceConfig = ServiceConfig-    { _svcId      :: !ServiceId-    , _svcHost    :: !ByteString-    , _svcPath    :: !Builder-    , _svcPort    :: !Int-    , _svcSecure  :: !Bool-    , _svcTimeout :: !(Maybe Seconds)-    }--defaultService :: ServiceId -> ByteString -> ServiceConfig-defaultService i h = ServiceConfig-    { _svcId      = i-    , _svcHost    = h-    , _svcPath    = mempty-    , _svcPort    = 443-    , _svcSecure  = True-    , _svcTimeout = Just 70-    }---- | The remote host name, used for both the IP address to connect to and the--- host request header.-serviceHost :: Lens' ServiceConfig ByteString-serviceHost = lens _svcHost (\s a -> s { _svcHost = a })---- | The remote port to connect to.------ Defaults to @443@.-servicePort :: Lens' ServiceConfig Int-servicePort = lens _svcPort (\s a -> s { _svcPort = a })---- | A path prefix that is prepended to any sent HTTP request.------ Defaults to @mempty@.-servicePath :: Lens' ServiceConfig Builder-servicePath = lens _svcPath (\s a -> s { _svcPath = a })---- | Whether to use HTTPS/SSL.------ Defaults to @True@.-serviceSecure :: Lens' ServiceConfig Bool-serviceSecure = lens _svcSecure (\s a -> s { _svcSecure = a })---- | Number of seconds to wait for a response.-serviceTimeout :: Lens' ServiceConfig (Maybe Seconds)-serviceTimeout = lens _svcTimeout (\s a -> s { _svcTimeout = a })---- | A single part of a (potentially multipart) request body.------ /Note:/ The 'IsString' instance defaults to a @text/plain@ MIME type.-data Body = Body !MediaType !RequestBody--instance IsString Body where-    fromString = Body ("text" // "plain") . fromString---- | A lens into the 'MediaType' of a request 'Body'.-bodyContentType :: Lens' Body MediaType-bodyContentType = lens (\(Body m _) -> m) (\(Body _ b) m -> Body m b)---- | An intermediary request builder.-data Request = Request-    { _rqPath    :: !Builder-    , _rqQuery   :: !(DList (ByteString, Maybe ByteString))-    , _rqHeaders :: !(DList (HeaderName, ByteString))-    , _rqBody    :: ![Body]-    }--instance Monoid Request where-    mempty      = Request mempty mempty mempty mempty-    mappend a b = Request-        (_rqPath    a <> "/" <> _rqPath b)-        (_rqQuery   a <> _rqQuery b)-        (_rqHeaders a <> _rqHeaders b)-        (_rqBody    b <> _rqBody a)--appendPath :: Request -> Builder -> Request-appendPath rq x = rq { _rqPath = _rqPath rq <> "/" <> x }--appendPaths :: ToHttpApiData a => Request -> [a] -> Request-appendPaths rq = appendPath rq . foldMap (mappend "/" . buildText)--appendQuery :: Request -> ByteString -> Maybe Text -> Request-appendQuery rq k v = rq-    { _rqQuery = DList.snoc (_rqQuery rq) (k, Text.encodeUtf8 <$> v)-    }--appendHeader :: Request -> HeaderName -> Maybe Text -> Request-appendHeader rq _ Nothing  = rq-appendHeader rq k (Just v) = rq-    { _rqHeaders = DList.snoc (_rqHeaders rq) (k, Text.encodeUtf8 v)-    }--setBody :: Request -> [Body] -> Request-setBody rq bs = rq { _rqBody = bs }---- | A materialised 'http-client' request and associated response parser.-data Client a = Client-    { _cliAccept   :: !(Maybe MediaType)-    , _cliMethod   :: !Method-    , _cliCheck    :: !(Status -> Bool)-    , _cliService  :: !ServiceConfig-    , _cliRequest  :: !Request-    , _cliResponse :: !(Stream -> ResourceT IO (Either (String, LBS.ByteString) a))-    }--clientService :: Lens' (Client a) ServiceConfig-clientService = lens _cliService (\s a -> s { _cliService = a })--mime :: FromStream c a-     => Proxy c-     -> Method-     -> [Int]-     -> Request-     -> ServiceConfig-     -> Client a-mime p = client (fromStream p) (Just (contentType p))--discard :: Method-        -> [Int]-        -> Request-        -> ServiceConfig-        -> Client ()-discard = client (\b -> closeResumableSource b >> pure (Right ())) Nothing--client :: (Stream -> ResourceT IO (Either (String, LBS.ByteString) a))-       -> Maybe MediaType-       -> Method-       -> [Int]-       -> Request-       -> ServiceConfig-       -> Client a-client f cs m ns rq s = Client-    { _cliAccept   = cs-    , _cliMethod   = m-    , _cliCheck    = (`elem` ns) . fromEnum-    , _cliService  = s-    , _cliRequest  = rq-    , _cliResponse = f-    }--class Accept c => ToBody c a where-    toBody :: Proxy c -> a -> Body--instance ToBody OctetStream ByteString where-    toBody p = Body (contentType p) . RequestBodyBS--instance ToBody OctetStream LBS.ByteString where-    toBody p = Body (contentType p) . RequestBodyLBS--instance ToBody PlainText ByteString where-    toBody p = Body (contentType p) . RequestBodyBS--instance ToBody PlainText LBS.ByteString where-    toBody p = Body (contentType p) . RequestBodyLBS--instance ToJSON a => ToBody JSON a where-    toBody p = Body (contentType p) . RequestBodyLBS . encode--class Accept c => FromStream c a where-    fromStream :: Proxy c-               -> Stream-               -> ResourceT IO (Either (String, LBS.ByteString) a)--instance FromStream OctetStream Stream where-    fromStream Proxy = pure . Right--instance FromJSON a => FromStream JSON a where-    fromStream Proxy  s = do-        bs <- sinkLBS s-        case eitherDecode bs of-            Left  e -> pure $! Left (e, bs)-            Right x -> pure $! Right x--class GoogleRequest a where-    type Rs     a :: *-    type Scopes a :: [Symbol]--    requestClient :: a -> Client (Rs a)--class GoogleClient fn where-    type Fn fn :: *--    buildClient :: Proxy fn -> Request -> Fn fn---- | Multiple path captures, with @[xs]@ forming @/<x1>/<x2>/<x2>/...@.-data Captures (s :: Symbol) a-    deriving (Typeable)---- | Form a Google style sub-resource, such as @/<capture>:<mode>@.-data CaptureMode (s :: Symbol) (m :: Symbol) a-    deriving (Typeable)--data MultipartRelated (cs :: [*]) m-    deriving (Typeable)--instance ( ToBody c m-         , GoogleClient fn-         ) => GoogleClient (MultipartRelated (c ': cs) m :> fn) where-    type Fn (MultipartRelated (c ': cs) m :> fn) = m -> Body -> Fn fn--    buildClient Proxy rq m b =-        buildClient (Proxy :: Proxy fn) $-           setBody rq [toBody (Proxy :: Proxy c) m, b]--instance GoogleClient fn => GoogleClient (AltMedia :> fn) where-    type Fn (AltMedia :> fn) = Body -> Fn fn--    buildClient Proxy rq b =-        buildClient (Proxy :: Proxy fn) $-           setBody rq [b]--instance (KnownSymbol s, GoogleClient fn) => GoogleClient (s :> fn) where-    type Fn (s :> fn) = Fn fn--    buildClient Proxy rq = buildClient (Proxy :: Proxy fn) $-        appendPath rq (buildSymbol (Proxy :: Proxy s))--instance (GoogleClient a, GoogleClient b) => GoogleClient (a :<|> b) where-    type Fn (a :<|> b) = Fn a :<|> Fn b--    buildClient Proxy rq =-             buildClient (Proxy :: Proxy a) rq-        :<|> buildClient (Proxy :: Proxy b) rq--instance ( KnownSymbol   s-         , ToHttpApiData a-         , GoogleClient  fn-         ) => GoogleClient (Capture s a :> fn) where-    type Fn (Capture s a :> fn) = a -> Fn fn--    buildClient Proxy rq = buildClient (Proxy :: Proxy fn)-        . appendPath rq-        . buildText--instance ( KnownSymbol   s-         , ToHttpApiData a-         , GoogleClient  fn-         ) => GoogleClient (Captures s a :> fn) where-    type Fn (Captures s a :> fn) = [a] -> Fn fn--    buildClient Proxy rq = buildClient (Proxy :: Proxy fn)-        . appendPaths rq--instance ( KnownSymbol   s-         , KnownSymbol   m-         , ToHttpApiData a-         , GoogleClient  fn-         ) => GoogleClient (CaptureMode s m a :> fn) where-    type Fn (CaptureMode s m a :> fn) = a -> Fn fn--    buildClient Proxy rq x = buildClient (Proxy :: Proxy fn)-        . appendPath rq-        $ buildText x <> ":" <> buildSymbol (Proxy :: Proxy m)--instance ( KnownSymbol   s-         , ToHttpApiData a-         , GoogleClient  fn-         ) => GoogleClient (QueryParam s a :> fn) where-    type Fn (QueryParam s a :> fn) = Maybe a -> Fn fn--    buildClient Proxy rq mx = buildClient (Proxy :: Proxy fn) $-        case mx of-            Nothing -> rq-            Just x  -> appendQuery rq k v-              where-                k = byteSymbol (Proxy :: Proxy s)-                v = Just (toQueryParam x)--instance ( KnownSymbol   s-         , ToHttpApiData a-         , GoogleClient  fn-         ) => GoogleClient (QueryParams s a :> fn) where-    type Fn (QueryParams s a :> fn) = [a] -> Fn fn--    buildClient Proxy rq = buildClient (Proxy :: Proxy fn) . foldl' go rq-      where-        go r = appendQuery r k . Just . toQueryParam--        k = byteSymbol (Proxy :: Proxy s)--instance ( KnownSymbol   s-         , ToHttpApiData a-         , GoogleClient  fn-         ) => GoogleClient (Header s a :> fn) where-    type Fn (Header s a :> fn) = Maybe a -> Fn fn--    buildClient Proxy rq mx = buildClient (Proxy :: Proxy fn) $-        case mx of-            Nothing -> rq-            Just x  -> appendHeader rq (CI.mk k) v-              where-                k = byteSymbol (Proxy :: Proxy s)-                v = Just (toQueryParam x)--instance ( ToBody c a-         , GoogleClient fn-         ) => GoogleClient (ReqBody (c ': cs) a :> fn) where-    type Fn (ReqBody (c ': cs) a :> fn) = a -> Fn fn--    buildClient Proxy rq x =-        buildClient (Proxy :: Proxy fn) $-            setBody rq [toBody (Proxy :: Proxy c) x]--instance {-# OVERLAPPABLE #-}-  FromStream c a => GoogleClient (Get (c ': cs) a) where-    type Fn (Get (c ': cs) a) = ServiceConfig -> Client a--    buildClient Proxy = mime (Proxy :: Proxy c) methodGet [200, 203]--instance {-# OVERLAPPING #-}-  GoogleClient (Get (c ': cs) ()) where-    type Fn (Get (c ': cs) ()) = ServiceConfig -> Client ()--    buildClient Proxy = discard methodGet [204]--instance {-# OVERLAPPABLE #-}-  (FromStream c a, cs' ~ (c ': cs)) => GoogleClient (Post cs' a) where-    type Fn (Post cs' a) = ServiceConfig -> Client a--    buildClient Proxy = mime (Proxy :: Proxy c) methodPost [200, 201]--instance {-# OVERLAPPING #-}-  GoogleClient (Post cs ()) where-    type Fn (Post cs ()) = ServiceConfig -> Client ()--    buildClient Proxy = discard methodPost [204]--instance {-# OVERLAPPABLE #-}-  FromStream c a => GoogleClient (Put (c ': cs) a) where-    type Fn (Put (c ': cs) a) = ServiceConfig -> Client a--    buildClient Proxy = mime (Proxy :: Proxy c) methodPut [200, 201]--instance {-# OVERLAPPING #-}-  GoogleClient (Put (c ': cs) ()) where-    type Fn (Put (c ': cs) ()) = ServiceConfig -> Client ()--    buildClient Proxy = discard methodPut [204]--instance {-# OVERLAPPABLE #-}-  FromStream c a => GoogleClient (Patch (c ': cs) a) where-    type Fn (Patch (c ': cs) a) = ServiceConfig -> Client a--    buildClient Proxy = mime (Proxy :: Proxy c) methodPatch [200, 201]--instance {-# OVERLAPPING #-}-  GoogleClient (Patch (c ': cs) ()) where-    type Fn (Patch (c ': cs) ()) = ServiceConfig -> Client ()--    buildClient Proxy = discard methodPatch [204]--instance {-# OVERLAPPABLE #-}-  FromStream c a => GoogleClient (Delete (c ': cs) a) where-    type Fn (Delete (c ': cs) a) = ServiceConfig -> Client a--    buildClient Proxy = mime (Proxy :: Proxy c) methodDelete [200, 202]--instance {-# OVERLAPPING #-}-  GoogleClient (Delete (c ': cs) ()) where-    type Fn (Delete (c ': cs) ()) = ServiceConfig -> Client ()--    buildClient Proxy = discard methodDelete [204]--sinkLBS :: Stream -> ResourceT IO LBS.ByteString-sinkLBS = fmap LBS.fromChunks . ($$+- CL.consume)--buildText :: ToHttpApiData a => a -> Builder-buildText = Build.fromText . toQueryParam--buildSymbol :: forall n proxy. KnownSymbol n => proxy n -> Builder-buildSymbol = Build.fromString . symbolVal--byteSymbol :: forall n proxy. KnownSymbol n => proxy n -> ByteString-byteSymbol = BS8.pack . symbolVal---- | An integral value representing seconds.-newtype Seconds = Seconds Int-    deriving-        ( Eq-        , Ord-        , Read-        , Show-        , Enum-        , Num-        , Bounded-        , Integral-        , Real-        , Data-        , Typeable-        , Generic-        )--seconds :: Seconds -> Int-seconds (Seconds n)-    | n < 0     = 0-    | otherwise = n--microseconds :: Seconds -> Int-microseconds =  (1000000 *) . seconds--newtype FieldMask = FieldMask Text-    deriving-        ( Eq-        , Ord-        , Show-        , Read-        , IsString-        , Generic-        , Data-        , Typeable-        , FromHttpApiData-        , ToHttpApiData-        , FromJSON-        , ToJSON-        )
test/Main.hs view
@@ -1,5 +1,5 @@ -- Module      : Main--- Copyright   : (c) 2015-2016 Brendan Hay+-- Copyright   : (c) 2015-2022 Brendan Hay -- License     : Mozilla Public License, v. 2.0. -- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com> -- Stability   : experimental@@ -7,10 +7,11 @@  module Main (main) where -import           Test.Tasty+import Test.Tasty  main :: IO ()-main = defaultMain $-    testGroup "gogol"-        [-        ]+main =+  defaultMain $+    testGroup+      "gogol"+      []