packages feed

schemas 0.1.1.0 → 0.2.0

raw patch · 10 files changed

+258/−42 lines, 10 files

Files

CHANGELOG.md view
@@ -1,6 +1,11 @@ # Revision history for schemas -## 0.1.1.0 -- +## 0.2.0 --  2019-09-29+* Add OpenApi2 encoding+* Change the `Semigroup` instance for typed schemas+* Trimmed down dependencies slightly++## 0.1.1.0 --  2019-09-28 * Fixed several bugs in `isSubtypeOf` and `encodeWith` * Better error messages when encoding with a partial schema fails * New: 'liftPrism' and 'oneOf'
README.md view
@@ -1,21 +1,35 @@ [![CI](https://travis-ci.com/pepeiborra/schemas.svg)](https://travis-ci.org/pepeiborra/threepenny-editors) [![Hackage](https://img.shields.io/hackage/v/schemas.svg)](https://hackage.haskell.org/package/threepenny-editors) # schemas-A library for schema-guided serialization of Haskell data types.  +schemas is a Haskell-centric serialization library written with versioning in mind. Since a schema is a first-class citizen, it can be serialized, reasoned about, and transmitted together with the data. Serialization and deserialization work better when the source schema is provided, and versioning is accomplished by checking that the two schemas are related by a subtyping relation. This alleviates the need to keep old versions of datatypes around.++Consider a schema modification that adds a field. To support upgrading old documents to the new schema, the only requirement is that the new field is optional. Downgrading is easy too, simply omit the new field. Conversely, a schema modifcation that removes a field supports trivial upgrades but the removed field must be optional to support downgrading. Changing the type of a field is supported in as much as the old and new types are relatable. Field renaming is not supported. More importantly, all these changes are defined by a schema relation, and the library provides a predicate to check whether the relation holds.++schemas can also be used in a GraphQL-like fashion, allowing clients to request a subset of the schema. This comes up specially when working with recursive schemas involving cyclic data.+ ## Features-* schemas are first-class citizens and can be reasoned about,+* schemas are first-class citizens and can be serialized, * schema construction is statically typed, * versioning is driven by a subtyping relation, no need for version numbers, * Serialization to JSON only currently  ## Why schemas -schemas is a Haskell-centric serialization library written with versioning in mind. Since a schema is a first-class citizen, it can be serialized and reasoned about. Serialization and deserialization require a source and target schema, and versioning is accomplished by checking that the two schemas are related by a subtyping relation. There is no need to keep old versions of datatypes around nor to write code for upgrades/downgrades.+A quick seach in Hackage reveals a large number of libraries about schemas, including [json-schema], [hjsonschema], [aeson-schema], [aeson-schemas] and [hschema], amongst others.+There's undoubtedly a large amount of overlapping amongst all these libraries, so the immediate question is, why introduce another one ?  -Consider a schema modification that adds a field. To support upgrading old documents to the new schema, the only requirement is that the new field is optional. Downgrading is easy too, simply omit the new field. Conversely, a schema modifcation that removes a field supports trivial upgrades but the removed field must be optional to support downgrading. Changing the type of a field is supported in as much as the old and new types are relatable. Field renaming is not supported. More importantly, all these changes are defined by a schema relation, and the library provides a predicate to check whether the relation holds.+This library is a re-implementation of an encoding library found in the Strats codebase at Standard Chartered Bank, the origins of which is go back a few years in time.+It predates other libraries that accomplish a similar task, including most of the ones mentioned before.+The approach has worked well but the codebase is showing its age and limitations, notably the lack of decoding capabilities.+This library extends the original approach with decoding and alternatives, hopefully keeping the good parts like the subtyping relation, intact.+ +[json-schema]: http://hackage.haskell.org/packages/json-schema+[hjsonschema]: http://hackage.haskell.org/packages/hjsonschema+[aeson-schema]: http://hackage.haskell.org/packages/aeson-schema+[aeson-schemas]: http://hackage.haskell.org/packages/aeson-schemas+[hschema]: http://hackage.haskell.org/packages/hschema -schemas can also be used in a GraphQL-like fashion, allowing clients to request a subset of the schema. This comes up specially when working with recursive schemas involving cyclic data.  ## Subtyping relation @@ -25,11 +39,11 @@  For more concrete details on the subtyping relation check the definition of `isSubtypeOf`. This function returns a witness, i.e. a conversion function, whenever the relation holds. -Versioning makes use of this subtyping relation as follows. Downgrading a value `v_2 :: T_2` into a previous version `T_1` is accomplished via the witness of `schema(T_1) < schema(T_2)`. Similarly, upgrading a `v_1 :: T_1` message into a newer version `T_2` can be accomplished via the witness of `schema(T_1) > schema(T_2)`. Therefore, a type `T_1` can only be replaced by a type `T_2` in an downgrade-compatible way if `schema(T_1) < schema(T_2)`; if upggrades are required, then `schema(T_1) > schema(T_2)` is required too.+Versioning makes use of this subtyping relation as follows. Downgrading a value `v_2 :: T_2` into a previous version `T_1` is accomplished via the witness of `schema(T_1) > schema(T_2)`. Similarly, upgrading a `v_1 :: T_1` message into a newer version `T_2` can be accomplished via the witness of `schema(T_1) < schema(T_2)`. Therefore, a type `T_1` can only be replaced by a type `T_2` in an downgrade-compatible way if `schema(T_1) > schema(T_2)`; if upgrades are required, then `schema(T_1) < schema(T_2)` is required too. -The `<` relation is reflexive and transitive, but importantly not asymmetric or antisymmetric: it can be that both `T_1 < T_2` and `T_2 < T_1` and yet they are not the same type. For example, given a `S_2` schema that adds a required field to `S_1`, we would have that `S_1 < S_2` but not `S_1 > S_2`. However, if new the field was optional, then we would have `S_1 > S_2` too. In such case, we say that `S_1 ~ S_2` because they only differ on optional fields.+The `<` relation is reflexive and transitive, but importantly not asymmetric or antisymmetric: it can be that both `T_1 < T_2` and `T_2 < T_1` and yet they are not the same type. For example, given a `S_2` schema that adds a required field to `S_1`, we would have that `S_1 > S_2` but not `S_1 < S_2`. However, if new the field was optional, then we would have `S_1 < S_2` too. In such case, we say that `S_1 ~ S_2` because they only differ on optional fields. For example, given a `S_3` schema that removes a field from `S_2`, we have:-- `S_2 > S_3` therefore we can upgrade `S_2` values to `S_3`+- `S_2 < S_3` therefore we can upgrade `S_2` values to `S_3` - `S_2 ~ S_3` if the removed field is optional, in which case we can also downgrade `S_3` values to `S_2`  The `~` relation is an equivalence class, i.e. it is reflexive, symmetric and transitive.@@ -37,13 +51,14 @@ ## Alternative encodings  Sometimes there is more than one way to encode a value. A field can be renamed or change its type, an optional field become mandatory, several fields can be merged into one, etc. Alternative encodings allow for backwards compatible schema evolution.+This library support alternative encodings via the `Monoid` instance for typed schemas and the `Alternative` instance for `RecordFields`.  -Schemas support alternative encodings via the 'Or' constructor. The schema `A|B` encodes a value in two alternative ways `A` and `B`. A message created with this schema may encodings A, B or both. 'encode' will always create messages with all the possible encodings. While messages with multiple alternative encodings are not desirable for serialization, the desired message can be carved out using the subtyping relation. All the following hold:+The schema `A|B` encodes a value in two alternative ways `A` and `B`. A message created with this schema may encodings A, B or both. 'encode' will always create messages with all the possible encodings. While messages with multiple alternative encodings are not desirable for serialization, the desired message can be carved out using the subtyping relation. All the following hold: ```-A|B < A (the coercion A -> A|B will produce a message with an A encoding)-A|B < B (the coercion B -> A|B will produce a message with a  B encoding)-A < A|B (the coercion A|B -> A will succeed only if the message contains an A encoding)-B < A|B (the coercoin A|B -> B will succeed only if the message contains a  B encoding)+A < A|B (the coercion A -> A|B will produce a message with an A encoding)+B < A|B (the coercion B -> A|B will produce a message with a  B encoding)+A|B < A (the coercion A|B -> A will succeed only if the message contains an A encoding)+A|B < B (the coercoin A|B -> B will succeed only if the message contains a  B encoding) ```  Typed schemas implement a limited form of alternative encodings via the `Alternative` instance for record fields. In the future a similar 'Alternative' instance for union constructors could be added.
schemas.cabal view
@@ -1,6 +1,6 @@ cabal-version:       2.0 name:                schemas-version:             0.1.1.0+version:             0.2.0 synopsis:            schema guided serialization description:   Schemas is a Haskell library for serializing and deserializing data in JSON.@@ -45,22 +45,20 @@     Schemas     Schemas.Class     Schemas.Internal+    Schemas.OpenApi2     Schemas.SOP     Schemas.Untyped   -- other-modules:   -- other-extensions:   build-depends:       base ^>=4.12.0.0                      , aeson-                     , aeson-pretty                      , bifunctors                      , bytestring                      , free-                     , generic-lens                      , generics-sop >= 0.5.0.0                      , hashable                      , lens                      , lens-aeson-                     , pretty-simple                      , profunctors                      , scientific                      , text@@ -81,6 +79,7 @@                      , Person2                      , Person3                      , SchemasSpec+                     , Schemas.OpenApi2Spec                      , Generators   build-depends:       aeson                      , aeson-pretty@@ -94,3 +93,4 @@                      , QuickCheck                      , schemas                      , text+                     , unordered-containers
src/Schemas.hs view
@@ -45,6 +45,7 @@   , enum   , readShow   , list+  , string   , vector   , Key(..)   , stringMap
src/Schemas/Class.hs view
@@ -10,7 +10,6 @@ import           Control.Lens         hiding (_Empty, Empty, enum, (<.>)) import           Data.Aeson           (Value) import           Data.Biapplicative-import           Data.Generics.Labels () import           Data.Hashable import           Data.HashMap.Strict  (HashMap) import qualified Data.HashMap.Strict  as Map@@ -34,22 +33,22 @@   schema = mempty  instance HasSchema Bool where-  schema = viaJSON "Bool"+  schema = viaJSON "Boolean"  instance HasSchema Double where-  schema = viaJSON "Double"+  schema = viaJSON "Number"  instance HasSchema Scientific where-  schema = viaJSON "Double"+  schema = viaJSON "Number"  instance HasSchema Int where-  schema = viaJSON "Int"+  schema = viaJSON "Integer"  instance HasSchema Integer where   schema = viaJSON "Integer"  instance HasSchema Natural where-  schema = viaJSON "Natural"+  schema = viaJSON "Integer"  instance {-# OVERLAPPING #-} HasSchema String where   schema = string@@ -79,15 +78,15 @@  instance HasSchema Schema where   schema = union'-    [ alt "StringMap" #_StringMap-    , alt "Array"     #_Array-    , alt "Enum"      #_Enum-    , alt "Record"    #_Record+    [ alt "StringMap" $ prism' StringMap (\case StringMap x -> Just x ; _ -> Nothing)+    , alt "Array"     $ prism' Array (\case Array x -> Just x ; _ -> Nothing)+    , alt "Enum"      $ prism' Enum (\case Enum x -> Just x ; _ -> Nothing)+    , alt "Record"    $ prism' Record (\case Record x -> Just x ; _ -> Nothing)     , alt "Empty"      _Empty-    , alt "AllOf"     #_AllOf-    , alt "Prim"      #_Prim+    , alt "AllOf"     $ prism' AllOf (\case AllOf x -> Just x ; _ -> Nothing)+    , alt "Prim"      $ prism' Prim (\case Prim x -> Just x ; _ -> Nothing)     , altWith unionSchema "Union" _Union-    , alt "OneOf"     #_OneOf+    , alt "OneOf"     $ prism' OneOf (\case OneOf x -> Just x ; _ -> Nothing)     ]     where       unionSchema = list (record $ (,) <$> field "constructor" fst <*> field "schema" snd)@@ -121,7 +120,7 @@       <*> field "$5" (view _5)  instance (HasSchema a, HasSchema b) => HasSchema (Either a b) where-  schema = union' [alt "Left" #_Left, alt "Right" #_Right]+  schema = union' [alt "Left" _Left, alt "Right" _Right]  instance (Eq key, Hashable key, HasSchema a, Key key) => HasSchema (HashMap key a) where   schema = dimap toKeyed fromKeyed $ stringMap schema
src/Schemas/Internal.hs view
@@ -24,7 +24,6 @@ import           Data.Either import           Data.Foldable              (asum) import           Data.Functor.Compose-import           Data.Generics.Labels       () import           Data.HashMap.Strict        (HashMap) import qualified Data.HashMap.Strict        as Map import           Data.List.NonEmpty         (NonEmpty (..))@@ -133,9 +132,9 @@ instance Monoid a => Monoid (TypedSchemaFlex f a) where   mempty = TEmpty mempty -instance Semigroup a => Semigroup (TypedSchemaFlex f a) where+instance Semigroup (TypedSchemaFlex f a) where   -- | Allows defining multiple schemas for the same thing, effectively implementing versioning.-  TEmpty a <> TEmpty b = TEmpty (a <> b)+  TEmpty a <> TEmpty _ = TEmpty a   TEmpty{} <> x = x   x <> TEmpty{} = x   TAllOf aa <> b = allOf (aa <> [b])@@ -169,8 +168,8 @@ -- -- @ --  schemaPerson = Person---             <$> (field "name" name <|> field "full name" name)---             <*> (field "age" age <|> pure -1)+--             \<$\> (field "name" name \<|\> field "full name" name)+--             \<*\> (field "age" age \<|\> pure -1) -- @ newtype RecordFields from a = RecordFields {getRecordFields :: Alt (RecordField from) a}   deriving newtype (Alternative, Applicative, Functor, Monoid, Semigroup)@@ -260,9 +259,9 @@ --   data Education = Degree Text | PhD Text | NoEducation -- --   schemaEducation = union'---     [ alt "NoEducation" #_NoEducation---     , alt "Degree"      #_Degree---     , alt "PhD"         #_PhD+--     [ alt \"NoEducation\" #_NoEducation+--     , alt \"Degree\"      #_Degree+--     , alt \"PhD\"         #_PhD --     ] --   @
+ src/Schemas/OpenApi2.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE DeriveAnyClass             #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE OverloadedLabels           #-}+{-# LANGUAGE OverloadedLists            #-}++-- | This module defines a 'TypedSchema' for the 'Schema' datatype,+--   inspired in the OpenApi 2.0 specification, which may be useful+--   to render 'Schema' values in OpeApi 2.0 format+module Schemas.OpenApi2+  ( OpenApi2Document(..)+  , OpenApi2Schema(..)+  , defOpenApi2Schema+  , OpenApi2Type(..)+  , OpenApi2Options(..)+  , defaultOptions+  , toOpenApi2Document+  , encodeAsOpenApi2Document+  )+where++import           Control.Monad+import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Except+import           Control.Monad.Trans.Writer+import           Data.Aeson                 (Value)+import           Data.Functor+import           Data.HashMap.Strict        (HashMap)+import qualified Data.HashMap.Strict        as Map+import qualified Data.List.NonEmpty         as NE+import           Data.Text                  (Text)+import qualified Data.Text                  as Text+import qualified Generics.SOP               as SOP+import           GHC.Generics+import           Schemas+import           Schemas.SOP++-- | Given a schema free of undiscriminated unions and alternatives,+--   @encodeAsOpenApi2Document name schema@ produces an encoding of an+--   OpenApi2 document that models the given schema.+--   Failures are omitted, use 'toOpenApi2Document' if you care.+encodeAsOpenApi2Document :: OpenApi2Options -> Text -> Schema -> Value+encodeAsOpenApi2Document opts n sc =+  encode $ toOpenApi2Document opts (Map.fromList [(n, sc)])++-- | A catalog of definitions+data OpenApi2Document = OpenApi2Document+  { definitions :: HashMap Text OpenApi2Schema+  , failures    :: HashMap Text Reason+  }+  deriving (Show)++instance Monoid OpenApi2Document where+  mempty = OpenApi2Document [] []++instance Semigroup OpenApi2Document where+  OpenApi2Document d f <> OpenApi2Document d' f' =+    OpenApi2Document (d <> d') (f <> f')++instance HasSchema OpenApi2Document where+  schema =+    record $ OpenApi2Document+    <$> field "definitions" definitions+    <*> field "failures"    failures++-- | The representation of an OpenApi 2.0 schema+data OpenApi2Schema = OpenApi2Schema+  { _type                :: OpenApi2Type+  , additionalProperties :: Maybe OpenApi2Schema+  , discriminator        :: Maybe  Text+  , enum                 :: Maybe [Text]+  , format               :: Maybe Text+  , items                :: Maybe OpenApi2Schema+  , properties           :: Maybe (HashMap Text OpenApi2Schema)+  , required             :: Maybe [Text]+  }+  deriving (Generic, Show)+  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)++instance HasSchema OpenApi2Schema where+  schema = gSchema defOptions { fieldLabelModifier = dropWhile (== '_') }++defOpenApi2Schema :: OpenApi2Type -> OpenApi2Schema+defOpenApi2Schema t =+  OpenApi2Schema t Nothing Nothing Nothing Nothing Nothing Nothing Nothing++data OpenApi2Type+  = OpenApi2Object+  | OpenApi2Array+  | OpenApi2Boolean+  | OpenApi2Integer+  | OpenApi2Number+  | OpenApi2String+  deriving (Bounded, Enum, Eq, Show)++instance HasSchema OpenApi2Type where+  schema = Schemas.enum (Text.toLower . Text.pack . drop 8 . show)+                        [minBound .. maxBound]++data OpenApi2Options = OpenApi2Options+  { -- | Please tell me what to do with Prims+    primMapping :: Text -> Maybe OpenApi2Schema+  }++defaultOptions :: OpenApi2Options+defaultOptions = OpenApi2Options { primMapping = f }+ where+  f "Boolean" = Just $ defOpenApi2Schema OpenApi2Boolean+  f "String"  = Just $ defOpenApi2Schema OpenApi2String+  f "Number"  = Just $ defOpenApi2Schema OpenApi2Number+  f "Integer" = Just $ defOpenApi2Schema OpenApi2Integer+  f _         = Nothing++toOpenApi2Document :: OpenApi2Options -> HashMap Text Schema -> OpenApi2Document+toOpenApi2Document opts schemas =+  foldMap wrap (Map.toList topLevelSchemas) <> internalSchemas+ where+  results = runExcept . runWriterT . toOpenApi2 (primMapping opts) <$> schemas++  (topLevelSchemas, internalSchemas) = runWriter $ forM results $ \case+    Left  reason      -> pure $ Left reason+    Right (sc, inner) -> tell inner $> Right sc++  wrap (n, Left reason) = OpenApi2Document [] [(n, reason)]+  wrap (n, Right sc   ) = OpenApi2Document [(n, sc)] []++newtype Reason = Unsupported Text+  deriving Show+  deriving newtype HasSchema++-- | Alternatives and undiscriminated Unions are not supported+toOpenApi2+  :: (Text -> Maybe OpenApi2Schema)+  -> Schema+  -> WriterT OpenApi2Document (Except Reason) OpenApi2Schema+toOpenApi2 prim (Array sc) = toOpenApi2 prim sc+  <&> \sc2 -> (defOpenApi2Schema OpenApi2Array) { items = Just sc2 }+toOpenApi2 prim (StringMap sc) = toOpenApi2 prim sc <&> \sc2 ->+  (defOpenApi2Schema OpenApi2Object) { additionalProperties = Just sc2 }+toOpenApi2 _rim (Enum vals) = pure $ (defOpenApi2Schema OpenApi2String)+  { Schemas.OpenApi2.enum = Just (NE.toList vals)+  }+toOpenApi2 prim (Record fields) = do+  let req = [ n | (n, Field _ True) <- Map.toList fields ]+  pp <- traverse (toOpenApi2 prim . fieldSchema) fields+  return (defOpenApi2Schema OpenApi2Object) { properties = Just pp+                                            , required   = Just req+                                            }+toOpenApi2 prim (Union alts) = do+  altSchemas <- traverse (toOpenApi2 prim) (Map.fromList $ NE.toList alts)+  tell $ OpenApi2Document altSchemas []+  return $ (defOpenApi2Schema OpenApi2Object)+    { discriminator = Just "tag"+    , required      = Just ["tag"]+    , properties    = Just [("tag", defOpenApi2Schema OpenApi2String)]+    }+toOpenApi2 prim (Prim p) | Just y <- prim p = pure y+toOpenApi2 _rim (Prim p) = lift $ throwE $ Unsupported $ "Unknown prim: " <> p+toOpenApi2 _rim AllOf{} = lift $ throwE $ Unsupported "alternatives (AllOf)"+toOpenApi2 _rim OneOf{} =+  lift $ throwE $ Unsupported "undiscriminated unions (OneOf)"++-- TODO future work+-- fromOpenApi2 :: OpenApi2 -> Schema+-- fromOpenApi2 _ = undefined+
src/Schemas/Untyped.hs view
@@ -20,7 +20,6 @@ import           Data.Biapplicative import           Data.Either import           Data.Foldable              (asum)-import           Data.Generics.Labels       () import           Data.HashMap.Strict        (HashMap) import qualified Data.HashMap.Strict        as Map import           Data.List                  (find)@@ -67,6 +66,9 @@   }   deriving (Eq, Generic, Show) +fieldSchemaL :: Applicative f => (Schema -> f Schema) -> Field -> f Field+fieldSchemaL f Field{..} = Field <$> f fieldSchema <*> pure isRequired+ pattern Empty :: Schema pattern Empty <- Record [] where Empty = Record [] @@ -129,7 +131,7 @@ versions :: Schema -> NonEmpty Schema versions (AllOf scc) = join $ traverse versions scc versions (OneOf scc) = OneOf <$> traverse versions scc-versions (Record fields) = Record <$> ((traverse . #fieldSchema) versions fields)+versions (Record fields) = Record <$> ((traverse . fieldSchemaL) versions fields) versions (Array sc) = Array <$> versions sc versions (StringMap sc) = StringMap <$> versions sc versions x = [x]
+ test/Schemas/OpenApi2Spec.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedLists   #-}+{-# LANGUAGE OverloadedStrings #-}++module Schemas.OpenApi2Spec where+++import qualified Data.HashMap.Strict        as Map+import           Person+import           Person2+import           Schemas+import           Schemas.OpenApi2+import           Test.Hspec++spec :: Spec+spec = do+  describe "toOpenApi2Document" $ do+    it "works for Person" $ do+      let document = toOpenApi2Document defaultOptions [("Person", theSchema @Person)]+      Map.keys (definitions document) `shouldContain` ["Person"]+      Map.keys (failures document) `shouldNotContain` ["Person"]+    it "does Nothing for Person2" $ do+      let document = toOpenApi2Document defaultOptions [("Person2", theSchema @Person2)]+      Map.keys (definitions document) `shouldNotContain` ["Person2"]+      Map.keys (failures document) `shouldContain` ["Person2"]
test/SchemasSpec.hs view
@@ -19,6 +19,9 @@ import Test.QuickCheck import Text.Show.Functions () +main :: IO ()+main = hspec spec+ spec :: Spec spec = do   describe "encoding" $ do