diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for avro + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016, Thomas M. DuBuisson + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Thomas M. DuBuisson nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/avro.cabal b/avro.cabal new file mode 100644 --- /dev/null +++ b/avro.cabal @@ -0,0 +1,113 @@ +-- Initial avro.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/ + +name: avro +version: 0.1.0.0 +synopsis: Avro serialization support for Haskell +description: Avro serialization and deserialization support for Haskell +homepage: https://github.com/GaloisInc/avro.git +license: BSD3 +license-file: LICENSE +author: Thomas M. DuBuisson +maintainer: tommd@galois.com +-- copyright: +category: Data +build-type: Simple +extra-source-files: ChangeLog.md, test/data/reused.avsc, test/data/small.avsc, test/data/enums.avsc +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/GaloisInc/avro.git + +flag dev + default: False + manual: True + description: Use development GHC flags + +library + exposed-modules: Data.Avro, + Data.Avro.Decode, + Data.Avro.DecodeRaw, + Data.Avro.Deconflict, + Data.Avro.Deriving, + Data.Avro.Encode, + Data.Avro.EncodeRaw, + Data.Avro.Schema, + Data.Avro.Types, + Data.Avro.Zag, + Data.Avro.Zig + other-modules: Data.Avro.Deriving.NormSchema + other-extensions: OverloadedStrings + build-depends: base >=4.8 && <5.0, + aeson, + array, + base16-bytestring, + binary, + bytestring, + containers, + data-binary-ieee754, + entropy, + fail, + hashable, + mtl, + scientific, + text, + unordered-containers, + vector, + pure-zlib, + semigroups, + tagged, + template-haskell + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -O2 + if flag(dev) + ghc-options: -Wall -Werror + +test-suite test + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + other-modules: Avro.Codec.ArraySpec + , Avro.Codec.BoolSpec + , Avro.Codec.CodecRawSpec + , Avro.Codec.DoubleSpec + , Avro.Codec.Int64Spec + , Avro.Codec.MaybeSpec + , Avro.Codec.NestedSpec + , Avro.Codec.TextSpec + , Avro.Codec.ZigZagSpec + , Avro.EncodeRawSpec + , Avro.THEnumSpec + , Avro.THReusedSpec + , Avro.THSimpleSpec + , Avro.ToAvroSpec + + main-is: Spec.hs + ghc-options: -threaded + if flag(dev) + ghc-options: -Wall -Werror + build-depends: base >=4.6 && < 5 + , avro + , aeson + , array + , base16-bytestring + , binary + , bytestring + , containers + , entropy + , extra + , fail + , hashable + , mtl + , scientific + , text + , unordered-containers + , vector + , pure-zlib + , semigroups + , tagged + , template-haskell + , hspec + , QuickCheck diff --git a/src/Data/Avro.hs b/src/Data/Avro.hs new file mode 100644 --- /dev/null +++ b/src/Data/Avro.hs @@ -0,0 +1,327 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MultiWayIf #-} +-- | Avro encoding and decoding routines. +-- +-- This library provides a high level interface for encoding (and decoding) +-- Haskell values in Apache's Avro serialization format. The goal is to +-- match Aeson's API whenever reasonable, meaning user experience with one +-- effectively translate to the other. +-- +-- Avro RPC is not currently supported. +-- +-- **Library Structure** +-- +-- The library structure includes: +-- * This module, 'Data.Avro', providing a high-level interface via +-- classes of 'FromAvro' and 'ToAvro' for decoding and encoding values. +-- * 'Data.Avro.Type' define the types of Avro data, providing a common +-- (intermediate) representation for any data that is encoded or decoded +-- by Data.Avro. +-- * 'Data.Avro.Encode' and 'Data.Avro.Decode': More +-- efficient conversion capable of avoiding the intermediate representation. +-- Also, the implementation of the en/decoding of the intermediate +-- representation. +-- * 'Data.Avro.Deconflict': translate decoded data from an +-- encoder schema to the (potentially different) decoder's schema. +-- * 'Data.Avro.Schema': Defines the type for Avro schema's and its JSON +-- encoding/decoding. +-- +-- Example decoding: +-- +-- Let's say you have an ADT and related schema: +-- +-- @ +-- {-# LANGUAGE OverloadedStrings #-} +-- import qualified Data.Avro.Types as Ty +-- import Data.Avro.Schema +-- import Data.Avro +-- import Data.List.NonEmpty (NonEmpty(..)) +-- +-- data MyEnum = A | B | C | D deriving (Eq,Ord,Show,Enum,Generic) +-- data MyStruct = MyStruct (Either MyEnum String) Int +-- +-- meSchema :: Schema +-- meSchema = Schema $ mkEnum "MyEnum" [] Nothing Nothing ["A","B","C","D"] +-- +-- msSchema :: Schema +-- msSchema = +-- Struct "MyStruct" Nothing [] Nothing Nothing +-- [ fld "enumOrString" eOrS (Just $ String "The Default") +-- , fld "int" Int (Just (Ty.Int 1)) +-- ] +-- where +-- fld nm ty def = Field nm [] Nothing Nothing ty def +-- eOrS = mkUnion (meSchema :| [String]) +-- +-- instance ToAvro MyEnum where +-- toAvro = toAvroEnum +-- instance ToAvro MyStruct where +-- toAvro (MyStruct ab i) = +-- record [ "enumOrString" .= ab +-- , "int" .= i +-- ] +-- +-- main = do +-- let val = MyStruct (Right "Hello") 1 +-- print (fromAvro (toAvro val) == Success val) +-- +-- @ +module Data.Avro + ( FromAvro(..) + , ToAvro(..) + , Avro + , (.:) + , (.=), record + , Result(..), badValue + , decode + , decodeContainer + , decodeContainerBytes + , encode + , encodeContainer + , encodeContainerWithSync + , schemaOf + ) where + +import Prelude as P +import Control.Arrow (first) +import qualified Data.Avro.Decode as D +import Data.Avro.Deconflict as C +import qualified Data.Avro.Encode as E +import Data.Avro.Schema as S +import Data.Avro.Types as T +import qualified Data.Binary.Get as G +import qualified Data.Binary.Put as P +import qualified Data.ByteString as B +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as BL +import Data.Foldable (toList) +import qualified Data.HashMap.Strict as HashMap +import Data.Int +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.Map as Map +import Data.Monoid ((<>)) +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Lazy as TL +import Data.Tagged +import qualified Data.Vector as V +import Data.Word + +-- |Decode a lazy bytestring using a given Schema. +decode :: FromAvro a => Schema -> ByteString -> Result a +decode sch bytes = + case D.decodeAvro sch bytes of + Right val -> fromAvro val + Left err -> Error err + +-- |Decode a container and de-conflict the writer schema with a given +-- reader-schema. Exceptions are thrown instead of a 'Result' type to +-- allow this function to be read lazy (to be done in some later version). +decodeContainer :: FromAvro a => Schema -> ByteString -> [[a]] +decodeContainer readerSchema bs = + case D.decodeContainer bs of + Right (writerSchema,val) -> + let err e = error $ "Could not deconflict reader and writer schema." <> e + dec x = + case C.deconflict writerSchema readerSchema x of + Left e -> err e + Right v -> case fromAvro v of + Success x -> x + Error e -> error e + in P.map (P.map dec) val + Left err -> error err + +encode :: ToAvro a => a -> BL.ByteString +encode = E.encodeAvro . toAvro + +encodeContainer :: ToAvro a => [[a]] -> IO BL.ByteString +encodeContainer = E.encodeContainer . map (map toAvro) + +encodeContainerWithSync :: ToAvro a => (Word64,Word64,Word64,Word64) -> [[a]] -> BL.ByteString +encodeContainerWithSync (a,b,c,d) = E.encodeContainerWithSync s . map (map toAvro) + where s = P.runPut $ mapM_ P.putWord64le [a,b,c,d] + +-- |Like 'decodeContainer' but returns the avro-encoded bytes for each +-- object in the container instead of the Haskell type. +-- +-- This is particularly useful when slicing up containers into one or more +-- smaller files. By extracting the original bytestring it is possible to +-- avoid re-encoding data. +decodeContainerBytes :: ByteString -> [[ByteString]] +decodeContainerBytes bs = + case D.decodeContainerWith schemaBytes bs of + Right (writerSchema, val) -> val + Left e -> error $ "Could not decode container: " <> e + where + schemaBytes sch = + do start <- G.bytesRead + end <- G.lookAhead $ do _ <- D.getAvroOf sch + G.bytesRead + G.getLazyByteString (end-start) + +type Avro a = (FromAvro a, ToAvro a) +class FromAvro a where + fromAvro :: Value Type -> Result a + +instance FromAvro (Value Type) where + fromAvro = pure +instance (ToAvro a, ToAvro b, FromAvro a, FromAvro b) => FromAvro (Either a b) where + fromAvro e@(T.Union _ v x) = + if | v == untag (schema :: Tagged a Type) -> Left <$> fromAvro x + | v == untag (schema :: Tagged b Type) -> Right <$> fromAvro x + | otherwise -> badValue e "either" + fromAvro x = badValue x "either" +instance FromAvro Bool where + fromAvro (T.Boolean b) = pure b + fromAvro v = badValue v "Bool" +instance FromAvro B.ByteString where + fromAvro (T.Bytes b) = pure b + fromAvro v = badValue v "ByteString" +instance FromAvro BL.ByteString where + fromAvro (T.Bytes b) = pure (BL.fromStrict b) + fromAvro v = badValue v "Lazy ByteString" +instance FromAvro Int where + fromAvro (T.Int i) | (fromIntegral i :: Integer) < fromIntegral (maxBound :: Int) + = pure (fromIntegral i) + fromAvro (T.Long i) | (fromIntegral i :: Integer) < fromIntegral (maxBound :: Int) + = pure (fromIntegral i) + fromAvro v = badValue v "Int" +instance FromAvro Int32 where + fromAvro (T.Int i) = pure (fromIntegral i) + fromAvro v = badValue v "Int32" +instance FromAvro Int64 where + fromAvro (T.Long i) = pure i + fromAvro (T.Int i) = pure (fromIntegral i) + fromAvro v = badValue v "Int64" +instance FromAvro Double where + fromAvro (T.Double d) = pure d + fromAvro v = badValue v "Double" +instance FromAvro a => FromAvro (Maybe a) where + fromAvro (T.Union (S.Null :| [_]) _ T.Null) = pure Nothing + fromAvro (T.Union (S.Null :| [_]) _ v) = Just <$> fromAvro v + fromAvro v = badValue v "Maybe a" + +instance FromAvro a => FromAvro [a] where + fromAvro (T.Array vec) = mapM fromAvro $ toList vec + fromAvro v = badValue v "[a]" + +instance FromAvro Text where + fromAvro (T.String txt) = pure txt + fromAvro v = badValue v "Text" + +instance FromAvro TL.Text where + fromAvro (T.String txt) = pure (TL.fromStrict txt) + fromAvro v = badValue v "Lazy Text" + +instance (FromAvro a) => FromAvro (Map.Map Text a) where + fromAvro (T.Record _ mp) = mapM fromAvro $ Map.fromList (HashMap.toList mp) + fromAvro (T.Map mp) = mapM fromAvro $ Map.fromList (HashMap.toList mp) + fromAvro v = badValue v "Map Text a" + +instance (FromAvro a) => FromAvro (HashMap.HashMap Text a) where + fromAvro (T.Record _ mp) = mapM fromAvro mp + fromAvro (T.Map mp) = mapM fromAvro mp + fromAvro v = badValue v "HashMap Text a" + +badValue :: Value Type -> String -> Result a +badValue v t = fail $ "Unexpected value when decoding for '" <> t <> "': " <> show v + +(.:) :: FromAvro a => HashMap.HashMap Text (Value Type) -> Text -> Result a +(.:) obj key = + case HashMap.lookup key obj of + Nothing -> fail $ "Requested field not available: " <> show key + Just v -> fromAvro v + +(.=) :: ToAvro a => Text -> a -> (Text,T.Value Type) +(.=) nm val = (nm,toAvro val) + +record :: Foldable f => Type -> f (Text,T.Value Type) -> T.Value Type +record ty = T.Record ty . HashMap.fromList . toList + +class ToAvro a where + toAvro :: a -> T.Value Type + schema :: Tagged a Type + +schemaOf :: (ToAvro a) => a -> Type +schemaOf = witness schema + +instance ToAvro Bool where + toAvro = T.Boolean + schema = Tagged S.Boolean +instance ToAvro () where + toAvro _ = T.Null + schema = Tagged S.Null +instance ToAvro Int where + toAvro = T.Long . fromIntegral + schema = Tagged S.Long +instance ToAvro Int32 where + toAvro = T.Int + schema = Tagged S.Int +instance ToAvro Int64 where + toAvro = T.Long + schema = Tagged S.Long +instance ToAvro Double where + toAvro = T.Double + schema = Tagged S.Double +instance ToAvro Text.Text where + toAvro = T.String + schema = Tagged S.String +instance ToAvro TL.Text where + toAvro = T.String . TL.toStrict + schema = Tagged S.String +instance ToAvro B.ByteString where + toAvro = T.Bytes + schema = Tagged S.Bytes +instance ToAvro BL.ByteString where + toAvro = T.Bytes . BL.toStrict + schema = Tagged S.Bytes +instance (ToAvro a, ToAvro b) => ToAvro (Either a b) where + toAvro e = + let sch@(l:|[r]) = options (schemaOf e) + in case e of + Left a -> T.Union sch l (toAvro a) + Right b -> T.Union sch r (toAvro b) + schema = Tagged $ mkUnion (untag (schema :: Tagged a Type) :| [untag (schema :: Tagged b Type)]) +instance (ToAvro a) => ToAvro (Map.Map Text a) where + toAvro = toAvro . HashMap.fromList . Map.toList + schema = wrapTag S.Map (schema :: Tagged a Type) +instance (ToAvro a) => ToAvro (HashMap.HashMap Text a) where + toAvro = T.Map . HashMap.map toAvro + schema = wrapTag S.Map (schema :: Tagged a Type) +instance (ToAvro a) => ToAvro (Map.Map TL.Text a) where + toAvro = toAvro . HashMap.fromList . map (first TL.toStrict) . Map.toList + schema = wrapTag S.Map (schema :: Tagged a Type) +instance (ToAvro a) => ToAvro (HashMap.HashMap TL.Text a) where + toAvro = toAvro . HashMap.fromList . map (first TL.toStrict) . HashMap.toList + schema = wrapTag S.Map (schema :: Tagged a Type) +instance (ToAvro a) => ToAvro (Map.Map String a) where + toAvro = toAvro . HashMap.fromList . map (first Text.pack) . Map.toList + schema = wrapTag S.Map (schema :: Tagged a Type) +instance (ToAvro a) => ToAvro (HashMap.HashMap String a) where + toAvro = toAvro . HashMap.fromList . map (first Text.pack) . HashMap.toList + schema = wrapTag S.Map (schema :: Tagged a Type) +instance (ToAvro a) => ToAvro (Maybe a) where + toAvro a = + let sch@(l:|[r]) = options (schemaOf a) + in case a of + Nothing -> T.Union sch S.Null (toAvro ()) + Just v -> T.Union sch r (toAvro v) + schema = Tagged $ mkUnion (S.Null:| [untag (schema :: Tagged a Type)]) +instance (ToAvro a) => ToAvro [a] where + toAvro = T.Array . V.fromList . (toAvro <$>) + schema = wrapTag S.Array (schema :: Tagged a Type) + +wrapTag :: (Type -> Type) -> Tagged a Type -> Tagged b Type +wrapTag f = Tagged . f . untag +{-# INLINE wrapTag #-} + +-- @enumToAvro val@ will generate an Avro encoded value of enum suitable +-- for serialization ('encode'). +-- enumToAvro :: (Show a, Enum a, Bounded a, Generic a) => a -> T.Value Type +-- enumToAvro e = T.Enum ty (show e) +-- where +-- ty = S.Enum nm Nothing [] Nothing (map (Text.pack . show) [minBound..maxBound]) +-- nm = datatypeName g +-- g = from e -- GHC generics diff --git a/src/Data/Avro/Decode.hs b/src/Data/Avro/Decode.hs new file mode 100644 --- /dev/null +++ b/src/Data/Avro/Decode.hs @@ -0,0 +1,324 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Avro.Decode + ( decodeAvro + , decodeContainer + -- * Lower level interface + , decodeContainerWith + , getAvroOf + , GetAvro(..) + ) where + +import Prelude as P +import Control.Monad (replicateM,when) +import qualified Codec.Compression.Zlib as Z +import qualified Data.Aeson as A +import qualified Data.Array as Array +import qualified Data.Binary.Get as G +import Data.Binary.Get (Get,runGetOrFail) +import Data.Binary.IEEE754 as IEEE +import Data.Bits +import qualified Data.ByteString.Lazy as BL +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy.Char8 as BC +import Data.Int +import Data.List (foldl') +import qualified Data.List.NonEmpty as NE +import Data.Maybe +import qualified Data.Map as Map +import Data.Monoid ((<>)) +import qualified Data.HashMap.Strict as HashMap +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import qualified Data.Vector as V + +import Data.Avro.DecodeRaw +import Data.Avro.Zag +import Data.Avro.Schema as S +import qualified Data.Avro.Types as T + +-- |Decode bytes into a 'Value' as described by Schema. +decodeAvro :: Schema -> BL.ByteString -> Either String (T.Value Type) +decodeAvro sch = either (\(_,_,s) -> Left s) (\(_,_,a) -> Right a) . runGetOrFail (getAvroOf sch) +{-# INLINABLE decodeAvro #-} + +decodeContainer :: BL.ByteString -> Either String (Schema, [[T.Value Type]]) +decodeContainer = decodeContainerWith getAvroOf +{-# INLINABLE decodeContainer #-} + +decodeContainerWith :: (Schema -> Get a) + -> BL.ByteString + -> Either String (Schema, [[a]]) +decodeContainerWith schemaToGet bs = + case runGetOrFail (getContainerWith schemaToGet) bs of + Right (_,_,a) -> Right a + Left (_,_,s) -> Left s +{-# INLINABLE decodeContainerWith #-} + +data ContainerHeader = ContainerHeader + { syncBytes :: !BL.ByteString + , decompress :: BL.ByteString -> Get BL.ByteString + , containedSchema :: !Schema + } + +nrSyncBytes :: Integral sb => sb +nrSyncBytes = 16 + +instance GetAvro ContainerHeader where + getAvro = + do magic <- getFixed avroMagicSize + when (BL.fromStrict magic /= avroMagicBytes) + (fail "Invalid magic number at start of container.") + metadata <- getMap :: Get (Map.Map Text BL.ByteString) -- avro.schema, avro.codec + sync <- BL.fromStrict <$> getFixed nrSyncBytes + codec <- getCodec (Map.lookup "avro.codec" metadata) + schema <- case Map.lookup "avro.schema" metadata of + Nothing -> fail "Invalid container object: no schema." + Just s -> case A.eitherDecode' s of + Left e -> fail ("Can not decode container schema: " <> e) + Right x -> return x + return ContainerHeader { syncBytes = sync, decompress = codec, containedSchema = schema } + where avroMagicSize :: Integral a => a + avroMagicSize = 4 + + avroMagicBytes :: BL.ByteString + avroMagicBytes = BC.pack "Obj" <> BL.pack [1] + + getFixed :: Int -> Get ByteString + getFixed = G.getByteString + + +getContainerWith :: (Schema -> Get a) -> Get (Schema, [[a]]) +getContainerWith schemaToGet = + do ContainerHeader {..} <- getAvro + (containedSchema,) <$> getBlocks (schemaToGet containedSchema) syncBytes decompress + where + getBlocks :: Get a -> BL.ByteString -> (BL.ByteString -> Get BL.ByteString) -> Get [[a]] + getBlocks getValue sync decompress = + do nrObj <- sFromIntegral =<< getLong + nrBytes <- getLong + bytes <- decompress =<< G.getLazyByteString nrBytes + r <- case runGetOrFail (replicateM nrObj getValue) bytes of + Right (_,_,x) -> return x + Left (_,_,s) -> fail s + marker <- G.getLazyByteString nrSyncBytes + when (marker /= sync) (fail "Invalid marker, does not match sync bytes.") + e <- G.isEmpty + if e + then return [r] + else (r :) <$> getBlocks getValue sync decompress + +getCodec :: Monad m => Maybe BL.ByteString -> m (BL.ByteString -> m BL.ByteString) +getCodec code | Just "null" <- code = + return return + | Just "deflate" <- code = + return (either (fail . show) return . Z.decompress) + | Just x <- code = + fail ("Unrecognized codec: " <> BC.unpack x) + | otherwise = return return + +{-# INLINABLE getAvroOf #-} +getAvroOf :: Schema -> Get (T.Value Type) +getAvroOf ty0 = go ty0 + where + env = S.buildTypeEnvironment envFail ty0 + envFail t = fail $ "Named type not in schema: " <> show t + + go :: Type -> Get (T.Value Type) + go ty = + case ty of + Null -> return T.Null + Boolean -> T.Boolean <$> getAvro + Int -> T.Int <$> getAvro + Long -> T.Long <$> getAvro + Float -> T.Float <$> getAvro + Double -> T.Double <$> getAvro + Bytes -> T.Bytes <$> getAvro + String -> T.String <$> getAvro + Array t -> + do vals <- getBlocksOf t + return $ T.Array (V.fromList $ mconcat vals) + Map t -> + do kvs <- getKVBlocks t + return $ T.Map (HashMap.fromList $ mconcat kvs) + NamedType tn -> env tn >>= go + Record {..} -> + do let getField Field {..} = (fldName,) <$> go fldType + T.Record ty . HashMap.fromList <$> mapM getField fields + Enum {..} -> + do val <- getLong + let sym = fromMaybe "" (symbolLookup val) -- empty string for 'missing' symbols (alternative is an error or exception) + pure (T.Enum ty (fromIntegral val) sym) + Union ts unionLookup -> + do i <- getLong + case unionLookup i of + Nothing -> fail $ "Decoded Avro tag is outside the expected range for a Union. Tag: " <> show i <> " union of: " <> show (P.map typeName $ NE.toList ts) + Just t -> T.Union ts t <$> go t + Fixed {..} -> T.Fixed <$> G.getByteString (fromIntegral size) + + getKVBlocks :: Type -> Get [[(Text,T.Value Type)]] + getKVBlocks t = + do blockLength <- abs <$> getLong + if blockLength == 0 + then return [] + else do vs <- replicateM (fromIntegral blockLength) ((,) <$> getString <*> go t) + (vs:) <$> getKVBlocks t + {-# INLINE getKVBlocks #-} + + getBlocksOf :: Type -> Get [[T.Value Type]] + getBlocksOf t = + do blockLength <- abs <$> getLong + if blockLength == 0 + then return [] + else do vs <- replicateM (fromIntegral blockLength) (go t) + (vs:) <$> getBlocksOf t + {-# INLINE getBlocksOf #-} + +class GetAvro a where + getAvro :: Get a + +instance GetAvro ty => GetAvro (Map.Map Text ty) where + getAvro = getMap +instance GetAvro Bool where + getAvro = getBoolean +instance GetAvro Int32 where + getAvro = getInt +instance GetAvro Int64 where + getAvro = getLong +instance GetAvro BL.ByteString where + getAvro = BL.fromStrict <$> getBytes +instance GetAvro ByteString where + getAvro = getBytes +instance GetAvro Text where + getAvro = getString +instance GetAvro Float where + getAvro = getFloat +instance GetAvro Double where + getAvro = getDouble +instance GetAvro String where + getAvro = Text.unpack <$> getString +instance GetAvro a => GetAvro [a] where + getAvro = getArray +instance GetAvro a => GetAvro (Maybe a) where + getAvro = + do t <- getLong + case t of + 0 -> return Nothing + 1 -> Just <$> getAvro + n -> fail $ "Invalid tag for expected {null,a} Avro union, received: " <> show n + +instance GetAvro a => GetAvro (Array.Array Int a) where + getAvro = + do ls <- getAvro + return $ Array.listArray (0,length ls - 1) ls +instance GetAvro a => GetAvro (V.Vector a) where + getAvro = V.fromList <$> getAvro +instance (GetAvro a, Ord a) => GetAvro (Set.Set a) where + getAvro = Set.fromList <$> getAvro + +-------------------------------------------------------------------------------- +-- Specialized Getters + +getBoolean :: Get Bool +getBoolean = + do w <- G.getWord8 + return (w == 0x01) + +-- |Get a 32-bit int (zigzag encoded, max of 5 bytes) +getInt :: Get Int32 +getInt = getZigZag + +-- |Get a 64 bit int (zigzag encoded, max of 10 bytes) +getLong :: Get Int64 +getLong = getZigZag + +-- |Get an zigzag encoded integral value consuming bytes till the msb is 0. +getZigZag :: (Bits i, Integral i, DecodeRaw i) => Get i +getZigZag = decodeRaw + +getBytes :: Get ByteString +getBytes = + do w <- getLong + G.getByteString (fromIntegral w) + +getString :: Get Text +getString = Text.decodeUtf8 <$> getBytes + +-- a la Java: +-- Bit 31 (the bit that is selected by the mask 0x80000000) represents the +-- sign of the floating-point number. Bits 30-23 (the bits that are +-- selected by the mask 0x7f800000) represent the exponent. Bits 22-0 (the +-- bits that are selected by the mask 0x007fffff) represent the +-- significand (sometimes called the mantissa) of the floating-point +-- number. +-- +-- If the argument is positive infinity, the result is 0x7f800000. +-- +-- If the argument is negative infinity, the result is 0xff800000. +-- +-- If the argument is NaN, the result is 0x7fc00000. +getFloat :: Get Float +getFloat = IEEE.wordToFloat <$> G.getWord32le + +-- As in Java: +-- Bit 63 (the bit that is selected by the mask 0x8000000000000000L) +-- represents the sign of the floating-point number. Bits 62-52 (the bits +-- that are selected by the mask 0x7ff0000000000000L) represent the +-- exponent. Bits 51-0 (the bits that are selected by the mask +-- 0x000fffffffffffffL) represent the significand (sometimes called the +-- mantissa) of the floating-point number. +-- +-- If the argument is positive infinity, the result is +-- 0x7ff0000000000000L. +-- +-- If the argument is negative infinity, the result is +-- 0xfff0000000000000L. +-- +-- If the argument is NaN, the result is 0x7ff8000000000000L +getDouble :: Get Double +getDouble = IEEE.wordToDouble <$> G.getWord64le + +-------------------------------------------------------------------------------- +-- Complex AvroValue Getters + +-- getRecord :: GetAvro ty => Get (AvroValue ty) +-- getRecord = getAvro + +getArray :: GetAvro ty => Get [ty] +getArray = + do nr <- getLong + if + | nr == 0 -> return [] + | nr < 0 -> + do _len <- getLong + rs <- replicateM (fromIntegral (abs nr)) getAvro + (rs <>) <$> getArray + | otherwise -> + do rs <- replicateM (fromIntegral nr) getAvro + (rs <>) <$> getArray + +getMap :: GetAvro ty => Get (Map.Map Text ty) +getMap = go Map.empty + where + go acc = + do nr <- getLong + if nr == 0 + then return acc + else do m <- Map.fromList <$> replicateM (fromIntegral nr) getKVs + go (Map.union m acc) + getKVs = (,) <$> getString <*> getAvro + +-- Safe-ish from integral +sFromIntegral :: forall a b m. (Monad m, Bounded a, Bounded b, Integral a, Integral b) => a -> m b +sFromIntegral a + | aI > fromIntegral (maxBound :: b) || + aI < fromIntegral (minBound :: b) = fail "Integral overflow." + | otherwise = return (fromIntegral a) + where aI = fromIntegral a :: Integer diff --git a/src/Data/Avro/DecodeRaw.hs b/src/Data/Avro/DecodeRaw.hs new file mode 100644 --- /dev/null +++ b/src/Data/Avro/DecodeRaw.hs @@ -0,0 +1,65 @@ +module Data.Avro.DecodeRaw + ( DecodeRaw(..) + ) where + +import Data.Avro.Zag +import Data.Binary.Get +import Data.Bits +import Data.Int +import Data.List +import Data.Word + +getNonNegative :: (Bits i, Integral i) => Get i +getNonNegative = do + orig <- getWord8s + return (foldl' (\a x -> (a `shiftL` 7) + fromIntegral x) 0 (reverse orig)) + +getWord8s :: Get [Word8] +getWord8s = do + w <- getWord8 + let msb = w `testBit` 7 in (w .&. 0x7F :) <$> if msb + then getWord8s + else return [] + +class DecodeRaw a where + decodeRaw :: Get a + +instance DecodeRaw Word where + decodeRaw = getNonNegative + {-# INLINE decodeRaw #-} + +instance DecodeRaw Word8 where + decodeRaw = getNonNegative + {-# INLINE decodeRaw #-} + +instance DecodeRaw Word16 where + decodeRaw = getNonNegative + {-# INLINE decodeRaw #-} + +instance DecodeRaw Word32 where + decodeRaw = getNonNegative + {-# INLINE decodeRaw #-} + +instance DecodeRaw Word64 where + decodeRaw = getNonNegative + {-# INLINE decodeRaw #-} + +instance DecodeRaw Int where + decodeRaw = zag <$> (decodeRaw :: Get Word) + {-# INLINE decodeRaw #-} + +instance DecodeRaw Int8 where + decodeRaw = zag <$> (decodeRaw :: Get Word8) + {-# INLINE decodeRaw #-} + +instance DecodeRaw Int16 where + decodeRaw = zag <$> (decodeRaw :: Get Word16) + {-# INLINE decodeRaw #-} + +instance DecodeRaw Int32 where + decodeRaw = zag <$> (decodeRaw :: Get Word32) + {-# INLINE decodeRaw #-} + +instance DecodeRaw Int64 where + decodeRaw = zag <$> (decodeRaw :: Get Word64) + {-# INLINE decodeRaw #-} diff --git a/src/Data/Avro/Deconflict.hs b/src/Data/Avro/Deconflict.hs new file mode 100644 --- /dev/null +++ b/src/Data/Avro/Deconflict.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE TupleSections #-} +module Data.Avro.Deconflict + ( deconflict + ) where + +import Data.Avro.Schema as S +import Data.Avro.Types as T +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text + +-- | @deconflict writer reader val@ will convert a value that was +-- encoded/decoded with the writer's schema into the form specified by the +-- reader's schema. +deconflict :: Schema -> Schema -> T.Value Type -> Either String (T.Value Type) +deconflict writerType readerType val = + resolveSchema writerType readerType val + +resolveSchema :: Type -> Type -> T.Value Type -> Either String (T.Value Type) +resolveSchema e d v + | e == d = Right v + | otherwise = go e d v + where + go :: Type -> Type -> T.Value Type -> Either String (T.Value Type) + go (S.Array aTy) (S.Array bTy) (T.Array vec) = + T.Array <$> mapM (go aTy bTy) vec + go (S.Map aTy) (S.Map bTy) (T.Map mp) = + T.Map <$> mapM (go aTy bTy) mp + go a@(S.Enum {}) b@(S.Enum {}) val + | name a == name b = resolveEnum a b val + go a@(S.Fixed {}) b@(S.Fixed {}) val + | name a == name b && size a == size b = Right val + go a@(S.Record {}) b@(S.Record {}) val + | name a == name b = resolveRecord a b val + go (S.Union _ _) (S.Union ys _) val = + resolveTwoUnions ys val + go nonUnion (S.Union ys _) val = + resolveReaderUnion nonUnion ys val + go (S.Union _xs _) nonUnion val = + resolveWriterUnion nonUnion val + go eTy dTy val = + case val of + T.Int i32 | dTy == S.Long -> Right $ T.Long (fromIntegral i32) + | dTy == S.Float -> Right $ T.Float (fromIntegral i32) + | dTy == S.Double -> Right $ T.Double (fromIntegral i32) + T.Long i64 | dTy == S.Float -> Right $ T.Float (fromIntegral i64) + | dTy == S.Double -> Right $ T.Double (fromIntegral i64) + T.Float f | dTy == S.Double -> Right $ T.Double (realToFrac f) + T.String s | dTy == S.Bytes -> Right $ T.Bytes (Text.encodeUtf8 s) + T.Bytes bs | dTy == S.String -> Right $ T.String (Text.decodeUtf8 bs) + _ -> Left $ "Can not resolve differing writer and reader schemas: " ++ show (eTy, dTy) + +-- The writer's symbol must be present in the reader's enum +resolveEnum :: Type -> Type -> T.Value Type -> Either String (T.Value Type) +resolveEnum e d val@(T.Enum _ _ _txt) = Right val + -- -- | txt `elem` symbols d = Right val + -- -- | otherwise = Left "Decoded enum does not appear in reader's symbol list." + +resolveTwoUnions :: NonEmpty Type -> T.Value Type -> Either String (T.Value Type) +resolveTwoUnions ds (T.Union _ eTy val) = + resolveReaderUnion eTy ds val + +resolveReaderUnion :: Type -> NonEmpty Type -> T.Value Type -> Either String (T.Value Type) +resolveReaderUnion e ds val = + let hdl [] = Left "Impossible: empty non-empty list." + hdl (d:rest) = + case resolveSchema e d val of + Right v -> Right (T.Union ds d v) + Left _ -> hdl rest + in hdl (NE.toList ds) + +resolveWriterUnion :: Type -> T.Value Type -> Either String (T.Value Type) +resolveWriterUnion reader (T.Union _ ty val) = resolveSchema ty reader val + +resolveRecord :: Type -> Type -> T.Value Type -> Either String (T.Value Type) +resolveRecord eRec dRec (T.Record ty fldVals) = + T.Record ty . HashMap.fromList <$> mapM (resolveFields fldVals (fields eRec)) (fields dRec) + +-- For each field of the decoders, lookup the field in the hash map +-- 1) If the field exists, call 'resolveSchema' +-- 2) If the field is missing use the reader's default +-- 3) If there is no default, fail. +-- +-- XXX: Consider aliases in the writer schema, use those to retry on failed lookup. +resolveFields :: HashMap Text (T.Value Type) -> [Field] -> Field -> Either String (Text,T.Value Type) +resolveFields hm eFlds d = + case (HashMap.lookup (fldName d) hm, fldDefault d) of + (Just x,_) -> Right (fldName d, x) + (_,Just def) -> Right (fldName d,def) + (Nothing,Nothing) -> Left $ "No field and no default for " ++ show (fldName d) diff --git a/src/Data/Avro/Deriving.hs b/src/Data/Avro/Deriving.hs new file mode 100644 --- /dev/null +++ b/src/Data/Avro/Deriving.hs @@ -0,0 +1,254 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Avro.Deriving +( deriveAvro +, deriveAvro' +, deriveFromAvro +) +where + +import Control.Monad (join) +import Data.Aeson (eitherDecode) +import Data.Char (isAlphaNum) +import qualified Data.Aeson as J +import Data.Avro hiding (decode, encode) +import Data.Avro.Schema as S +import qualified Data.Avro.Types as AT +import Data.ByteString (ByteString) +import Data.Int +import Data.List.NonEmpty (NonEmpty( (:|) )) +import Data.Map (Map) +import Data.Maybe (fromMaybe) +import Data.Semigroup ((<>)) +import Language.Haskell.TH as TH +import Language.Haskell.TH.Syntax + +import Data.Avro.Deriving.NormSchema + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Lazy.Char8 as LBSC8 +import Data.Text (Text) +import qualified Data.Text as T + +-- | Derives Avro from a given schema file. +-- Generates data types, FromAvro and ToAvro instances. +deriveAvro :: FilePath -> Q [Dec] +deriveAvro p = readSchema p >>= deriveAvro' + +deriveAvro' :: Schema -> Q [Dec] +deriveAvro' s = do + let schemas = extractDerivables s + types <- traverse genType schemas + fromAvros <- traverse genFromAvro schemas + toAvros <- traverse genToAvro schemas + pure $ join types <> join fromAvros <> join toAvros + +-- | Derives "read only" Avro from a given schema file. +-- Generates data types and FromAvro. +deriveFromAvro :: FilePath -> Q [Dec] +deriveFromAvro p = do + schemas <- extractDerivables <$> readSchema p + types <- traverse genType schemas + fromAvros <- traverse genFromAvro schemas + pure $ join types <> join fromAvros + +readSchema :: FilePath -> Q Schema +readSchema p = do + qAddDependentFile p + mbSchema <- runIO $ decodeSchema p + case mbSchema of + Left err -> fail $ "Unable to generate AVRO for " <> p <> ": " <> err + Right sch -> pure sch + +genFromAvro :: Schema -> Q [Dec] +genFromAvro (S.Enum n _ _ _ _ _) = + [d| instance FromAvro $(conT $ mkDataTypeName n) where + fromAvro (AT.Enum _ i _) = $([| pure . toEnum|]) i + fromAvro value = $( [|\v -> badValue v $(mkTextLit $ unTN n)|] ) value + |] +genFromAvro (S.Record n _ _ _ _ fs) = + [d| instance FromAvro $(conT $ mkDataTypeName n) where + fromAvro (AT.Record _ r) = $(genFromAvroFieldsExp (mkTextName $ unTN n) fs) r + fromAvro value = $( [|\v -> badValue v $(mkTextLit $ unTN n)|] ) value + |] +genFromAvro _ = pure [] + +genFromAvroFieldsExp :: Name -> [Field] -> Q Exp +genFromAvroFieldsExp n (x:xs) = + [| \r -> + $(let extract fld = [| r .: T.pack $(mkTextLit (fldName fld))|] + ctor = [| $(conE n) <$> $(extract x) |] + in foldl (\expr fld -> [| $expr <*> $(extract fld) |]) ctor xs + ) + |] + +genToAvro :: Schema -> Q [Dec] +genToAvro s@(Enum n _ _ _ vs _) = do + let sname = mkSchemaValueName n + sdef <- schemaDef sname s + idef <- toAvroInstance sname + pure (sdef <> idef) + where + conP' = flip conP [] . mkAdtCtorName n + toAvroInstance sname = + [d| instance ToAvro $(conT $ mkDataTypeName n) where + schema = pure $(varE sname) + toAvro = $([| \x -> + let convert = AT.Enum $(varE sname) (fromEnum $([|x|])) + in $(caseE [|x|] ((\v -> match (conP' v) + (normalB [| convert (T.pack $(mkTextLit v))|]) []) <$> vs)) + |]) + |] + +genToAvro s@(Record n _ _ _ _ fs) = do + let sname = mkSchemaValueName n + sdef <- schemaDef sname s + idef <- toAvroInstance sname + pure (sdef <> idef) + where + toAvroInstance sname = + [d| instance ToAvro $(conT $ mkDataTypeName n) where + toAvro = $(genToAvroFieldsExp sname) + schema = pure $(varE sname) + |] + genToAvroFieldsExp sname = [| \r -> record $(varE sname) + $(let assign fld = [| T.pack $(mkTextLit (fldName fld)) .= $(varE $ mkFieldTextName n fld) r |] + in listE $ assign <$> fs + ) + |] + +schemaDef :: Name -> Schema -> Q [Dec] +schemaDef sname sch = setName sname $ + [d| + x :: Schema + x = fromMaybe undefined (J.decode (LBSC8.pack $(mkLit (LBSC8.unpack $ J.encode sch)))) + |] + +-- | A hack around TemplateHaskell limitation: +-- It is currently not possible to splice variable name in QQ. +-- This function allows to replace hardcoded name into the specified one. +setName :: Name -> Q [Dec] -> Q [Dec] +setName = fmap . map . sn + where + sn n (SigD _ t) = SigD n t + sn n (ValD (VarP _) x y) = ValD (VarP n) x y + sn _ d = d + +genType :: Schema -> Q [Dec] +genType (S.Record n _ _ _ _ fs) = do + flds <- traverse (mkField n) fs + let dname = mkDataTypeName n + sequenceA [genDataType dname flds] +genType (S.Enum n _ _ _ vs _) = do + let dname = mkDataTypeName n + sequenceA [genEnum dname (mkAdtCtorName n <$> vs)] +genType _ = pure [] + +mkFieldTypeName :: S.Type -> Q TH.Type +mkFieldTypeName t = case t of + S.Boolean -> [t| Bool |] + S.Long -> [t| Int64 |] + S.Int -> [t| Int |] + S.Float -> [t| Float |] + S.Double -> [t| Double |] + S.Bytes -> [t| ByteString |] + S.String -> [t| Text |] + S.Union (Null :| [x]) _ -> [t| Maybe $(mkFieldTypeName x) |] -- AppT (ConT $ mkName "Maybe") (mkFieldTypeName x) + S.Union (x :| [Null]) _ -> [t| Maybe $(mkFieldTypeName x) |] --AppT (ConT $ mkName "Maybe") (mkFieldTypeName x) + S.Union (x :| [y]) _ -> [t| Either $(mkFieldTypeName x) $(mkFieldTypeName y) |] -- AppT (AppT (ConT (mkName "Either")) (mkFieldTypeName x)) (mkFieldTypeName y) + S.Union (_ :| _) _ -> error "Unions with more than 2 elements are not yet supported" + S.Record n _ _ _ _ _ -> [t| $(conT $ mkDataTypeName n) |] + S.Map x -> [t| Map Text $(mkFieldTypeName x) |] --AppT (AppT (ConT (mkName "Map")) (ConT $ mkName "Text")) (mkFieldTypeName x) + S.Array x -> [t| [$(mkFieldTypeName x)] |]--AppT (ConT $ Text "[]") (mkFieldTypeName x) + S.NamedType n -> [t| $(conT $ mkDataTypeName n)|] --ConT . mkName . T.unpack . mkDataTypeName $ x + S.Fixed n _ _ _ -> [t| $(conT $ mkDataTypeName n)|] --ConT . mkName . T.unpack . mkDataTypeName $ x + S.Enum n _ _ _ _ _ -> [t| $(conT $ mkDataTypeName n)|] + _ -> error $ "Avro type is not supported: " <> show t + +updateFirst :: (Text -> Text) -> Text -> Text +updateFirst f t = + let (l, ls) = T.splitAt 1 t + in f l <> ls + +decodeSchema :: FilePath -> IO (Either String Schema) +decodeSchema p = eitherDecode <$> LBS.readFile p + +mkAdtCtorName :: TypeName -> Text -> Name +mkAdtCtorName prefix nm = + concatNames (mkDataTypeName prefix) (mkDataTypeName' nm) + +concatNames :: Name -> Name -> Name +concatNames a b = mkName $ nameBase a <> nameBase b + +sanitiseName :: Text -> Text +sanitiseName = + let valid c = isAlphaNum c || c == '\'' || c == '_' + in T.concat . T.split (not . valid) + +mkSchemaValueName :: TypeName -> Name +mkSchemaValueName (TN n) = mkTextName $ "schema'" <> n + +mkDataTypeName :: TypeName -> Name +mkDataTypeName = mkDataTypeName' . unTN + +mkDataTypeName' :: Text -> Name +mkDataTypeName' = + mkTextName . sanitiseName . updateFirst T.toUpper . T.takeWhileEnd (/='.') + +mkFieldTextName :: TypeName -> Field -> Name +mkFieldTextName (TN dn) fld = mkTextName . sanitiseName $ + updateFirst T.toLower dn <> updateFirst T.toUpper (fldName fld) + +mkField :: TypeName -> Field -> Q VarStrictType +mkField prefix field = do + ftype <- mkFieldTypeName (fldType field) + let fName = mkFieldTextName prefix field + pure (fName, defaultStrictness, ftype) + +genEnum :: Name -> [Name] -> Q Dec +#if MIN_VERSION_template_haskell(2,12,0) +genEnum dn vs = do + ders <- sequenceA [[t|Eq|], [t|Show|], [t|Ord|], [t|Enum|]] + pure $ DataD [] dn [] Nothing ((\n -> NormalC n []) <$> vs) [DerivClause Nothing ders] +#elif MIN_VERSION_template_haskell(2,11,0) +genEnum dn vs = do + ders <- sequenceA [[t|Eq|], [t|Show|], [t|Ord|], [t|Enum|]] + pure $ DataD [] dn [] Nothing ((\n -> NormalC n []) <$> vs) ders +#else +genEnum dn vs = do + [ConT eq, ConT sh, ConT or, ConT en] <- sequenceA [[t|Eq|], [t|Show|], [t|Ord|], [t|Enum|]] + pure $ DataD [] dn [] ((\n -> NormalC n []) <$> vs) [eq, sh, or, en] +#endif + +genDataType :: Name -> [VarStrictType] -> Q Dec +#if MIN_VERSION_template_haskell(2,12,0) +genDataType dn flds = do + ders <- sequenceA [[t|Eq|], [t|Show|]] + pure $ DataD [] dn [] Nothing [RecC dn flds] [DerivClause Nothing ders] +#elif MIN_VERSION_template_haskell(2,11,0) +genDataType dn flds = do + ders <- sequenceA [[t|Eq|], [t|Show|]] + pure $ DataD [] dn [] Nothing [RecC dn flds] ders +#else +genDataType dn flds = do + [ConT eq, ConT sh] <- sequenceA [[t|Eq|], [t|Show|]] + pure $ DataD [] dn [] [RecC dn flds] [eq, sh] +#endif + +defaultStrictness :: Strict +#if MIN_VERSION_template_haskell(2,11,0) +defaultStrictness = Bang SourceNoUnpack NoSourceStrictness +#else +defaultStrictness = NotStrict +#endif + +mkTextName :: Text -> Name +mkTextName = mkName . T.unpack + +mkLit :: String -> ExpQ +mkLit = litE . StringL + +mkTextLit :: Text -> ExpQ +mkTextLit = litE . StringL . T.unpack diff --git a/src/Data/Avro/Deriving/NormSchema.hs b/src/Data/Avro/Deriving/NormSchema.hs new file mode 100644 --- /dev/null +++ b/src/Data/Avro/Deriving/NormSchema.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE OverloadedStrings #-} +module Data.Avro.Deriving.NormSchema +where + +import Data.Avro.Schema +import qualified Data.Set as S +import Data.List.NonEmpty (NonEmpty( (:|) )) +import Control.Monad.State.Strict +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.List as L +import Data.Maybe (catMaybes, fromMaybe) +import Data.Semigroup ((<>)) + +-- | Extracts all the records from the schema (flattens the schema) +-- Named types get resolved when needed to include at least one "inlined" +-- schema in each record and to make each record self-contained. +-- Note: Namespaces are not really supported in this version. All the +-- namespaces (including inlined into full names) will be ignored +-- during names resolution. +extractDerivables :: Schema -> [Schema] +extractDerivables s = flip evalState S.empty . normSchema rawRecs <$> rawRecs + where + rawRecs = getTypes s + getTypes rec = case rec of + r@(Record _ _ _ _ _ fs) -> r : (fs >>= (getTypes . fldType)) + Array t -> getTypes t + Union (t1 :| ts) _ -> getTypes t1 <> concatMap getTypes ts + Map t -> getTypes t + e@Enum{} -> [e] + _ -> [] + +-- TODO: Currently ensures normalisation: only in one way +-- that is needed for "extractRecord". +-- it ensures that an "extracted" record is self-contained and +-- all the named types are resolvable within the scope of the schema. +-- The other way around (to each record is inlined only once and is referenced +-- as a named type after that) is not implemented. +normSchema :: [Schema] -- ^ List of all possible records + -> Schema -- ^ Schema to normalise + -> State (S.Set TypeName) Schema +normSchema rs r = case r of + t@(NamedType tn) -> do + let sn = shortName tn + resolved <- get + if S.member sn resolved + then pure t + else do + modify' (S.insert sn) + pure $ fromMaybe (error $ "Unable to resolve schema: " <> show (typeName t)) (findSchema tn) + Array s -> Array <$> normSchema rs s + Map s -> Map <$> normSchema rs s + Record{name = tn} -> do + let sn = shortName tn + modify' (S.insert sn) + flds <- mapM (\fld -> setType fld <$> normSchema rs (fldType fld)) (fields r) + pure $ r { fields = flds } + s -> pure s + where + shortName tn = TN $ T.takeWhileEnd (/='.') (unTN tn) + setType fld t = fld { fldType = t} + fullName s = TN $ maybe (typeName s) (\n -> typeName s <> "." <> n) (namespace s) + findSchema tn = L.find (\s -> name s == tn || fullName s == tn) rs diff --git a/src/Data/Avro/Encode.hs b/src/Data/Avro/Encode.hs new file mode 100644 --- /dev/null +++ b/src/Data/Avro/Encode.hs @@ -0,0 +1,237 @@ +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} + +module Data.Avro.Encode + ( -- * High level interface + getSchema + , encodeAvro + , encodeContainer, encodeContainerWithSync + -- * Lower level interface + , EncodeAvro(..) + , Zag(..) + , putAvro + ) where + +import Prelude as P +import qualified Data.Aeson as A +import qualified Data.Array as Ar +import Data.Ix (Ix) +import Data.Bits +import Data.ByteString.Lazy as BL +import qualified Data.Binary.IEEE754 as IEEE +import Data.ByteString.Lazy.Char8 () +import qualified Data.ByteString as B +import Data.ByteString.Builder +import qualified Data.Foldable as F +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import Data.Int +import Data.List as DL +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.List.NonEmpty as NE +import Data.Monoid +import Data.Maybe (catMaybes, mapMaybe) +import qualified Data.Set as S +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as U +import Data.Word +import Data.Proxy +import System.Entropy (getEntropy) + +import Data.Avro.EncodeRaw +import Data.Avro.Schema as S +import Data.Avro.Types as T +import Data.Avro.Zag +import Data.Avro.Zig + +encodeAvro :: EncodeAvro a => a -> BL.ByteString +encodeAvro = toLazyByteString . putAvro + +-- |Encode chunks of objects into a container, using 16 random bytes for +-- the synchronization markers. +encodeContainer :: EncodeAvro a => [[a]] -> IO BL.ByteString +encodeContainer xss = + do sync <- getEntropy 16 + return $ encodeContainerWithSync (BL.fromStrict sync) xss + +-- |Encode chunks of objects into a container, using the provided +-- ByteString as the synchronization markers. +encodeContainerWithSync :: EncodeAvro a => BL.ByteString -> [[a]] -> BL.ByteString +encodeContainerWithSync syncBytes xss = + toLazyByteString $ + lazyByteString avroMagicBytes <> + putAvro (HashMap.fromList [("avro.schema", A.encode objSchema), ("avro.codec","null")] :: HashMap Text BL.ByteString) <> + lazyByteString syncBytes <> + foldMap putBlocks xss + where + objSchema = getSchema (P.head (P.head xss)) + putBlocks ys = + let nrObj = P.length ys + nrBytes = BL.length theBytes + theBytes = toLazyByteString $ foldMap putAvro ys + in putAvro nrObj <> + putAvro nrBytes <> + lazyByteString theBytes <> + lazyByteString syncBytes + avroMagicBytes :: BL.ByteString + avroMagicBytes = "Obj" <> BL.pack [1] + +-- XXX make an instance 'EncodeAvro Schema' +-- Would require a schema schema... +-- encodeSchema :: EncodeAvro a => a -> BL.ByteString +-- encodeSchema = toLazyByteString . putAvro . getSchema + +putAvro :: EncodeAvro a => a -> Builder +putAvro = fst . runAvro . avro + +getSchema :: forall a. EncodeAvro a => a -> Schema +getSchema _ = getType (Proxy :: Proxy a) + +getType :: EncodeAvro a => Proxy a -> Type +getType p = snd (runAvro (avro (undefined `asProxyTypeOf` p))) +-- N.B. ^^^ Local knowledge that 'fst' won't be used, +-- so the bottom of 'undefined' will not escape so long as schema creation +-- remains lazy in the argument. + +newtype AvroM = AvroM { runAvro :: (Builder,Type) } + +class EncodeAvro a where + avro :: a -> AvroM + +-- class PutAvro a where +-- putAvro :: a -> Builder + +avroInt :: forall a. (FiniteBits a, Integral a, EncodeRaw a) => a -> AvroM +avroInt n = AvroM (encodeRaw n, S.Int) + +avroLong :: forall a. (FiniteBits a, Integral a, EncodeRaw a) => a -> AvroM +avroLong n = AvroM (encodeRaw n, S.Long) + +-- Put a Haskell Int. +putI :: Int -> Builder +putI = encodeRaw + +instance EncodeAvro Int where + avro = avroInt +instance EncodeAvro Int8 where + avro = avroInt +instance EncodeAvro Int16 where + avro = avroInt +instance EncodeAvro Int32 where + avro = avroInt +instance EncodeAvro Int64 where + avro = avroInt +instance EncodeAvro Word8 where + avro = avroInt +instance EncodeAvro Word16 where + avro = avroInt +instance EncodeAvro Word32 where + avro = avroLong +instance EncodeAvro Word64 where + avro = avroLong +instance EncodeAvro Text where + avro t = + let bs = T.encodeUtf8 t + in AvroM (encodeRaw (B.length bs) <> byteString bs, S.String) +instance EncodeAvro TL.Text where + avro t = + let bs = TL.encodeUtf8 t + in AvroM (encodeRaw (BL.length bs) <> lazyByteString bs, S.String) + +instance EncodeAvro ByteString where + avro bs = AvroM (encodeRaw (BL.length bs) <> lazyByteString bs, S.Bytes) + +instance EncodeAvro B.ByteString where + avro bs = AvroM (encodeRaw (B.length bs) <> byteString bs, S.Bytes) + +instance EncodeAvro String where + avro s = let t = T.pack s in avro t + +instance EncodeAvro Double where + avro d = AvroM (word64LE (IEEE.doubleToWord d), S.Double) + +instance EncodeAvro Float where + avro d = AvroM (word32LE (IEEE.floatToWord d), S.Float) + +-- Terminating word for array and map types. +long0 :: Builder +long0 = encodeRaw (0 :: Word64) + +instance EncodeAvro a => EncodeAvro [a] where + avro a = AvroM ( if DL.null a then long0 else encodeRaw (F.length a) <> foldMap putAvro a <> long0 + , S.Array (getType (Proxy :: Proxy a)) + ) + +instance (Ix i, EncodeAvro a) => EncodeAvro (Ar.Array i a) where + avro a = AvroM ( if F.length a == 0 then long0 else encodeRaw (F.length a) <> foldMap putAvro a <> long0 + , S.Array (getType (Proxy :: Proxy a)) + ) +instance EncodeAvro a => EncodeAvro (V.Vector a) where + avro a = AvroM ( if V.null a then long0 else encodeRaw (F.length a) <> foldMap putAvro a <> long0 + , S.Array (getType (Proxy :: Proxy a)) + ) +instance (U.Unbox a, EncodeAvro a) => EncodeAvro (U.Vector a) where + avro a = AvroM ( if U.null a then long0 else encodeRaw (U.length a) <> foldMap putAvro (U.toList a) <> long0 + , S.Array (getType (Proxy :: Proxy a)) + ) + +instance EncodeAvro a => EncodeAvro (S.Set a) where + avro a = AvroM ( if S.null a then long0 else encodeRaw (F.length a) <> foldMap putAvro a <> long0 + , S.Array (getType (Proxy :: Proxy a)) + ) + +instance EncodeAvro a => EncodeAvro (HashMap Text a) where + avro hm = AvroM ( if HashMap.null hm then long0 else putI (F.length hm) <> foldMap putKV (HashMap.toList hm) <> long0 + , S.Map (getType (Proxy :: Proxy a)) + ) + where putKV (k,v) = putAvro k <> putAvro v + +-- XXX more from containers +-- XXX Unordered containers + +-- | Maybe is modeled as a sum type `{null, a}`. +instance EncodeAvro a => EncodeAvro (Maybe a) where + avro Nothing = AvroM (putI 0 , S.mkUnion (S.Null:|[S.Int])) + avro (Just x) = AvroM (putI 1 <> putAvro x, S.mkUnion (S.Null:|[S.Int])) + +instance EncodeAvro () where + avro () = AvroM (mempty, S.Null) + +instance EncodeAvro Bool where + avro b = AvroM (word8 $ fromIntegral $ fromEnum b, S.Boolean) + +-------------------------------------------------------------------------------- +-- Common Intermediate Representation Encoding + +instance EncodeAvro (T.Value Type) where + avro v = + case v of + T.Null -> avro () + T.Boolean b -> avro b + T.Int i -> avro i + T.Long i -> avro i + T.Float f -> avro f + T.Double d -> avro d + T.Bytes bs -> avro bs + T.String t -> avro t + T.Array vec -> avro vec + T.Map hm -> avro hm + T.Record ty hm -> + let bs = foldMap putAvro (mapMaybe (`HashMap.lookup` hm) fs) + fs = P.map fldName (fields ty) + in AvroM (bs, ty) + T.Union opts sel val | F.length opts > 0 -> + case DL.elemIndex sel (NE.toList opts) of + Just idx -> AvroM (putI idx <> putAvro val, S.mkUnion opts) + Nothing -> error "Union encoding specifies type not found in schema" + T.Fixed bs -> avro bs + T.Enum sch@S.Enum{..} ix t -> AvroM (putI ix, sch) diff --git a/src/Data/Avro/EncodeRaw.hs b/src/Data/Avro/EncodeRaw.hs new file mode 100644 --- /dev/null +++ b/src/Data/Avro/EncodeRaw.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Data.Avro.EncodeRaw + ( EncodeRaw(..) + ) where + +import Data.Avro.Zig +import Data.Bits +import Data.ByteString.Builder +import Data.Int +import Data.Monoid +import Data.Word + +putNonNegative :: forall a. (FiniteBits a, Integral a) => a -> Builder +putNonNegative n = if n .&. complement 0x7F == 0 + then word8 $ fromIntegral (n .&. 0x7f) + else word8 (0x80 .|. (fromIntegral n .&. 0x7F)) <> putNonNegative (n `shiftR` 7) + +class EncodeRaw a where + encodeRaw :: a -> Builder + +instance EncodeRaw Word where + encodeRaw = putNonNegative + {-# INLINE encodeRaw #-} + +instance EncodeRaw Word8 where + encodeRaw = putNonNegative + {-# INLINE encodeRaw #-} + +instance EncodeRaw Word16 where + encodeRaw = putNonNegative + {-# INLINE encodeRaw #-} + +instance EncodeRaw Word32 where + encodeRaw = putNonNegative + {-# INLINE encodeRaw #-} + +instance EncodeRaw Word64 where + encodeRaw = putNonNegative + {-# INLINE encodeRaw #-} + +instance EncodeRaw Int where + encodeRaw = encodeRaw . zig + {-# INLINE encodeRaw #-} + +instance EncodeRaw Int8 where + encodeRaw = encodeRaw . zig + {-# INLINE encodeRaw #-} + +instance EncodeRaw Int16 where + encodeRaw = encodeRaw . zig + {-# INLINE encodeRaw #-} + +instance EncodeRaw Int32 where + encodeRaw = encodeRaw . zig + {-# INLINE encodeRaw #-} + +instance EncodeRaw Int64 where + encodeRaw = encodeRaw . zig + {-# INLINE encodeRaw #-} diff --git a/src/Data/Avro/Schema.hs b/src/Data/Avro/Schema.hs new file mode 100644 --- /dev/null +++ b/src/Data/Avro/Schema.hs @@ -0,0 +1,521 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +-- | Avro 'Schema's, represented here as values of type 'Schema', +-- describe the serialization and de-serialization of values. +-- +-- In Avro schemas are compose-able such that encoding data under a schema and +-- decoding with a variant, such as newer or older version of the original +-- schema, can be accomplished by using the 'Data.Avro.Deconflict' module. +module Data.Avro.Schema + ( + -- * Schema description types + Schema, Type(..) + , Field(..), Order(..) + , TypeName(..) + , mkEnum, mkUnion + , validateSchema + -- * Lower level utilities + , typeName + , buildTypeEnvironment + , Result(..) + ) where + +import Prelude as P +import Control.Applicative +import Control.Monad.Except +import Control.Monad.State.Strict +import qualified Control.Monad.Fail as MF +import qualified Data.Aeson as A +import Data.Aeson ((.=),object,(.:?),(.:),(.!=),FromJSON(..),ToJSON(..)) +import Data.Aeson.Types (Parser,typeMismatch) +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.HashMap.Strict as HashMap +import Data.Hashable +import qualified Data.List as L +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.List.NonEmpty as NE +import Data.Maybe (catMaybes, fromMaybe) +import Data.Monoid ((<>), First(..)) +import qualified Data.Set as S +import Data.String +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding as T +import qualified Data.Vector as V +import qualified Data.Avro.Types as Ty +import qualified Data.IntMap as IM +import Data.Int +import Text.Show.Functions + +-- |An Avro schema is either +-- * A "JSON object in the form `{"type":"typeName" ...` +-- * A "JSON string, naming a defined type" (basic type w/o free variables/names) +-- * A "JSON array, representing a union" +-- +-- N.B. It is possible to create a Haskell value (of Schema type) that is +-- not a valid Avro schema by violating one of the above or one of the +-- conditions called out in 'validateSchema'. +type Schema = Type + +-- |Avro types are considered either primitive (string, int, etc) or +-- complex/declared (structures, unions etc). +data Type + = + -- Basic types + Null + | Boolean + | Int | Long + | Float | Double + | Bytes | String + | Array { item :: Type } + | Map { values :: Type } + | NamedType TypeName + -- Declared types + | Record { name :: TypeName + , namespace :: Maybe Text + , aliases :: [TypeName] + , doc :: Maybe Text + , order :: Maybe Order + , fields :: [Field] + } + | Enum { name :: TypeName + , namespace :: Maybe Text + , aliases :: [TypeName] + , doc :: Maybe Text + , symbols :: [Text] + , symbolLookup :: Int64 -> Maybe Text + } + | Union { options :: NonEmpty Type + , unionLookup :: Int64 -> Maybe Type + } + | Fixed { name :: TypeName + , namespace :: Maybe Text + , aliases :: [TypeName] + , size :: Integer + } + deriving (Show) + +instance Eq Type where + Null == Null = True + Boolean == Boolean = True + Int == Int = True + Long == Long = True + Float == Float = True + Double == Double = True + Bytes == Bytes = True + String == String = True + Array ty == Array ty2 = ty == ty2 + Map ty == Map ty2 = ty == ty2 + NamedType t == NamedType t2 = t == t2 + Record _ _ _ _ _ fs == Record _ _ _ _ _ fs2 = fs == fs2 + Enum _ _ _ _ s _ == Enum _ _ _ _ s2 _ = s == s2 + Union a _ == Union b _ = a == b + Fixed _ _ _ s == Fixed _ _ _ s2 = s == s2 + _ == _ = False + +-- | @mkEnum name aliases namespace docs syms@ Constructs an `Enum` schema using +-- the enumeration type's name, aliases (if any), namespace, documentation, and list of +-- symbols that inhabit the enumeration. +mkEnum :: TypeName -> [TypeName] -> Maybe Text -> Maybe Text -> [Text] -> Type +mkEnum n as ns d ss = Enum n ns as d ss (\i -> IM.lookup (fromIntegral i) mp) + where + mp = IM.fromList (zip [0..] ss) + +-- | @mkUnion subTypes@ Defines a union of the provided subTypes. N.B. it is +-- invalid Avro to include another union or to have more than one of the same +-- type as a direct member of the union. No check is done for this condition! +mkUnion :: NonEmpty Type -> Type +mkUnion os = Union os (\i -> IM.lookup (fromIntegral i) mp) + where mp = IM.fromList (zip [0..] $ NE.toList os) + +newtype TypeName = TN { unTN :: T.Text } + deriving (Eq, Ord) + +instance Show TypeName where + show (TN s) = show s + +instance Monoid TypeName where + mempty = TN mempty + mappend (TN a) (TN b) = TN (a <> b) + +instance IsString TypeName where + fromString = TN . fromString + +instance Hashable TypeName where + hashWithSalt s (TN t) = hashWithSalt (hashWithSalt s ("AvroTypeName" :: Text)) t + +-- |Get the name of the type. In the case of unions, get the name of the +-- first value in the union schema. +typeName :: Type -> Text +typeName bt = + case bt of + Null -> "null" + Boolean -> "boolean" + Int -> "int" + Long -> "long" + Float -> "float" + Double -> "double" + Bytes -> "bytes" + String -> "string" + Array _ -> "array" + Map _ -> "map" + NamedType (TN t) -> t + Union (x:|_) _ -> typeName x + _ -> unTN $ name bt + +data Field = Field { fldName :: Text + , fldAliases :: [Text] + , fldDoc :: Maybe Text + , fldOrder :: Maybe Order + , fldType :: Type + , fldDefault :: Maybe (Ty.Value Type) + } + deriving (Eq, Show) + +data Order = Ascending | Descending | Ignore + deriving (Eq, Ord, Show) + +instance FromJSON Type where + parseJSON (A.String s) = + case s of + "null" -> return Null + "boolean" -> return Boolean + "int" -> return Int + "long" -> return Long + "float" -> return Float + "double" -> return Double + "bytes" -> return Bytes + "string" -> return String + somename -> return (NamedType (TN somename)) + parseJSON (A.Object o) = + do ty <- o .: ("type" :: Text) + case ty of + "map" -> Map <$> o .: ("values" :: Text) + "array" -> Array <$> o .: ("items" :: Text) + "record" -> + Record <$> o .: ("name" :: Text) + <*> o .:? ("namespace" :: Text) + <*> o .:? ("aliases" :: Text) .!= [] + <*> o .:? ("doc" :: Text) + <*> o .:? ("order" :: Text) .!= Just Ascending + <*> o .: ("fields" :: Text) + "enum" -> + mkEnum <$> o .: ("name" :: Text) + <*> o .:? ("aliases" :: Text) .!= [] + <*> o .:? ("namespace" :: Text) + <*> o .:? ("doc" :: Text) + <*> o .: ("symbols" :: Text) + "fixed" -> + Fixed <$> o .: ("name" :: Text) + <*> o .:? ("namespace" :: Text) + <*> o .:? ("aliases" :: Text) .!= [] + <*> o .: ("size" :: Text) + s -> fail $ "Unrecognized object type: " <> s + parseJSON (A.Array arr) | V.length arr > 0 = + mkUnion . NE.fromList <$> mapM parseJSON (V.toList arr) + parseJSON foo = typeMismatch "Invalid JSON for Avro Schema" foo + +instance ToJSON Type where + toJSON bt = + case bt of + Null -> A.String "null" + Boolean -> A.String "boolean" + Int -> A.String "int" + Long -> A.String "long" + Float -> A.String "float" + Double -> A.String "double" + Bytes -> A.String "bytes" + String -> A.String "string" + Array tn -> object [ "type" .= ("array" :: Text), "items" .= tn ] + Map tn -> object [ "type" .= ("map" :: Text), "values" .= tn ] + NamedType (TN tn) -> A.String tn + Record {..} -> + let opts = catMaybes + [ ("order" .=) <$> order + , ("namespace" .=) <$> namespace + , ("doc" .=) <$> doc + ] + in object $ opts ++ + [ "type" .= ("record" :: Text) + , "name" .= name + , "aliases" .= aliases + , "fields" .= fields + ] + Enum {..} -> + let opts = catMaybes + [ ("namespace" .=) <$> namespace + , ("doc" .=) <$> doc + ] + in object $ opts ++ + [ "type" .= ("enum" :: Text) + , "name" .= name + , "aliases" .= aliases + , "symbols" .= symbols + ] + Union {..} -> A.Array $ V.fromList $ P.map toJSON (NE.toList options) + Fixed {..} -> + let opts = catMaybes + [ ("namespace" .=) <$> namespace ] + in object $ opts ++ + [ "type" .= ("fixed" :: Text) + , "name" .= name + , "aliases" .= aliases + , "size" .= size + ] + +instance ToJSON TypeName where + toJSON (TN t) = A.String t + +instance FromJSON TypeName where + parseJSON (A.String s) = return (TN s) + parseJSON j = typeMismatch "TypeName" j + +instance FromJSON Field where + parseJSON (A.Object o) = + do nm <- o .: "name" + doc <- o .:? "doc" + ty <- o .: "type" + let err = fail "Haskell Avro bindings does not support default for aliased or recursive types at this time." + defM <- o .:? "default" + def <- case parseAvroJSON err ty <$> defM of + Just (Success x) -> return (Just x) + Just (Error e) -> fail e + Nothing -> return Nothing + od <- o .:? ("order" :: Text) .!= Just Ascending + al <- o .:? ("aliases" :: Text) .!= [] + return $ Field nm al doc od ty def + + parseJSON j = typeMismatch "Field " j + +instance ToJSON Field where + toJSON Field {..} = + let opts = catMaybes + [ ("order" .=) <$> fldOrder + , ("doc" .=) <$> fldDoc + , ("default" .=) <$> fldDefault + ] + in object $ opts ++ + [ "name" .= fldName + , "type" .= fldType + , "aliases" .= fldAliases + ] + +instance ToJSON (Ty.Value Type) where + toJSON av = + case av of + Ty.Null -> A.Null + Ty.Boolean b -> A.Bool b + Ty.Int i -> A.Number (fromIntegral i) + Ty.Long i -> A.Number (fromIntegral i) + Ty.Float f -> A.Number (realToFrac f) + Ty.Double d -> A.Number (realToFrac d) + Ty.Bytes bs -> A.String ("\\u" <> T.decodeUtf8 (Base16.encode bs)) + Ty.String t -> A.String t + Ty.Array vec -> A.Array (V.map toJSON vec) + Ty.Map mp -> A.Object (HashMap.map toJSON mp) + Ty.Record _ flds -> A.Object (HashMap.map toJSON flds) + Ty.Union _ _ Ty.Null -> A.Null + Ty.Union _ ty val -> object [ typeName ty .= val ] + Ty.Fixed bs -> A.String ("\\u" <> T.decodeUtf8 (Base16.encode bs)) -- XXX the example wasn't literal - this should be an actual bytestring... somehow. + Ty.Enum _ _ txt -> A.String txt + +data Result a = Success a | Error String + deriving (Eq,Ord,Show) + +instance Monad Result where + return = pure + Success a >>= k = k a + Error e >>= _ = Error e + fail = MF.fail +instance Functor Result where + fmap f (Success x) = Success (f x) + fmap _ (Error e) = Error e +instance MF.MonadFail Result where + fail = Error +instance MonadError String Result where + throwError = fail + catchError a@(Success _) _ = a + catchError (Error e) k = k e +instance Applicative Result where + pure = Success + (<*>) = ap +instance Alternative Result where + empty = mzero + (<|>) = mplus +instance MonadPlus Result where + mzero = fail "mzero" + mplus a@(Success _) _ = a + mplus _ b = b +instance Monoid (Result a) where + mempty = fail "Empty Result" + mappend = mplus +instance Foldable Result where + foldMap _ (Error _) = mempty + foldMap f (Success y) = f y + foldr _ z (Error _) = z + foldr f z (Success y) = f y z +instance Traversable Result where + traverse _ (Error err) = pure (Error err) + traverse f (Success v) = Success <$> f v + +-- |Parse JSON-encoded avro data. +parseAvroJSON :: (Text -> Maybe Type) -> Type -> A.Value -> Result (Ty.Value Type) +parseAvroJSON env (NamedType (TN tn)) av = + case env tn of + Nothing -> fail $ "Could not resolve type name for " <> show tn + Just t -> parseAvroJSON env t av +parseAvroJSON env ty av = + case av of + A.String s -> + case ty of + String -> return $ Ty.String s + Enum {..} -> + if s `elem` symbols + then return $ Ty.Enum ty (maybe (error "IMPOSSIBLE BUG") id $ lookup s (zip symbols [0..])) s + else fail $ "JSON string is not one of the expected symbols for enum '" <> show name <> "': " <> T.unpack s + Union tys _ -> do + f <- tryAllTypes env tys av + maybe (fail $ "No match for String in union '" <> show (typeName ty) <> "'.") pure f + _ -> avroTypeMismatch ty "string" + A.Bool b -> case ty of + Boolean -> return $ Ty.Boolean b + _ -> avroTypeMismatch ty "boolean" + A.Number i -> + case ty of + Int -> return $ Ty.Int (floor i) + Long -> return $ Ty.Long (floor i) + Float -> return $ Ty.Float (realToFrac i) + Double -> return $ Ty.Double (realToFrac i) + Union tys _ -> do + f <- tryAllTypes env tys av + maybe (fail $ "No match for Number in union '" <> show (typeName ty) <> "'.") pure f + _ -> avroTypeMismatch ty "number" + A.Array vec -> + case ty of + Array t -> Ty.Array <$> V.mapM (parseAvroJSON env t) vec + Union tys _ -> do + f <- tryAllTypes env tys av + maybe (fail $ "No match for Array in union '" <> show (typeName ty) <> "'.") pure f + _ -> avroTypeMismatch ty "array" + A.Object obj -> + case ty of + Map mTy -> Ty.Map <$> mapM (parseAvroJSON env mTy) obj + Record {..} -> + do let lkAndParse f = + case HashMap.lookup (fldName f) obj of + Nothing -> case fldDefault f of + Just v -> return v + Nothing -> fail $ "Decode failure: No record field '" <> T.unpack (fldName f) <> "' and no default in schema." + Just v -> parseAvroJSON env (fldType f) v + Ty.Record ty . HashMap.fromList <$> mapM (\f -> (fldName f,) <$> lkAndParse f) fields + Union tys _ -> do + f <- tryAllTypes env tys av + maybe (fail $ "No match for given record in union '" <> show (typeName ty) <> "'.") pure f + _ -> avroTypeMismatch ty "object" + A.Null -> case ty of + Null -> return Ty.Null + Union us _ | Null `elem` NE.toList us -> return $ Ty.Union us Null Ty.Null + _ -> avroTypeMismatch ty "null" + +tryAllTypes :: (Text -> Maybe Type) -> NonEmpty Type -> A.Value -> Result (Maybe (Ty.Value Type)) +tryAllTypes env tys av = + getFirst <$> foldMap (\t -> First . Just <$> parseAvroJSON env t av) (NE.toList tys) + `catchError` (\_ -> return mempty) + +avroTypeMismatch :: Type -> Text -> Result a +avroTypeMismatch expected actual = + fail $ "Could not resolve type '" <> T.unpack actual <> "' with expected type: " <> show expected + +instance ToJSON Order where + toJSON o = + case o of + Ascending -> A.String "ascending" + Descending -> A.String "descending" + Ignore -> A.String "ignore" + +instance FromJSON Order where + parseJSON (A.String s) = + case s of + "ascending" -> return Ascending + "descending" -> return Descending + "ignore" -> return Ignore + _ -> fail $ "Unknown string for order: " <> T.unpack s + parseJSON j = typeMismatch "Order" j + +-- | Placeholder NO-OP function! +-- +-- Validates a schema to ensure: +-- +-- * All types are defined +-- * Unions do not directly contain other unions +-- * Unions are not ambiguous (may not contain more than one schema with +-- the same type except for named types of record, fixed and enum) +-- * Default values for unions can be cast as the type indicated by the +-- first structure. +-- * Default values can be cast/de-serialize correctly. +-- * Named types are resolvable +validateSchema :: Schema -> Parser () +validateSchema _sch = return () -- XXX TODO + +-- | @buildTypeEnvironment schema@ builds a function mapping type names to +-- the types declared in the traversed schema. Notice this function does not +-- currently handle namespaces in a correct manner, possibly allowing +-- for bad environment lookups when used on complex schemas. +buildTypeEnvironment :: Applicative m => (TypeName -> m Type) -> Type -> TypeName -> m Type +buildTypeEnvironment failure from = + \forTy -> case HashMap.lookup forTy mp of + Nothing -> failure forTy + Just res -> pure res + where + mp = HashMap.fromList $ go from + go :: Type -> [(TypeName,Type)] + go ty = + let mk :: TypeName -> [TypeName] -> Maybe Text -> [(TypeName,Type)] + mk n as ns = + let unqual = n:as + qual = maybe [] (\x -> P.map (mappend (TN x <> ".")) unqual) ns + in zip (unqual ++ qual) (repeat ty) + in case ty of + Record {..} -> mk name aliases namespace ++ concatMap (go . fldType) fields + Enum {..} -> mk name aliases namespace + Union {..} -> concatMap go options + Fixed {..} -> mk name aliases namespace + Array {..} -> go item + _ -> [] + +-- TODO: Currently ensures normalisation: only in one way +-- that is needed for "extractRecord". +-- it ensures that an "extracted" record is self-contained and +-- all the named types are resolvable within the scope of the schema. +-- The other way around (to each record is inlined only once and is referenced +-- as a named type after that) is not implemented. +normSchema :: [Schema] -- ^ List of all possible records + -> Schema -- ^ Schema to normalise + -> State (S.Set TypeName) Schema +normSchema rs r = case r of + t@(NamedType tn) -> do + let sn = shortName tn + resolved <- get + if S.member sn resolved + then pure t + else do + modify' (S.insert sn) + pure $ fromMaybe (error $ "Unable to resolve schema: " <> show (typeName t)) (findSchema tn) + + Array s -> Array <$> normSchema rs s + Map s -> Map <$> normSchema rs s + Record{name = tn} -> do + let sn = shortName tn + modify' (S.insert sn) + flds <- mapM (\fld -> setType fld <$> normSchema rs (fldType fld)) (fields r) + pure $ r { fields = flds } + s -> pure s + where + shortName tn = TN $ T.takeWhileEnd (/='.') (unTN tn) + setType fld t = fld { fldType = t} + fullName s = TN $ maybe (typeName s) (\n -> typeName s <> "." <> n) (namespace s) + findSchema tn = L.find (\s -> name s == tn || fullName s == tn) rs diff --git a/src/Data/Avro/Types.hs b/src/Data/Avro/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Avro/Types.hs @@ -0,0 +1,25 @@ +module Data.Avro.Types where + +import Data.ByteString +import Data.HashMap.Strict (HashMap) +import Data.Int +import Data.List.NonEmpty (NonEmpty) +import Data.Text +import Data.Vector + +data Value f + = Null + | Boolean !Bool + | Int {-# UNPACK #-} !Int32 + | Long {-# UNPACK #-} !Int64 + | Float {-# UNPACK #-} !Float + | Double {-# UNPACK #-} !Double + | Bytes {-# UNPACK #-} !ByteString + | String {-# UNPACK #-} !Text + | Array (Vector (Value f)) -- ^ Dynamically enforced monomorphic type. + | Map (HashMap Text (Value f)) -- ^ Dynamically enforced monomorphic type + | Record f (HashMap Text (Value f)) -- Order and a map + | Union (NonEmpty f) f (Value f) -- ^ Set of union options, schema for selected option, and the actual value. + | Fixed {-# UNPACK #-} !ByteString + | Enum f {-# UNPACK #-} !Int Text -- ^ An enum is a set of the possible symbols (the schema) and the selected symbol + deriving (Eq, Show) diff --git a/src/Data/Avro/Zag.hs b/src/Data/Avro/Zag.hs new file mode 100644 --- /dev/null +++ b/src/Data/Avro/Zag.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE TypeFamilies #-} + +module Data.Avro.Zag + ( Zag(..) + ) where + +import Data.Bits +import Data.Int +import Data.Word + +class Zag a where + type Zagged a + zag :: a -> Zagged a + +instance Zag Word8 where + type Zagged Word8 = Int8 + zag n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1) + {-# INLINE zag #-} + +instance Zag Word16 where + type Zagged Word16 = Int16 + zag n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1) + {-# INLINE zag #-} + +instance Zag Word32 where + type Zagged Word32 = Int32 + zag n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1) + {-# INLINE zag #-} + +instance Zag Word64 where + type Zagged Word64 = Int64 + zag n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1) + {-# INLINE zag #-} + +instance Zag Word where + type Zagged Word = Int + zag n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1) + {-# INLINE zag #-} diff --git a/src/Data/Avro/Zig.hs b/src/Data/Avro/Zig.hs new file mode 100644 --- /dev/null +++ b/src/Data/Avro/Zig.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE TypeFamilies #-} + +module Data.Avro.Zig + ( Zig(..) + ) where + +import Data.Bits +import Data.Int +import Data.Word + +class Zig a where + type Zigged a + zig :: a -> Zigged a + +instance Zig Int8 where + type Zigged Int8 = Word8 + zig n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` (finiteBitSize n - 1)) + {-# INLINE zig #-} + +instance Zig Int16 where + type Zigged Int16 = Word16 + zig n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` (finiteBitSize n - 1)) + {-# INLINE zig #-} + +instance Zig Int32 where + type Zigged Int32 = Word32 + zig n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` (finiteBitSize n - 1)) + {-# INLINE zig #-} + +instance Zig Int64 where + type Zigged Int64 = Word64 + zig n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` (finiteBitSize n - 1)) + {-# INLINE zig #-} + +instance Zig Int where + type Zigged Int = Word + zig n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` (finiteBitSize n - 1)) + {-# INLINE zig #-} diff --git a/test/Avro/Codec/ArraySpec.hs b/test/Avro/Codec/ArraySpec.hs new file mode 100644 --- /dev/null +++ b/test/Avro/Codec/ArraySpec.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Avro.Codec.ArraySpec (spec) where + +import Data.Avro +import Data.Map (Map) +import qualified Data.Map as M +import Data.Text as T + +import Test.Hspec +import qualified Test.QuickCheck as Q + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +spec :: Spec +spec = describe "Avro.Codec.ArraySpec" $ do + it "list roundtip" $ Q.property $ \(xs :: [Int]) -> decode (schemaOf xs) (encode xs) == Success xs + + it "map roundtrip" $ Q.property $ \(xs :: Map String Int) -> + let xs' = M.mapKeys T.pack xs + in decode (schemaOf xs') (encode xs') == Success xs' diff --git a/test/Avro/Codec/BoolSpec.hs b/test/Avro/Codec/BoolSpec.hs new file mode 100644 --- /dev/null +++ b/test/Avro/Codec/BoolSpec.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Avro.Codec.BoolSpec (spec) where + +import Test.Hspec +import qualified Test.QuickCheck as Q + +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Tagged +import Data.Text +import qualified Data.ByteString.Lazy as BL + +import Data.Avro +import Data.Avro.Schema +import qualified Data.Avro.Types as AT + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +-- Avro definition for Bool + +newtype OnlyBool = OnlyBool + { onlyBoolValue :: Bool + } deriving (Show, Eq) + +onlyBoolSchema :: Schema +onlyBoolSchema = + let fld nm = Field nm [] Nothing Nothing + in Record "OnlyBool" (Just "test.contract") [] Nothing Nothing + [ fld "onlyBoolValue" Boolean Nothing + ] + +instance ToAvro OnlyBool where + toAvro sa = record onlyBoolSchema + [ "onlyBoolValue" .= onlyBoolValue sa + ] + schema = pure onlyBoolSchema + +instance FromAvro OnlyBool where + fromAvro (AT.Record _ r) = + OnlyBool <$> r .: "onlyBoolValue" + +spec :: Spec +spec = describe "Avro.Codec.BoolSpec" $ do + let x = untag (schema :: Tagged OnlyBool Type) + it "should encode True correctly" $ do + let trueEncoding = BL.singleton 0x01 + encode (OnlyBool True) `shouldBe` trueEncoding + + it "should encode False correctly" $ do + let falseEncoding = BL.singleton 0x00 + encode (OnlyBool False) `shouldBe` falseEncoding + + it "should encode then decode True correctly" $ do + decode x (encode $ OnlyBool True) `shouldBe` Success (OnlyBool True) + + it "should encode then decode False correctly" $ do + decode x (encode $ OnlyBool False) `shouldBe` Success (OnlyBool False) diff --git a/test/Avro/Codec/CodecRawSpec.hs b/test/Avro/Codec/CodecRawSpec.hs new file mode 100644 --- /dev/null +++ b/test/Avro/Codec/CodecRawSpec.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Avro.Codec.CodecRawSpec (spec) where + +import Data.Avro.DecodeRaw +import Data.Avro.EncodeRaw +import Data.Binary.Get +import Data.ByteString.Builder +import Data.Int +import Data.Word +import Test.Hspec +import qualified Test.QuickCheck as Q + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +spec :: Spec +spec = describe "Avro.Codec.CodecRawSpec" $ do + it "codec raw round trip Int" $ Q.property $ \(w :: Int) -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w + it "codec raw round trip Int8" $ Q.property $ \(w :: Int8) -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w + it "codec raw round trip Int16" $ Q.property $ \(w :: Int16) -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w + it "codec raw round trip Int32" $ Q.property $ \(w :: Int32) -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w + it "codec raw round trip Int64" $ Q.property $ \(w :: Int64) -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w + it "codec raw round trip Word" $ Q.property $ \(w :: Word) -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w + it "codec raw round trip Word8" $ Q.property $ \(w :: Word8) -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w + it "codec raw round trip Word16" $ Q.property $ \(w :: Word16) -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w + it "codec raw round trip Word32" $ Q.property $ \(w :: Word32) -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w + it "codec raw round trip Word64" $ Q.property $ \(w :: Word64) -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w diff --git a/test/Avro/Codec/DoubleSpec.hs b/test/Avro/Codec/DoubleSpec.hs new file mode 100644 --- /dev/null +++ b/test/Avro/Codec/DoubleSpec.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Avro.Codec.DoubleSpec (spec) where + +import Data.Avro +import Data.Avro.Schema +import Data.Tagged +import Test.Hspec +import qualified Data.Avro.Types as AT +import qualified Data.ByteString.Lazy as BL +import qualified Test.QuickCheck as Q + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +newtype OnlyDouble = OnlyDouble + {onlyDoubleValue :: Double + } deriving (Show, Eq) + +onlyDoubleSchema :: Schema +onlyDoubleSchema = + let fld nm = Field nm [] Nothing Nothing + in Record "OnlyDouble" (Just "test.contract") [] Nothing Nothing + [ fld "onlyDoubleValue" Double Nothing + ] + +instance ToAvro OnlyDouble where + toAvro sa = record onlyDoubleSchema + [ "onlyDoubleValue" .= onlyDoubleValue sa ] + schema = pure onlyDoubleSchema + +instance FromAvro OnlyDouble where + fromAvro (AT.Record _ r) = + OnlyDouble <$> r .: "onlyDoubleValue" + +spec :: Spec +spec = describe "Avro.Codec.DoubleSpec" $ do + it "Can decode 0.89" $ do + let expectedBuffer = BL.pack [123, 20, -82, 71, -31, 122, -20, 63] + let value = OnlyDouble 0.89 + encode value `shouldBe` expectedBuffer + + it "Can decode -2.0" $ do + let expectedBuffer = BL.pack [0, 0, 0, 0, 0, 0, 0, -64] + let value = OnlyDouble (-2.0) + encode value `shouldBe` expectedBuffer + + it "Can decode 1.0" $ do + let expectedBuffer = [0, 0, 0, 0, 0, 0, -16, 63] + let value = OnlyDouble 1.0 + BL.unpack (encode value) `shouldBe` expectedBuffer + + it "Can decode encoded Double values" $ do + Q.property $ \(d :: Double) -> + let x = untag (schema :: Tagged OnlyDouble Type) in + decode x (encode (OnlyDouble d)) == Success (OnlyDouble d) diff --git a/test/Avro/Codec/Int64Spec.hs b/test/Avro/Codec/Int64Spec.hs new file mode 100644 --- /dev/null +++ b/test/Avro/Codec/Int64Spec.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Avro.Codec.Int64Spec (spec) where + +import Data.Avro +import Data.Avro.Encode +import Data.Avro.Schema +import Data.Avro.Zig +import Data.Bits +import Data.ByteString.Builder +import Data.Int +import Data.List.Extra +import Data.Tagged +import Data.Word +import Numeric (showHex) +import Test.Hspec +import qualified Data.Avro.Types as AT +import qualified Data.ByteString.Lazy as BL +import qualified Test.QuickCheck as Q +import Debug.Trace +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + + +prettyPrint :: BL.ByteString -> String +prettyPrint = concatMap (`showHex` "") . BL.unpack + +newtype OnlyInt64 = OnlyInt64 + { onlyInt64Value :: Int64 + } deriving (Show, Eq) + +onlyInt64Schema :: Schema +onlyInt64Schema = + let fld nm = Field nm [] Nothing Nothing + in Record "OnlyInt64" (Just "test.contract") [] Nothing Nothing + [ fld "onlyInt64Value" Long Nothing + ] + +instance ToAvro OnlyInt64 where + toAvro sa = record onlyInt64Schema + [ "onlyInt64Value" .= onlyInt64Value sa + ] + schema = pure onlyInt64Schema + +instance FromAvro OnlyInt64 where + fromAvro (AT.Record _ r) = + OnlyInt64 <$> r .: "onlyInt64Value" + +bitStringToWord8s :: String -> [Word8] +bitStringToWord8s = reverse . map (toWord . reverse) . chunksOf 8 . reverse . toBinary + where toBinary :: String -> [Bool] + toBinary ('1':xs) = True : toBinary xs + toBinary ('0':xs) = False : toBinary xs + toBinary (_ :xs) = toBinary xs + toBinary [] = [] + toWord' :: Word8 -> [Bool] -> Word8 + toWord' n (True :bs) = toWord' ((n `shiftL` 1) .|. 1) bs + toWord' n (False:bs) = toWord' ((n `shiftL` 1) .|. 0) bs + toWord' n _ = n + toWord = toWord' 0 + +spec :: Spec +spec = describe "Avro.Codec.Int64Spec" $ do + it "Can encode 90071992547409917L correctly" $ do + let expectedBuffer = BL.pack [0xfa, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xbf, 0x02] + let value = OnlyInt64 90071992547409917 + encode value `shouldBe` expectedBuffer + it "Can decode 90071992547409917L correctly" $ do + let x = untag (schema :: Tagged OnlyInt64 Type) + let buffer = BL.pack [0xfa, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xbf, 0x02] + let expectedValue = OnlyInt64 90071992547409917 + decode x buffer `shouldBe` Success expectedValue + it "Can decode encoded Int64 values" $ do + let x = untag (schema :: Tagged OnlyInt64 Type) + Q.property $ \(w :: Int64) -> decode x (encode (OnlyInt64 w)) == Success (OnlyInt64 w) + + it "Can decode 129L" $ do + let w = 129 :: Int64 + let x = untag (schema :: Tagged OnlyInt64 Type) + decode x (encode (OnlyInt64 w)) == Success (OnlyInt64 w) + + it "Can decode 36028797018963968 correctly" $ do + let x = untag (schema :: Tagged OnlyInt64 Type) + let buffer = BL.pack (bitStringToWord8s "10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000001") + let expectedValue = OnlyInt64 36028797018963968 + decode x buffer `shouldBe` Success expectedValue + + it "bitStringToWord8s 00000000" $ bitStringToWord8s "00000000" `shouldBe` [0x00 ] + it "bitStringToWord8s 00000001" $ bitStringToWord8s "00000001" `shouldBe` [0x01 ] + it "bitStringToWord8s 01111111" $ bitStringToWord8s "01111111" `shouldBe` [0x7f ] + it "bitStringToWord8s 10000000 00000001" $ bitStringToWord8s "10000000 00000001" `shouldBe` [0x80, 0x01 ] + it "bitStringToWord8s 10000001 00000001" $ bitStringToWord8s "10000001 00000001" `shouldBe` [0x81, 0x01 ] + it "bitStringToWord8s 10000010 00000001" $ bitStringToWord8s "10000010 00000001" `shouldBe` [0x82, 0x01 ] + it "bitStringToWord8s 11111111 01111111" $ bitStringToWord8s "11111111 01111111" `shouldBe` [0xff, 0x7f ] + it "bitStringToWord8s 10000000 10000000 00000001" $ bitStringToWord8s "10000000 10000000 00000001" `shouldBe` [0x80, 0x80, 0x01 ] + it "bitStringToWord8s 10000001 10000000 00000001" $ bitStringToWord8s "10000001 10000000 00000001" `shouldBe` [0x81, 0x80, 0x01 ] + it "bitStringToWord8s 10000001 10000000 00000000" $ bitStringToWord8s "10000001 10000000 00000000" `shouldBe` [0x81, 0x80, 0x00 ] + + it "Can zig" $ do + zig ( 0 :: Int64) `shouldBe` 0 + zig ( -1 :: Int64) `shouldBe` 1 + zig ( 1 :: Int64) `shouldBe` 2 + zig ( -2 :: Int64) `shouldBe` 3 + zig ( 2147483647 :: Int64) `shouldBe` 4294967294 + zig (-2147483648 :: Int64) `shouldBe` 4294967295 diff --git a/test/Avro/Codec/MaybeSpec.hs b/test/Avro/Codec/MaybeSpec.hs new file mode 100644 --- /dev/null +++ b/test/Avro/Codec/MaybeSpec.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Avro.Codec.MaybeSpec (spec) where + +import Test.Hspec +import qualified Test.QuickCheck as Q + +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Tagged +import Data.Text + +import Data.Avro +import Data.Avro.Schema +import qualified Data.Avro.Types as AT + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +newtype OnlyMaybeBool = OnlyMaybeBool + { onlyMaybeBoolValue :: Maybe Bool + } deriving (Show, Eq) + +onlyMaybeBoolSchema :: Schema +onlyMaybeBoolSchema = + let fld nm = Field nm [] Nothing Nothing + in Record "onlyMaybeBool" (Just "test.contract") [] Nothing Nothing + [ fld "onlyMaybeBoolValue" (mkUnion (Null :| [Boolean])) Nothing + ] + +instance ToAvro OnlyMaybeBool where + toAvro sa = record onlyMaybeBoolSchema + [ "onlyMaybeBoolValue" .= onlyMaybeBoolValue sa + ] + schema = pure onlyMaybeBoolSchema + +instance FromAvro OnlyMaybeBool where + fromAvro (AT.Record _ r) = + OnlyMaybeBool <$> r .: "onlyMaybeBoolValue" + +spec :: Spec +spec = describe "Avro.Codec.MaybeSpec" $ do + it "should encode then decode Maybe Bool correctly" $ do + Q.property $ \(w :: Maybe Bool) -> + let x = untag (schema :: Tagged OnlyMaybeBool Type) in + decode x (encode (OnlyMaybeBool w)) `shouldBe` Success (OnlyMaybeBool w) diff --git a/test/Avro/Codec/NestedSpec.hs b/test/Avro/Codec/NestedSpec.hs new file mode 100644 --- /dev/null +++ b/test/Avro/Codec/NestedSpec.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Avro.Codec.NestedSpec (spec) where + +import Data.Avro +import Data.Avro.Schema +import qualified Data.Avro.Types as AT +import qualified Data.ByteString.Lazy as BL +import Test.Hspec + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +data ChildType = ChildType + { childValue1 :: Int + , childValue2 :: Int + } deriving (Show, Eq) + +data ParentType = ParentType + { parentValue1 :: Int + , parentValue2 :: [ChildType] + } deriving (Show, Eq) + +childTypeSchema :: Schema +childTypeSchema = + let fld nm = Field nm [] Nothing Nothing + in Record "ChildType" (Just "test.contract") [] Nothing Nothing + [ fld "childValue1" Long Nothing + , fld "childValue2" Long Nothing + ] + +parentTypeSchema :: Schema +parentTypeSchema = + let fld nm = Field nm [] Nothing Nothing + in Record "ParentType" (Just "test.contract") [] Nothing Nothing + [ fld "parentValue1" Long Nothing + , fld "parentValue2" (Array childTypeSchema) Nothing] + +instance ToAvro ChildType where + toAvro sa = record childTypeSchema + [ "childValue1" .= childValue1 sa + , "childValue2" .= childValue2 sa + ] + schema = pure childTypeSchema + +instance FromAvro ChildType where + fromAvro (AT.Record _ r) = + ChildType <$> r .: "childValue1" + <*> r .: "childValue2" + fromAvro v = badValue v "ChildType" + +instance ToAvro ParentType where + toAvro sa = record parentTypeSchema + [ "parentValue1" .= parentValue1 sa + , "parentValue2" .= parentValue2 sa + ] + schema = pure parentTypeSchema + +instance FromAvro ParentType where + fromAvro (AT.Record _ r) = + ParentType <$> r .: "parentValue1" + <*> r .: "parentValue2" + fromAvro v = badValue v "ParentType" + +spec :: Spec +spec = describe "Avro.Codec.NestedSpec" $ do + it "Can encode/decode nested structures" $ do + let parent = ParentType 0 [ChildType 1 2, ChildType 3 4] + let parentEncoded = encode parent + + let parentDecoded = decode parentTypeSchema parentEncoded + parentDecoded `shouldBe` Success parent diff --git a/test/Avro/Codec/TextSpec.hs b/test/Avro/Codec/TextSpec.hs new file mode 100644 --- /dev/null +++ b/test/Avro/Codec/TextSpec.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Avro.Codec.TextSpec (spec) where + +import Data.Avro +import Data.Avro.Schema +import Data.Text +import Data.Tagged +import Test.Hspec +import qualified Data.Avro.Types as AT +import qualified Test.QuickCheck as Q + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +newtype OnlyText = OnlyText + {onlyTextValue :: Text + } deriving (Show, Eq) + +onlyTextSchema :: Schema +onlyTextSchema = + let fld nm = Field nm [] Nothing Nothing + in Record "OnlyText" (Just "test.contract") [] Nothing Nothing + [ fld "onlyTextValue" String Nothing + ] + +instance ToAvro OnlyText where + toAvro sa = record onlyTextSchema + [ "onlyTextValue" .= onlyTextValue sa ] + schema = pure onlyTextSchema + +instance FromAvro OnlyText where + fromAvro (AT.Record _ r) = + OnlyText <$> r .: "onlyTextValue" + +spec :: Spec +spec = describe "Avro.Codec.TextSpec" $ do + it "Can decode \"This is an unit test\"" $ do + -- The '(' here is the length (ASCII value) of the string + let expectedBuffer = "(This is an unit test" + let value = OnlyText "This is an unit test" + encode value `shouldBe` expectedBuffer + + it "Can decode encoded Text values" $ do + Q.property $ \(t :: String) -> + let x = untag (schema :: Tagged OnlyText Type) in + decode x (encode (OnlyText (pack t))) == Success (OnlyText (pack t)) diff --git a/test/Avro/Codec/ZigZagSpec.hs b/test/Avro/Codec/ZigZagSpec.hs new file mode 100644 --- /dev/null +++ b/test/Avro/Codec/ZigZagSpec.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Avro.Codec.ZigZagSpec (spec) where + +import Data.Avro.Zag +import Data.Avro.Zig +import Data.Int +import Data.Word +import Test.Hspec +import Test.QuickCheck + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +spec :: Spec +spec = describe "Avro.Codec.Int64Spec" $ do + it "Zig and zag roundtrips for Int" $ property $ \(w :: Int ) -> zag (zig w) `shouldBe` w + it "Zig and zag roundtrips for Int8" $ property $ \(w :: Int8 ) -> zag (zig w) `shouldBe` w + it "Zig and zag roundtrips for Int16" $ property $ \(w :: Int16 ) -> zag (zig w) `shouldBe` w + it "Zig and zag roundtrips for Int32" $ property $ \(w :: Int32 ) -> zag (zig w) `shouldBe` w + it "Zig and zag roundtrips for Int64" $ property $ \(w :: Int64 ) -> zag (zig w) `shouldBe` w + it "Zag and zig roundtrips for Word" $ property $ \(w :: Word ) -> zig (zag w) `shouldBe` w + it "Zag and zig roundtrips for Word8" $ property $ \(w :: Word8 ) -> zig (zag w) `shouldBe` w + it "Zag and zig roundtrips for Word16" $ property $ \(w :: Word16) -> zig (zag w) `shouldBe` w + it "Zag and zig roundtrips for Word32" $ property $ \(w :: Word32) -> zig (zag w) `shouldBe` w + it "Zag and zig roundtrips for Word64" $ property $ \(w :: Word64) -> zig (zag w) `shouldBe` w diff --git a/test/Avro/EncodeRawSpec.hs b/test/Avro/EncodeRawSpec.hs new file mode 100644 --- /dev/null +++ b/test/Avro/EncodeRawSpec.hs @@ -0,0 +1,51 @@ +module Avro.EncodeRawSpec (spec) where + +import Data.Avro.EncodeRaw +import Data.Bits +import Data.ByteString.Builder +import Data.List.Extra +import Data.Word +import Test.Hspec +import qualified Data.ByteString.Lazy as BL + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +bitStringToWord8s :: String -> [Word8] +bitStringToWord8s = reverse . map (toWord . reverse) . chunksOf 8 . reverse . toBinary + where toBinary :: String -> [Bool] + toBinary ('1':xs) = True : toBinary xs + toBinary ('0':xs) = False : toBinary xs + toBinary (_ :xs) = toBinary xs + toBinary [] = [] + toWord' :: Word8 -> [Bool] -> Word8 + toWord' n (True :bs) = toWord' ((n `shiftL` 1) .|. 1) bs + toWord' n (False:bs) = toWord' ((n `shiftL` 1) .|. 0) bs + toWord' n _ = n + toWord = toWord' 0 + +spec :: Spec +spec = describe "Avro.EncodeRawSpec" $ do + it "Can encodeRaw ( 0 :: Word64)" $ toLazyByteString (encodeRaw ( 0 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 00000000" ) + it "Can encodeRaw ( 1 :: Word64)" $ toLazyByteString (encodeRaw ( 1 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 00000001" ) + it "Can encodeRaw ( 2 :: Word64)" $ toLazyByteString (encodeRaw ( 2 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 00000010" ) + it "Can encodeRaw ( 127 :: Word64)" $ toLazyByteString (encodeRaw ( 127 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 01111111" ) + it "Can encodeRaw ( 129 :: Word64)" $ toLazyByteString (encodeRaw ( 129 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000001 00000001" ) + it "Can encodeRaw ( 130 :: Word64)" $ toLazyByteString (encodeRaw ( 130 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000010 00000001" ) + it "Can encodeRaw ( 16383 :: Word64)" $ toLazyByteString (encodeRaw ( 16383 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 11111111 01111111" ) + it "Can encodeRaw ( 16385 :: Word64)" $ toLazyByteString (encodeRaw ( 16385 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000001 10000000 00000001" ) + it "Can encodeRaw ( 2097153 :: Word64)" $ toLazyByteString (encodeRaw ( 2097153 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000001 10000000 10000000 00000001" ) + it "Can encodeRaw ( 268435457 :: Word64)" $ toLazyByteString (encodeRaw ( 268435457 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000001 10000000 10000000 10000000 00000001" ) + it "Can encodeRaw ( 34359738369 :: Word64)" $ toLazyByteString (encodeRaw ( 34359738369 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000001 10000000 10000000 10000000 10000000 00000001" ) + it "Can encodeRaw ( 4398046511105 :: Word64)" $ toLazyByteString (encodeRaw ( 4398046511105 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000001 10000000 10000000 10000000 10000000 10000000 00000001" ) + it "Can encodeRaw ( 562949953421313 :: Word64)" $ toLazyByteString (encodeRaw ( 562949953421313 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000001 10000000 10000000 10000000 10000000 10000000 10000000 00000001" ) + it "Can encodeRaw ( 72057594037927937 :: Word64)" $ toLazyByteString (encodeRaw ( 72057594037927937 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000001 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000001" ) + it "Can encodeRaw (9223372036854775809 :: Word64)" $ toLazyByteString (encodeRaw (9223372036854775809 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "10000001 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000001" ) + it "Can encodeRaw ( 128 :: Word64)" $ toLazyByteString (encodeRaw ( 128 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000000 00000001" ) + it "Can encodeRaw ( 16384 :: Word64)" $ toLazyByteString (encodeRaw ( 16384 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000000 10000000 00000001" ) + it "Can encodeRaw ( 2097153 :: Word64)" $ toLazyByteString (encodeRaw ( 2097152 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000000 10000000 10000000 00000001" ) + it "Can encodeRaw ( 268435457 :: Word64)" $ toLazyByteString (encodeRaw ( 268435456 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000000 10000000 10000000 10000000 00000001" ) + it "Can encodeRaw ( 34359738369 :: Word64)" $ toLazyByteString (encodeRaw ( 34359738368 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000000 10000000 10000000 10000000 10000000 00000001" ) + it "Can encodeRaw ( 4398046511105 :: Word64)" $ toLazyByteString (encodeRaw ( 4398046511104 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000000 10000000 10000000 10000000 10000000 10000000 00000001" ) + it "Can encodeRaw ( 562949953421313 :: Word64)" $ toLazyByteString (encodeRaw ( 562949953421312 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000001" ) + it "Can encodeRaw ( 72057594037927936 :: Word64)" $ toLazyByteString (encodeRaw ( 72057594037927936 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s " 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000001" ) + it "Can encodeRaw (9223372036854775808 :: Word64)" $ toLazyByteString (encodeRaw (9223372036854775808 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000001" ) diff --git a/test/Avro/THEnumSpec.hs b/test/Avro/THEnumSpec.hs new file mode 100644 --- /dev/null +++ b/test/Avro/THEnumSpec.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +module Avro.THEnumSpec +where + +import Data.Avro +import Data.Avro.Deriving + +import Test.Hspec + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +deriveAvro "test/data/enums.avsc" + +spec :: Spec +spec = describe "Avro.THEnumSpec: Schema with enums" $ do + it "should do roundtrip" $ do + let msg = EnumWrapper + { enumWrapperId = 42 + , enumWrapperName = "Text" + , enumWrapperReason = EnumReasonBecause + } + fromAvro (toAvro msg) `shouldBe` pure msg diff --git a/test/Avro/THReusedSpec.hs b/test/Avro/THReusedSpec.hs new file mode 100644 --- /dev/null +++ b/test/Avro/THReusedSpec.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +module Avro.THReusedSpec +where + +import Data.Avro +import Data.Avro.Deriving + +import Test.Hspec + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +deriveAvro "test/data/reused.avsc" + +spec :: Spec +spec = describe "Avro.THReusedSpec: Schema with named types" $ do + let container = ContainerChild + { containerChildFstIncluded = ReusedChild 100 + , containerChildSndIncluded = ReusedChild 200 + } + let wrapper = ReusedWrapper + { reusedWrapperFull = ReusedChild 42 + , reusedWrapperInner = container + } + it "wrapper should do roundtrip" $ + fromAvro (toAvro wrapper) `shouldBe` pure wrapper + + it "child should do rundtrip" $ + fromAvro (toAvro container) `shouldBe` pure container + + it "innermost element should do roundtrip" $ + fromAvro (toAvro (ReusedChild 7)) `shouldBe` pure (ReusedChild 7) diff --git a/test/Avro/THSimpleSpec.hs b/test/Avro/THSimpleSpec.hs new file mode 100644 --- /dev/null +++ b/test/Avro/THSimpleSpec.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +module Avro.THSimpleSpec +where + +import Control.Monad +import Data.Aeson (decodeStrict) +import Data.Avro +import Data.Avro.Deriving +import Data.Avro.Schema +import Data.ByteString as BS + +import Test.Hspec + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +deriveAvro "test/data/small.avsc" + +spec :: Spec +spec = describe "Avro.THSpec: Small Schema" $ do + let msgs = + [ Endpoint + { endpointIps = ["192.168.1.1", "127.0.0.1"] + , endpointPorts = [PortRange 1 10, PortRange 11 20] + } + , Endpoint + { endpointIps = [] + , endpointPorts = [PortRange 1 10, PortRange 11 20] + } + ] + + it "should do roundtrip" $ do + forM_ msgs $ \msg -> + fromAvro (toAvro msg) `shouldBe` pure msg + + it "should do full round trip" $ + forM_ msgs $ \msg -> do + let encoded = encode msg + let decoded = decode (schemaOf msg) encoded + + pure msg `shouldBe` decoded diff --git a/test/Avro/ToAvroSpec.hs b/test/Avro/ToAvroSpec.hs new file mode 100644 --- /dev/null +++ b/test/Avro/ToAvroSpec.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Avro.ToAvroSpec +where + +import Data.Avro +import Data.Int +import Data.Text +import Data.Avro.Schema +import qualified Data.Avro.Types as AT +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Tagged +import Data.Word +import qualified Data.ByteString.Lazy as BL +import Test.Hspec +import qualified Test.QuickCheck as Q + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +data TypesTestMessage = TypesTestMessage + { tmId :: Int64 + , tmName :: Text + , tmTimestamp :: Maybe Int64 + , tmForeignId :: Maybe Int64 + , tmCompetence :: Maybe Double + , tmAttraction :: Double + } deriving (Show, Eq) + +tmSchema :: Schema +tmSchema = + let fld nm = Field nm [] Nothing Nothing + in Record "TypesTestMessage" (Just "avro.haskell.test") [] Nothing Nothing + [ fld "id" Long Nothing + , fld "name" String Nothing + , fld "timestamp" (mkUnion (Null :| [Long])) Nothing + , fld "foreignId" (mkUnion (Null :| [Long])) Nothing + , fld "competence" (mkUnion (Null :| [Double])) Nothing + , fld "attraction" Double Nothing + ] + +instance ToAvro TypesTestMessage where + toAvro m = record tmSchema + [ "id" .= tmId m + , "name" .= tmName m + , "timestamp" .= tmTimestamp m + , "foreignId" .= tmForeignId m + , "competence" .= tmCompetence m + , "attraction" .= tmAttraction m + ] + schema = pure tmSchema + +instance FromAvro TypesTestMessage where + fromAvro (AT.Record _ r) = + TypesTestMessage <$> r .: "id" + <*> r .: "name" + <*> r .: "timestamp" + <*> r .: "foreignId" + <*> r .: "competence" + <*> r .: "attraction" + fromAvro v = badValue v "TypesTestMessage" + +message :: TypesTestMessage +message = TypesTestMessage + { tmId = 896543 + , tmName = "test-name" + , tmTimestamp = Just 7 + , tmForeignId = Nothing + , tmCompetence = Just 7.5 + , tmAttraction = 8.974 + } + +spec :: Spec +spec = describe "Kafka.IntegrationSpec" $ do + it "sends messages to test topic" $ do + fromAvro (toAvro message) `shouldBe` pure message diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/data/enums.avsc b/test/data/enums.avsc new file mode 100644 --- /dev/null +++ b/test/data/enums.avsc @@ -0,0 +1,15 @@ +{ "type": "record", + "name": "EnumWrapper", + "namespace": "haskell.avro.example", + "fields": [ + { "name": "id", "type": "long" }, + { "name": "name", "type": "string"}, + { "name": "reason", + "type": { + "type": "enum", + "name": "EnumReason", + "symbols": ["Because", "Instead"] + } + } + ] +} diff --git a/test/data/reused.avsc b/test/data/reused.avsc new file mode 100644 --- /dev/null +++ b/test/data/reused.avsc @@ -0,0 +1,37 @@ +{ + "type": "record", + "name": "ReusedWrapper", + "namespace": "Boo", + "fields": [ + { + "name": "full", + "type": { + "type": "record", + "name": "ReusedChild", + "fields": [ + { + "name": "data", + "type": "int" + } + ] + } + }, + { + "name": "inner", + "type": { + "type": "record", + "name": "ContainerChild", + "fields": [ + { + "name": "fstIncluded", + "type": "ReusedChild" + }, + { + "name": "sndIncluded", + "type": "ReusedChild" + } + ] + } + } + ] +} diff --git a/test/data/small.avsc b/test/data/small.avsc new file mode 100644 --- /dev/null +++ b/test/data/small.avsc @@ -0,0 +1,33 @@ +{ + "type": "record", + "name": "Endpoint", + "fields": [ + { + "name": "ips", + "type": { + "type": "array", + "items": "string" + } + }, + { + "name": "ports", + "type": { + "type": "array", + "items": { + "type": "record", + "name": "PortRange", + "fields": [ + { + "name": "start", + "type": "int" + }, + { + "name": "end", + "type": "int" + } + ] + } + } + } + ] +}