Merge pull request #58 from brendanhay/feature/base64-invalid-encoding

Invalid Base64 De/serialisation

core/gogol-core.cabal

@@ -36,7 +36,7 @@ library
     ghc-options:       -Wall
 
     exposed-modules:
-          Network.Google.Data.Base64
+          Network.Google.Data.Bytes
         , Network.Google.Data.JSON
         , Network.Google.Data.Numeric
         , Network.Google.Data.Time
@@ -59,7 +59,6 @@ library
         , http-media           >= 0.6
         , http-types           >= 0.8.6
         , lens                 >= 4.4
-        , memory               >= 0.8
         , resourcet            >= 1.1
         , scientific           >= 0.3
         , servant              >= 0.4.4

core/src/Network/Google/Data/Bytes.hs

@@ -0,0 +1,49 @@
+{-# 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 <[email protected]>
+-- 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

core/src/Network/Google/Prelude.hs

@@ -31,7 +31,7 @@ import Servant.API         as Export hiding (Headers, getResponse)
 import Servant.Utils.Links as Export hiding (Link)
 import Web.HttpApiData     as Export (FromHttpApiData (..), ToHttpApiData (..))
 
-import Network.Google.Data.Base64  as Export
+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

gen/.ghci

@@ -0,0 +1,3 @@
+:set -XOverloadedStrings
+
+:set prompt "> "

gen/gogol-gen.cabal

@@ -44,7 +44,7 @@ executable gogol-gen
     ghc-options:       -Wall -threaded
 
     build-depends:
-          aeson
+          aeson            >= 1
         , attoparsec
         , base             >= 4.8
         , bifunctors
@@ -55,8 +55,8 @@ executable gogol-gen
         , errors           >= 2.1.2
         , formatting
         , hashable
-        , haskell-src-exts >= 1.17.1
-        , hindent
+        , haskell-src-exts == 1.17.1
+        , hindent           < 5
         , lens
         , mtl
         , optparse-applicative

gen/src/Gen/Orphans.hs

@@ -11,24 +11,13 @@
 
 module Gen.Orphans where
 
-import           Data.Aeson
-import           Data.Bifunctor
 import           Data.Hashable
-import qualified Data.HashMap.Strict          as Map
 import           Data.String
-import qualified Data.Text                    as Text
 import           Language.Haskell.Exts.Build
-import           Language.Haskell.Exts.Pretty
 import           Language.Haskell.Exts.Syntax
 
 instance Hashable Name
 
 instance IsString Name  where fromString = name
 instance IsString QName where fromString = UnQual . name
 instance IsString QOp   where fromString = op . sym
-
-instance ToJSON a => ToJSON (Map.HashMap Name a) where
-    toJSON = toJSON
-        . Map.fromList
-        . map (first (Text.pack . prettyPrint))
-        . Map.toList

gen/src/Gen/Syntax.hs

@@ -588,7 +588,7 @@ internalLit = \case
     Nat       -> TyApp (TyCon "Textual") (TyCon "Nat")
     Float     -> TyApp (TyCon "Textual") (TyCon "Double")
     Double    -> TyApp (TyCon "Textual") (TyCon "Double")
-    Byte      -> TyCon "Base64"
+    Byte      -> TyCon "Bytes"
     UInt32    -> TyApp (TyCon "Textual") (TyCon "Word32")
     UInt64    -> TyApp (TyCon "Textual") (TyCon "Word64")
     Int32     -> TyApp (TyCon "Textual") (TyCon "Int32")
@@ -622,7 +622,7 @@ iso = \case
     TLit Duration -> Just (var "_Duration")
     TLit Float    -> Just (var "_Coerce")
     TLit Double   -> Just (var "_Coerce")
-    TLit Byte     -> Just (var "_Base64")
+    TLit Byte     -> Just (var "_Bytes")
     TLit UInt32   -> Just (var "_Coerce")
     TLit UInt64   -> Just (var "_Coerce")
     TLit Int32    -> Just (var "_Coerce")

gen/src/Gen/Types/Data.hs

@@ -31,7 +31,6 @@ import           Data.Text                    (Text)
 import qualified Data.Text                    as Text
 import qualified Data.Text.Lazy               as LText
 import           Data.Text.Manipulate
-import           Gen.Orphans                  ()
 import           Gen.Types.Help
 import           Gen.Types.Id
 import           Gen.Types.NS

gen/src/Gen/Types/Id.hs

@@ -58,12 +58,10 @@ import           Control.Applicative
 import           Control.Monad
 import           Data.Aeson                   hiding (Bool, String)
 import qualified Data.Attoparsec.Text         as A
-import           Data.Bifunctor               (first)
 import qualified Data.CaseInsensitive         as CI
 import           Data.Foldable                (foldl')
 import           Data.Function                (on)
 import           Data.Hashable
-import qualified Data.HashMap.Strict          as Map
 import           Data.List                    (intersperse)
 import           Data.List                    (elemIndex, nub, sortOn)
 import           Data.Semigroup               hiding (Sum)
@@ -73,9 +71,7 @@ import qualified Data.Text                    as Text
 import qualified Data.Text.Lazy.Builder       as Build
 import           Data.Text.Manipulate
 import           Formatting
-import           Gen.Orphans                  ()
 import           Gen.Text
-import           Gen.Types.Map
 import           GHC.Generics                 (Generic)
 import           Language.Haskell.Exts.Build
 import           Language.Haskell.Exts.Syntax (Exp, Name (..))
@@ -164,22 +160,28 @@ instance IsString Global where
 instance FromJSON Global where
     parseJSON = withText "global" (pure . mkGlobal)
 
+instance FromJSONKey Global where
+    fromJSONKey = FromJSONKeyText mkGlobal
+
 instance ToJSON Global where
     toJSON = toJSON . global
 
-instance FromJSON v => FromJSON (Map Global v) where
-    parseJSON = fmap (Map.fromList . map (first mkGlobal) . Map.toList)
-        . parseJSON
-
 gid :: Format a (Global -> a)
 gid = later (Build.fromText . global)
 
 newtype Local = Local { local :: Text }
-    deriving (Eq, Ord, Show, Generic, Hashable, FromJSON, ToJSON, IsString)
-
-instance FromJSON v => FromJSON (Map Local v) where
-    parseJSON = fmap (Map.fromList . map (first Local) . Map.toList)
-        . parseJSON
+    deriving
+        ( Eq
+        , Ord
+        , Show
+        , Generic
+        , Hashable
+        , FromJSON
+        , ToJSON
+        , FromJSONKey
+        , ToJSONKey
+        , IsString
+        )
 
 lid :: Format a (Local -> a)
 lid = later (Build.fromText . local)

gen/src/Gen/Types/Schema.hs

@@ -38,7 +38,6 @@ import           Data.Semigroup       ((<>))
 import           Data.Text            (Text)
 import qualified Data.Text            as Text
 import           Data.Text.Manipulate
-import           Gen.Orphans          ()
 import           Gen.Text
 import           Gen.TH
 import           Gen.Types.Help

gen/src/Main.hs

@@ -18,6 +18,7 @@ import           Control.Error
 import           Control.Lens              hiding ((<.>))
 import           Control.Monad.State
 import           Data.List                 (nub, sort)
+import           Data.Monoid               ((<>))
 import           Data.String
 import qualified Data.Text                 as Text
 import qualified Filesystem                as FS
@@ -152,7 +153,7 @@ main = do
             let anx = _optAnnexes </> fromText modelName <.> "json"
             p <- isFile anx
             if not p
-               then say ("Skipping '" % stext % "' due to mimsing annex configuration.")
+               then say ("Skipping '" % stext % "' due to missing annex configuration.")
                          modelName
                else do
                     s <- sequence

gen/stack.yaml

@@ -5,6 +5,8 @@ flags: {}
 
 extra-deps:
   - text-regex-replace-0.1.1.1
+  - haskell-src-exts-1.17.1
+  - hindent-4.6.4
 
 packages:
   - '.'