Maps in Protocol Buffers

adapter/avro/mu-avro.cabal

@@ -60,6 +60,7 @@ executable test-avro
       avro        >=0.5.1 && <0.6
     , base        >=4.12  && <5
     , bytestring  >=0.10  && <0.11
+    , containers  >=0.6   && <0.7
     , mu-avro
     , mu-schema   >=0.3   && <0.4
 

adapter/avro/src/Mu/Quasi/Avro.hs

@@ -139,7 +139,7 @@ schemaFromAvroType =
     A.String (Just A.UUID) -> [t|'TPrimitive UUID|]
     A.String _ -> [t|'TPrimitive T.Text|]
     A.Array item -> [t|'TList $(schemaFromAvroType item)|]
-    A.Map values -> [t|'TMap T.Text $(schemaFromAvroType values)|]
+    A.Map values -> [t|'TMap ('TPrimitive T.Text) $(schemaFromAvroType values)|]
     A.NamedType typeName ->
       [t|'TSchematic $(textToStrLit (A.baseName typeName))|]
     A.Enum {} -> fail "should never happen, please, file an issue"

adapter/avro/test/Avro.hs

@@ -8,6 +8,7 @@ module Main where
 
 import           Data.Avro
 import qualified Data.ByteString.Lazy as BS
+import qualified Data.Map             as M
 import           System.Environment
 
 import           Mu.Adapter.Avro      ()
@@ -18,8 +19,11 @@ exampleAddress :: Address
 exampleAddress = Address "1111BB" "Spain"
 
 examplePerson1, examplePerson2 :: Person
-examplePerson1 = Person "Haskellio" "Gomez" (Just 30) (Just Male) exampleAddress [1,2,3]
-examplePerson2 = Person "Cuarenta" "Siete" Nothing Nothing exampleAddress []
+examplePerson1
+  = Person "Haskellio" "Gomez" (Just 30) (Just Male) exampleAddress [1,2,3] M.empty
+examplePerson2
+  = Person "Cuarenta" "Siete" Nothing Nothing exampleAddress []
+           (M.fromList [("hola", 1), ("hello", 2)])
 
 deriving via (WithSchema ExampleSchema "person" Person) instance HasAvroSchema Person
 deriving via (WithSchema ExampleSchema "person" Person) instance FromAvro Person

adapter/avro/test/avro/example.avdl

@@ -3,6 +3,7 @@ protocol Service {
   record Person {
     string name;
     int age;
+    map<int> things;
   }
 
   error NotFoundError {

adapter/avro/test/avro/example.avsc

@@ -18,6 +18,7 @@
           ]
       }
     },
-    {"name": "lucky_numbers", "type": { "type": "array", "items": "long" } }
+    {"name": "lucky_numbers", "type": { "type": "array", "items": "long" } },
+    {"name": "things", "type": "map", "values": "int"}
   ]
 }

adapter/protobuf/mu-protobuf.cabal

@@ -1,5 +1,5 @@
 name:          mu-protobuf
-version:       0.4.0.3
+version:       0.4.1.0
 synopsis:
   Protocol Buffers serialization and gRPC schema import for Mu microservices
 
@@ -34,6 +34,7 @@ library
       base                    >=4.12  && <5
     , bytestring              >=0.10  && <0.11
     , compendium-client       >=0.2   && <0.3
+    , containers              >=0.6   && <0.7
     , http-client             >=0.6   && <0.7
     , http2-grpc-proto3-wire  >=0.1   && <0.2
     , language-protobuf       >=1.0.1 && <2
@@ -54,6 +55,7 @@ executable test-protobuf
   build-depends:
       base         >=4.12  && <5
     , bytestring
+    , containers   >=0.6   && <0.7
     , mu-protobuf
     , mu-schema    >=0.3.0
     , proto3-wire

adapter/protobuf/src/Mu/Adapter/ProtoBuf.hs

@@ -41,6 +41,7 @@ module Mu.Adapter.ProtoBuf (
 import           Control.Applicative
 import qualified Data.ByteString          as BS
 import           Data.Int
+import qualified Data.Map                 as M
 import           Data.SOP                 (All)
 import qualified Data.Text                as T
 import qualified Data.Text.Lazy           as LT
@@ -337,10 +338,13 @@ instance KnownBool 'False where
   boolVal _ = False
 
 instance {-# OVERLAPS #-}
-         (ProtoBridgeOneFieldValue sch t, KnownNat (FindProtoBufId sch ty name), KnownBool (FindProtoBufPacked sch ty name))
+         ( ProtoBridgeOneFieldValue sch t
+         , KnownNat (FindProtoBufId sch ty name)
+         , KnownBool (FindProtoBufPacked sch ty name) )
          => ProtoBridgeField sch ty ('FieldDef name ('TList t)) where
   fieldToProto (Field (FList xs))
-    | boolVal (Proxy @(FindProtoBufPacked sch ty name)), supportsPacking (Proxy @(FieldValue sch t))
+    | boolVal (Proxy @(FindProtoBufPacked sch ty name))
+    , supportsPacking (Proxy @(FieldValue sch t))
     = packedFieldValueToProto fieldId xs
     | otherwise
     = foldMap (oneFieldValueToProto fieldId) xs
@@ -353,10 +357,35 @@ instance {-# OVERLAPS #-}
              | otherwise
              = base
 
-instance TypeError ('Text "maps are not currently supported")
+-- see https://developers.google.com/protocol-buffers/docs/proto3#maps
+{-
+message MapFieldEntry {
+  key_type key = 1;
+  value_type value = 2;
+}
+
+repeated MapFieldEntry map_field = N;
+-}
+instance ( KnownNat (FindProtoBufId sch ty name)
+         , ProtoBridgeOneFieldValue sch k
+         , ProtoBridgeOneFieldValue sch v
+         , Ord (FieldValue sch k) )
          => ProtoBridgeField sch ty ('FieldDef name ('TMap k v)) where
-  fieldToProto = error "maps are not currently supported"
-  protoToField = error "maps are not currently supported"
+  fieldToProto (Field (FMap mp))
+    = foldMap oneMapValueToProto (M.toAscList mp)
+    where fieldId = fromInteger $ natVal (Proxy @(FindProtoBufId sch ty name))
+          oneMapValueToProto (k, v)
+            = PBEnc.embedded fieldId $
+                oneFieldValueToProto 1 k <> oneFieldValueToProto 2 v
+  protoToField = Field . FMap . M.fromList <$> go
+    where fieldId = fromInteger $ natVal (Proxy @(FindProtoBufId sch ty name))
+          go = PBDec.repeated (
+                 PBDec.embedded'
+                   ((,) <$> PBDec.one protoToOneFieldValue
+                              (error "key should always be present") `at` 1
+                        <*> PBDec.one protoToOneFieldValue
+                              (error "value should always be present") `at` 2))
+                 `at` fieldId
 
 instance {-# OVERLAPS #-}
          (ProtoBridgeUnionFieldValue (FindProtoBufOneOfIds sch ty name) sch ts)
@@ -518,14 +547,14 @@ instance TypeError ('Text "lists cannot be nested in protobuf")
   packedFieldValueToProto = error "lists cannot be nested in protobuf"
   protoToPackedFieldValue = error "lists cannot be nested in protobuf"
 
-instance TypeError ('Text "maps are not currently supported")
+instance TypeError ('Text "maps cannot be nested in protobuf")
          => ProtoBridgeOneFieldValue sch ('TMap k v) where
-  defaultOneFieldValue = error "maps are not currently supported"
-  oneFieldValueToProto = error "maps are not currently supported"
-  protoToOneFieldValue = error "maps are not currently supported"
-  supportsPacking      = error "maps are not currently supported"
-  packedFieldValueToProto = error "maps are not currently supported"
-  protoToPackedFieldValue = error "maps are not currently supported"
+  defaultOneFieldValue = error "maps cannot be nested in protobuf"
+  oneFieldValueToProto = error "maps cannot be nested in protobuf"
+  protoToOneFieldValue = error "maps cannot be nested in protobuf"
+  supportsPacking      = error "maps cannot be nested in protobuf"
+  packedFieldValueToProto = error "maps cannot be nested in protobuf"
+  protoToPackedFieldValue = error "maps cannot be nested in protobuf"
 
 instance TypeError ('Text "nested unions are not currently supported")
          => ProtoBridgeOneFieldValue sch ('TUnion choices) where

adapter/protobuf/test/ProtoBuf.hs

@@ -10,6 +10,7 @@ module Main where
 
 import qualified Data.ByteString      as BS
 import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Map             as M
 import qualified Data.Text            as T
 import           GHC.Generics
 import qualified Proto3.Wire.Decode   as PBDec
@@ -26,7 +27,8 @@ data MPerson
             , age           :: Maybe Int
             , gender        :: Maybe Gender
             , address       :: MAddress
-            , lucky_numbers :: [Int] }
+            , lucky_numbers :: [Int]
+            , things        :: M.Map T.Text Int }
   deriving (Eq, Show, Generic)
   deriving (ToSchema ExampleSchema "person")
   deriving (FromSchema ExampleSchema "person")
@@ -60,7 +62,8 @@ type instance AnnotatedSchema ProtoBufAnnotation ExampleSchema
      , 'AnnField "person" "age"       ('ProtoBufId 3 '[])
      , 'AnnField "person" "gender"    ('ProtoBufId 4 '[])
      , 'AnnField "person" "address"   ('ProtoBufId 5 '[])
-     , 'AnnField "person" "lucky_numbers" ('ProtoBufId 6 '[ '("packed", 'ProtoBufOptionConstantBool 'True) ]) ]
+     , 'AnnField "person" "lucky_numbers" ('ProtoBufId 6 '[ '("packed", 'ProtoBufOptionConstantBool 'True) ])
+     , 'AnnField "person" "things"    ('ProtoBufId 7 '[]) ]
 
 exampleAddress :: MAddress
 exampleAddress = MAddress "1111BB" "Spain"
@@ -69,9 +72,10 @@ examplePerson1, examplePerson2 :: MPerson
 examplePerson1 = MPerson "Haskellio" "Gómez"
                          (Just 30) (Just Male)
                          exampleAddress [1,2,3]
+                         (M.fromList [("pepe", 1), ("juan", 2)])
 examplePerson2 = MPerson "Cuarenta" "Siete"
                          Nothing Nothing
-                         exampleAddress []
+                         exampleAddress [] M.empty
 
 main :: IO ()
 main = do -- Obtain the filenames

adapter/protobuf/test/protobuf/example.proto

@@ -7,6 +7,7 @@ message person {
   gender gender = 4;
   address address = 5;
   repeated int32 lucky_numbers = 6 [packed=true];
+  map<string, int32> things = 7;
 }
 
 message address {

adapter/protobuf/test/protobuf/generate.py

@@ -12,6 +12,9 @@
 for i in [1,2,3]:
   example_person.lucky_numbers.append(i)
 example_person.address.CopyFrom(example_address)
+example_person.things["hola"]  = 1
+example_person.things["hello"] = 2
+example_person.things["hallo"] = 3
 
 f = open(sys.argv[1], "wb")
 f.write(example_person.SerializeToString())

core/schema/src/Mu/Schema/Examples.hs

@@ -21,6 +21,7 @@ Look at the source code of this module.
 module Mu.Schema.Examples where
 
 import qualified Data.Aeson                         as J
+import qualified Data.Map                           as M
 import qualified Data.Text                          as T
 import           GHC.Generics
 
@@ -34,7 +35,8 @@ data Person
            , age           :: Maybe Int
            , gender        :: Maybe Gender
            , address       :: Address
-           , lucky_numbers :: [Int] }
+           , lucky_numbers :: [Int]
+           , things        :: M.Map T.Text Int }
   deriving (Eq, Show, Generic)
   deriving (ToSchema ExampleSchema "person", FromSchema ExampleSchema "person")
   deriving (J.ToJSON, J.FromJSON)
@@ -111,7 +113,8 @@ type ExampleSchema
                  , 'FieldDef "age"       ('TOption ('TPrimitive Int))
                  , 'FieldDef "gender"    ('TOption ('TSchematic "gender"))
                  , 'FieldDef "address"   ('TSchematic "address")
-                 , 'FieldDef "lucky_numbers" ('TList ('TPrimitive Int)) ]
+                 , 'FieldDef "lucky_numbers" ('TList ('TPrimitive Int))
+                 , 'FieldDef "things"    ('TMap ('TPrimitive T.Text) ('TPrimitive Int)) ]
      ]
 
 $(generateTypesFromSchema (++"Msg") ''ExampleSchema)