{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}

module Kafka.Avro.SchemaRegistry
( schemaRegistry, loadSchema, sendSchema
, schemaRegistry_
, loadSubjectSchema
, getGlobalConfig, getSubjectConfig
, getVersions, isCompatible
, getSubjects
, SchemaId(..), Subject(..)
, SchemaRegistry, SchemaRegistryError(..)
, Schema(..)
, Compatibility(..), Version(..)
) where

import           Control.Arrow           (first)
import           Control.Exception       (throwIO)
import           Control.Exception.Safe (try)
import           Control.Lens            (view, (&), (.~), (^.))
import           Control.Monad           (void)
import           Control.Monad.IO.Class  (MonadIO, liftIO)
import           Control.Monad.Trans.Except (ExceptT (ExceptT), except, runExceptT, withExceptT)
import           Data.Aeson
import           Data.Aeson.Types        (typeMismatch)
import qualified Data.Aeson.Key          as A
import qualified Data.Aeson.KeyMap       as KM
import           Data.Avro.Schema.Schema (Schema (..), typeName)
import           Data.Foldable           (traverse_)
import           Data.Functor            (($>))
import           Data.Bifunctor          (bimap)
import           Data.Cache              as C
import           Data.Hashable           (Hashable)
import qualified Data.HashMap.Lazy       as HM
import           Data.Int                (Int32)
import           Data.String             (IsString)
import           Data.Text               (Text, append, cons, unpack)
import qualified Data.Text.Encoding      as Text
import qualified Data.Text.Lazy.Encoding as LText
import           Data.Word               (Word32)
import           GHC.Exception           (SomeException, displayException, fromException)
import           GHC.Generics            (Generic)
import           Network.HTTP.Client     (HttpException (..), HttpExceptionContent (..), Manager, defaultManagerSettings, newManager)
import qualified Network.Wreq            as Wreq

newtype SchemaId = SchemaId { SchemaId -> Int32
unSchemaId :: Int32} deriving (SchemaId -> SchemaId -> Bool
(SchemaId -> SchemaId -> Bool)
-> (SchemaId -> SchemaId -> Bool) -> Eq SchemaId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemaId -> SchemaId -> Bool
$c/= :: SchemaId -> SchemaId -> Bool
== :: SchemaId -> SchemaId -> Bool
$c== :: SchemaId -> SchemaId -> Bool
Eq, Eq SchemaId
Eq SchemaId
-> (SchemaId -> SchemaId -> Ordering)
-> (SchemaId -> SchemaId -> Bool)
-> (SchemaId -> SchemaId -> Bool)
-> (SchemaId -> SchemaId -> Bool)
-> (SchemaId -> SchemaId -> Bool)
-> (SchemaId -> SchemaId -> SchemaId)
-> (SchemaId -> SchemaId -> SchemaId)
-> Ord SchemaId
SchemaId -> SchemaId -> Bool
SchemaId -> SchemaId -> Ordering
SchemaId -> SchemaId -> SchemaId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SchemaId -> SchemaId -> SchemaId
$cmin :: SchemaId -> SchemaId -> SchemaId
max :: SchemaId -> SchemaId -> SchemaId
$cmax :: SchemaId -> SchemaId -> SchemaId
>= :: SchemaId -> SchemaId -> Bool
$c>= :: SchemaId -> SchemaId -> Bool
> :: SchemaId -> SchemaId -> Bool
$c> :: SchemaId -> SchemaId -> Bool
<= :: SchemaId -> SchemaId -> Bool
$c<= :: SchemaId -> SchemaId -> Bool
< :: SchemaId -> SchemaId -> Bool
$c< :: SchemaId -> SchemaId -> Bool
compare :: SchemaId -> SchemaId -> Ordering
$ccompare :: SchemaId -> SchemaId -> Ordering
$cp1Ord :: Eq SchemaId
Ord, Int -> SchemaId -> ShowS
[SchemaId] -> ShowS
SchemaId -> String
(Int -> SchemaId -> ShowS)
-> (SchemaId -> String) -> ([SchemaId] -> ShowS) -> Show SchemaId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaId] -> ShowS
$cshowList :: [SchemaId] -> ShowS
show :: SchemaId -> String
$cshow :: SchemaId -> String
showsPrec :: Int -> SchemaId -> ShowS
$cshowsPrec :: Int -> SchemaId -> ShowS
Show, Eq SchemaId
Eq SchemaId
-> (Int -> SchemaId -> Int)
-> (SchemaId -> Int)
-> Hashable SchemaId
Int -> SchemaId -> Int
SchemaId -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SchemaId -> Int
$chash :: SchemaId -> Int
hashWithSalt :: Int -> SchemaId -> Int
$chashWithSalt :: Int -> SchemaId -> Int
$cp1Hashable :: Eq SchemaId
Hashable)
newtype SchemaName = SchemaName Text deriving (SchemaName -> SchemaName -> Bool
(SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> Bool) -> Eq SchemaName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemaName -> SchemaName -> Bool
$c/= :: SchemaName -> SchemaName -> Bool
== :: SchemaName -> SchemaName -> Bool
$c== :: SchemaName -> SchemaName -> Bool
Eq, Eq SchemaName
Eq SchemaName
-> (SchemaName -> SchemaName -> Ordering)
-> (SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> Bool)
-> (SchemaName -> SchemaName -> SchemaName)
-> (SchemaName -> SchemaName -> SchemaName)
-> Ord SchemaName
SchemaName -> SchemaName -> Bool
SchemaName -> SchemaName -> Ordering
SchemaName -> SchemaName -> SchemaName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SchemaName -> SchemaName -> SchemaName
$cmin :: SchemaName -> SchemaName -> SchemaName
max :: SchemaName -> SchemaName -> SchemaName
$cmax :: SchemaName -> SchemaName -> SchemaName
>= :: SchemaName -> SchemaName -> Bool
$c>= :: SchemaName -> SchemaName -> Bool
> :: SchemaName -> SchemaName -> Bool
$c> :: SchemaName -> SchemaName -> Bool
<= :: SchemaName -> SchemaName -> Bool
$c<= :: SchemaName -> SchemaName -> Bool
< :: SchemaName -> SchemaName -> Bool
$c< :: SchemaName -> SchemaName -> Bool
compare :: SchemaName -> SchemaName -> Ordering
$ccompare :: SchemaName -> SchemaName -> Ordering
$cp1Ord :: Eq SchemaName
Ord, String -> SchemaName
(String -> SchemaName) -> IsString SchemaName
forall a. (String -> a) -> IsString a
fromString :: String -> SchemaName
$cfromString :: String -> SchemaName
IsString, Int -> SchemaName -> ShowS
[SchemaName] -> ShowS
SchemaName -> String
(Int -> SchemaName -> ShowS)
-> (SchemaName -> String)
-> ([SchemaName] -> ShowS)
-> Show SchemaName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaName] -> ShowS
$cshowList :: [SchemaName] -> ShowS
show :: SchemaName -> String
$cshow :: SchemaName -> String
showsPrec :: Int -> SchemaName -> ShowS
$cshowsPrec :: Int -> SchemaName -> ShowS
Show, Eq SchemaName
Eq SchemaName
-> (Int -> SchemaName -> Int)
-> (SchemaName -> Int)
-> Hashable SchemaName
Int -> SchemaName -> Int
SchemaName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SchemaName -> Int
$chash :: SchemaName -> Int
hashWithSalt :: Int -> SchemaName -> Int
$chashWithSalt :: Int -> SchemaName -> Int
$cp1Hashable :: Eq SchemaName
Hashable)

newtype Subject = Subject { Subject -> Text
unSubject :: Text} deriving (Subject -> Subject -> Bool
(Subject -> Subject -> Bool)
-> (Subject -> Subject -> Bool) -> Eq Subject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subject -> Subject -> Bool
$c/= :: Subject -> Subject -> Bool
== :: Subject -> Subject -> Bool
$c== :: Subject -> Subject -> Bool
Eq, Int -> Subject -> ShowS
[Subject] -> ShowS
Subject -> String
(Int -> Subject -> ShowS)
-> (Subject -> String) -> ([Subject] -> ShowS) -> Show Subject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subject] -> ShowS
$cshowList :: [Subject] -> ShowS
show :: Subject -> String
$cshow :: Subject -> String
showsPrec :: Int -> Subject -> ShowS
$cshowsPrec :: Int -> Subject -> ShowS
Show, String -> Subject
(String -> Subject) -> IsString Subject
forall a. (String -> a) -> IsString a
fromString :: String -> Subject
$cfromString :: String -> Subject
IsString, Eq Subject
Eq Subject
-> (Subject -> Subject -> Ordering)
-> (Subject -> Subject -> Bool)
-> (Subject -> Subject -> Bool)
-> (Subject -> Subject -> Bool)
-> (Subject -> Subject -> Bool)
-> (Subject -> Subject -> Subject)
-> (Subject -> Subject -> Subject)
-> Ord Subject
Subject -> Subject -> Bool
Subject -> Subject -> Ordering
Subject -> Subject -> Subject
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Subject -> Subject -> Subject
$cmin :: Subject -> Subject -> Subject
max :: Subject -> Subject -> Subject
$cmax :: Subject -> Subject -> Subject
>= :: Subject -> Subject -> Bool
$c>= :: Subject -> Subject -> Bool
> :: Subject -> Subject -> Bool
$c> :: Subject -> Subject -> Bool
<= :: Subject -> Subject -> Bool
$c<= :: Subject -> Subject -> Bool
< :: Subject -> Subject -> Bool
$c< :: Subject -> Subject -> Bool
compare :: Subject -> Subject -> Ordering
$ccompare :: Subject -> Subject -> Ordering
$cp1Ord :: Eq Subject
Ord, (forall x. Subject -> Rep Subject x)
-> (forall x. Rep Subject x -> Subject) -> Generic Subject
forall x. Rep Subject x -> Subject
forall x. Subject -> Rep Subject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Subject x -> Subject
$cfrom :: forall x. Subject -> Rep Subject x
Generic, Eq Subject
Eq Subject
-> (Int -> Subject -> Int) -> (Subject -> Int) -> Hashable Subject
Int -> Subject -> Int
Subject -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Subject -> Int
$chash :: Subject -> Int
hashWithSalt :: Int -> Subject -> Int
$chashWithSalt :: Int -> Subject -> Int
$cp1Hashable :: Eq Subject
Hashable)

newtype RegisteredSchema = RegisteredSchema { RegisteredSchema -> Schema
unRegisteredSchema :: Schema} deriving ((forall x. RegisteredSchema -> Rep RegisteredSchema x)
-> (forall x. Rep RegisteredSchema x -> RegisteredSchema)
-> Generic RegisteredSchema
forall x. Rep RegisteredSchema x -> RegisteredSchema
forall x. RegisteredSchema -> Rep RegisteredSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisteredSchema x -> RegisteredSchema
$cfrom :: forall x. RegisteredSchema -> Rep RegisteredSchema x
Generic, Int -> RegisteredSchema -> ShowS
[RegisteredSchema] -> ShowS
RegisteredSchema -> String
(Int -> RegisteredSchema -> ShowS)
-> (RegisteredSchema -> String)
-> ([RegisteredSchema] -> ShowS)
-> Show RegisteredSchema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisteredSchema] -> ShowS
$cshowList :: [RegisteredSchema] -> ShowS
show :: RegisteredSchema -> String
$cshow :: RegisteredSchema -> String
showsPrec :: Int -> RegisteredSchema -> ShowS
$cshowsPrec :: Int -> RegisteredSchema -> ShowS
Show)

newtype Version = Version { Version -> Word32
unVersion :: Word32 } deriving (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Eq Version
Eq Version
-> (Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmax :: Version -> Version -> Version
>= :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c< :: Version -> Version -> Bool
compare :: Version -> Version -> Ordering
$ccompare :: Version -> Version -> Ordering
$cp1Ord :: Eq Version
Ord, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show, Eq Version
Eq Version
-> (Int -> Version -> Int) -> (Version -> Int) -> Hashable Version
Int -> Version -> Int
Version -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Version -> Int
$chash :: Version -> Int
hashWithSalt :: Int -> Version -> Int
$chashWithSalt :: Int -> Version -> Int
$cp1Hashable :: Eq Version
Hashable)

data Compatibility = NoCompatibility
                   | FullCompatibility
                   | ForwardCompatibility
                   | BackwardCompatibility
                   deriving (Compatibility -> Compatibility -> Bool
(Compatibility -> Compatibility -> Bool)
-> (Compatibility -> Compatibility -> Bool) -> Eq Compatibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Compatibility -> Compatibility -> Bool
$c/= :: Compatibility -> Compatibility -> Bool
== :: Compatibility -> Compatibility -> Bool
$c== :: Compatibility -> Compatibility -> Bool
Eq, Int -> Compatibility -> ShowS
[Compatibility] -> ShowS
Compatibility -> String
(Int -> Compatibility -> ShowS)
-> (Compatibility -> String)
-> ([Compatibility] -> ShowS)
-> Show Compatibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Compatibility] -> ShowS
$cshowList :: [Compatibility] -> ShowS
show :: Compatibility -> String
$cshow :: Compatibility -> String
showsPrec :: Int -> Compatibility -> ShowS
$cshowsPrec :: Int -> Compatibility -> ShowS
Show, Eq Compatibility
Eq Compatibility
-> (Compatibility -> Compatibility -> Ordering)
-> (Compatibility -> Compatibility -> Bool)
-> (Compatibility -> Compatibility -> Bool)
-> (Compatibility -> Compatibility -> Bool)
-> (Compatibility -> Compatibility -> Bool)
-> (Compatibility -> Compatibility -> Compatibility)
-> (Compatibility -> Compatibility -> Compatibility)
-> Ord Compatibility
Compatibility -> Compatibility -> Bool
Compatibility -> Compatibility -> Ordering
Compatibility -> Compatibility -> Compatibility
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Compatibility -> Compatibility -> Compatibility
$cmin :: Compatibility -> Compatibility -> Compatibility
max :: Compatibility -> Compatibility -> Compatibility
$cmax :: Compatibility -> Compatibility -> Compatibility
>= :: Compatibility -> Compatibility -> Bool
$c>= :: Compatibility -> Compatibility -> Bool
> :: Compatibility -> Compatibility -> Bool
$c> :: Compatibility -> Compatibility -> Bool
<= :: Compatibility -> Compatibility -> Bool
$c<= :: Compatibility -> Compatibility -> Bool
< :: Compatibility -> Compatibility -> Bool
$c< :: Compatibility -> Compatibility -> Bool
compare :: Compatibility -> Compatibility -> Ordering
$ccompare :: Compatibility -> Compatibility -> Ordering
$cp1Ord :: Eq Compatibility
Ord)

data SchemaRegistry = SchemaRegistry
  { SchemaRegistry -> Cache SchemaId Schema
srCache        :: Cache SchemaId Schema
  , SchemaRegistry -> Cache (Subject, SchemaName) SchemaId
srReverseCache :: Cache (Subject, SchemaName) SchemaId
  , SchemaRegistry -> String
srBaseUrl      :: String
  , SchemaRegistry -> Maybe Auth
srAuth         :: Maybe Wreq.Auth
  }

data SchemaRegistryError = SchemaRegistryConnectError String
                         | SchemaRegistryLoadError SchemaId
                         | SchemaRegistrySchemaNotFound SchemaId
                         | SchemaRegistrySendError String
                         deriving (Int -> SchemaRegistryError -> ShowS
[SchemaRegistryError] -> ShowS
SchemaRegistryError -> String
(Int -> SchemaRegistryError -> ShowS)
-> (SchemaRegistryError -> String)
-> ([SchemaRegistryError] -> ShowS)
-> Show SchemaRegistryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaRegistryError] -> ShowS
$cshowList :: [SchemaRegistryError] -> ShowS
show :: SchemaRegistryError -> String
$cshow :: SchemaRegistryError -> String
showsPrec :: Int -> SchemaRegistryError -> ShowS
$cshowsPrec :: Int -> SchemaRegistryError -> ShowS
Show, SchemaRegistryError -> SchemaRegistryError -> Bool
(SchemaRegistryError -> SchemaRegistryError -> Bool)
-> (SchemaRegistryError -> SchemaRegistryError -> Bool)
-> Eq SchemaRegistryError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemaRegistryError -> SchemaRegistryError -> Bool
$c/= :: SchemaRegistryError -> SchemaRegistryError -> Bool
== :: SchemaRegistryError -> SchemaRegistryError -> Bool
$c== :: SchemaRegistryError -> SchemaRegistryError -> Bool
Eq)

schemaRegistry :: MonadIO m => String -> m SchemaRegistry
schemaRegistry :: String -> m SchemaRegistry
schemaRegistry = Maybe Auth -> String -> m SchemaRegistry
forall (m :: * -> *).
MonadIO m =>
Maybe Auth -> String -> m SchemaRegistry
schemaRegistry_ Maybe Auth
forall a. Maybe a
Nothing

schemaRegistry_ :: MonadIO m => Maybe Wreq.Auth -> String -> m SchemaRegistry
schemaRegistry_ :: Maybe Auth -> String -> m SchemaRegistry
schemaRegistry_ Maybe Auth
auth String
url = IO SchemaRegistry -> m SchemaRegistry
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SchemaRegistry -> m SchemaRegistry)
-> IO SchemaRegistry -> m SchemaRegistry
forall a b. (a -> b) -> a -> b
$
    Cache SchemaId Schema
-> Cache (Subject, SchemaName) SchemaId
-> String
-> Maybe Auth
-> SchemaRegistry
SchemaRegistry
    (Cache SchemaId Schema
 -> Cache (Subject, SchemaName) SchemaId
 -> String
 -> Maybe Auth
 -> SchemaRegistry)
-> IO (Cache SchemaId Schema)
-> IO
     (Cache (Subject, SchemaName) SchemaId
      -> String -> Maybe Auth -> SchemaRegistry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TimeSpec -> IO (Cache SchemaId Schema)
forall k v. Maybe TimeSpec -> IO (Cache k v)
newCache Maybe TimeSpec
forall a. Maybe a
Nothing
    IO
  (Cache (Subject, SchemaName) SchemaId
   -> String -> Maybe Auth -> SchemaRegistry)
-> IO (Cache (Subject, SchemaName) SchemaId)
-> IO (String -> Maybe Auth -> SchemaRegistry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe TimeSpec -> IO (Cache (Subject, SchemaName) SchemaId)
forall k v. Maybe TimeSpec -> IO (Cache k v)
newCache Maybe TimeSpec
forall a. Maybe a
Nothing
    IO (String -> Maybe Auth -> SchemaRegistry)
-> IO String -> IO (Maybe Auth -> SchemaRegistry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
url
    IO (Maybe Auth -> SchemaRegistry)
-> IO (Maybe Auth) -> IO SchemaRegistry
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Auth -> IO (Maybe Auth)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Auth
auth


loadSchema :: MonadIO m => SchemaRegistry -> SchemaId -> m (Either SchemaRegistryError Schema)
loadSchema :: SchemaRegistry -> SchemaId -> m (Either SchemaRegistryError Schema)
loadSchema SchemaRegistry
sr SchemaId
sid = do
  Maybe Schema
sc <- SchemaRegistry -> SchemaId -> m (Maybe Schema)
forall (m :: * -> *).
MonadIO m =>
SchemaRegistry -> SchemaId -> m (Maybe Schema)
cachedSchema SchemaRegistry
sr SchemaId
sid
  case Maybe Schema
sc of
    Just Schema
s  -> Either SchemaRegistryError Schema
-> m (Either SchemaRegistryError Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> Either SchemaRegistryError Schema
forall a b. b -> Either a b
Right Schema
s)
    Maybe Schema
Nothing -> IO (Either SchemaRegistryError Schema)
-> m (Either SchemaRegistryError Schema)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SchemaRegistryError Schema)
 -> m (Either SchemaRegistryError Schema))
-> IO (Either SchemaRegistryError Schema)
-> m (Either SchemaRegistryError Schema)
forall a b. (a -> b) -> a -> b
$ do
      Either SchemaRegistryError RegisteredSchema
res <- SchemaRegistry
-> SchemaId -> IO (Either SchemaRegistryError RegisteredSchema)
getSchemaById SchemaRegistry
sr SchemaId
sid
      (RegisteredSchema -> IO Schema)
-> Either SchemaRegistryError RegisteredSchema
-> IO (Either SchemaRegistryError Schema)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((\Schema
schema -> Schema
schema Schema -> IO () -> IO Schema
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SchemaRegistry -> SchemaId -> Schema -> IO ()
forall (m :: * -> *).
MonadIO m =>
SchemaRegistry -> SchemaId -> Schema -> m ()
cacheSchema SchemaRegistry
sr SchemaId
sid Schema
schema) (Schema -> IO Schema)
-> (RegisteredSchema -> Schema) -> RegisteredSchema -> IO Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisteredSchema -> Schema
unRegisteredSchema) Either SchemaRegistryError RegisteredSchema
res

loadSubjectSchema :: MonadIO m => SchemaRegistry -> Subject -> Version -> m (Either SchemaRegistryError Schema)
loadSubjectSchema :: SchemaRegistry
-> Subject -> Version -> m (Either SchemaRegistryError Schema)
loadSubjectSchema SchemaRegistry
sr (Subject Text
sbj) (Version Word32
version) = do
    let url :: String
url     = SchemaRegistry -> String
srBaseUrl SchemaRegistry
sr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/subjects/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
sbj String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/versions/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
version
    Response ByteString
resp        <- IO (Response ByteString) -> m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> m (Response ByteString))
-> IO (Response ByteString) -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> IO (Response ByteString)
Wreq.getWith (SchemaRegistry -> Options
wreqOpts SchemaRegistry
sr) String
url
    let wrapped :: Either SchemaRegistryError Value
wrapped = (SomeException -> SchemaRegistryError)
-> (Response Value -> Value)
-> Either SomeException (Response Value)
-> Either SchemaRegistryError Value
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap SomeException -> SchemaRegistryError
wrapError (Getting Value (Response Value) Value -> Response Value -> Value
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Value (Response Value) Value
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody) (Response ByteString -> Either SomeException (Response Value)
forall (m :: * -> *).
MonadThrow m =>
Response ByteString -> m (Response Value)
Wreq.asValue Response ByteString
resp)

    Either SchemaRegistryError RegisteredSchema
schema   <- String
-> Either SchemaRegistryError Value
-> m (Either SchemaRegistryError RegisteredSchema)
forall (m :: * -> *) a e.
(MonadIO m, FromJSON a) =>
String -> Either e Value -> m (Either e a)
getData String
"schema" Either SchemaRegistryError Value
wrapped
    Either SchemaRegistryError SchemaId
schemaId <- String
-> Either SchemaRegistryError Value
-> m (Either SchemaRegistryError SchemaId)
forall (m :: * -> *) a e.
(MonadIO m, FromJSON a) =>
String -> Either e Value -> m (Either e a)
getData String
"id" Either SchemaRegistryError Value
wrapped

    case (,) (RegisteredSchema -> SchemaId -> (RegisteredSchema, SchemaId))
-> Either SchemaRegistryError RegisteredSchema
-> Either
     SchemaRegistryError (SchemaId -> (RegisteredSchema, SchemaId))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SchemaRegistryError RegisteredSchema
schema Either
  SchemaRegistryError (SchemaId -> (RegisteredSchema, SchemaId))
-> Either SchemaRegistryError SchemaId
-> Either SchemaRegistryError (RegisteredSchema, SchemaId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either SchemaRegistryError SchemaId
schemaId of
      Left SchemaRegistryError
err                                    -> Either SchemaRegistryError Schema
-> m (Either SchemaRegistryError Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SchemaRegistryError Schema
 -> m (Either SchemaRegistryError Schema))
-> Either SchemaRegistryError Schema
-> m (Either SchemaRegistryError Schema)
forall a b. (a -> b) -> a -> b
$ SchemaRegistryError -> Either SchemaRegistryError Schema
forall a b. a -> Either a b
Left SchemaRegistryError
err
      Right (RegisteredSchema Schema
schema, SchemaId
schemaId) -> SchemaRegistry -> SchemaId -> Schema -> m ()
forall (m :: * -> *).
MonadIO m =>
SchemaRegistry -> SchemaId -> Schema -> m ()
cacheSchema SchemaRegistry
sr SchemaId
schemaId Schema
schema m ()
-> Either SchemaRegistryError Schema
-> m (Either SchemaRegistryError Schema)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Schema -> Either SchemaRegistryError Schema
forall a b. b -> Either a b
Right Schema
schema
  where
    getData :: (MonadIO m, FromJSON a) => String -> Either e Value -> m (Either e a)
    getData :: String -> Either e Value -> m (Either e a)
getData String
key = (e -> m (Either e a))
-> (Value -> m (Either e a)) -> Either e Value -> m (Either e a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either e a -> m (Either e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a))
-> (e -> Either e a) -> e -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left) (String -> Value -> m (Either e a)
forall (m :: * -> *) a e.
(MonadIO m, FromJSON a) =>
String -> Value -> m (Either e a)
viewData String
key)

    viewData :: (MonadIO m, FromJSON a) => String -> Value -> m (Either e a)
    viewData :: String -> Value -> m (Either e a)
viewData String
key Value
value = IO (Either e a) -> m (Either e a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either e a) -> m (Either e a))
-> IO (Either e a) -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ (String -> IO (Either e a))
-> (a -> IO (Either e a)) -> Either String a -> IO (Either e a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (JSONError -> IO (Either e a)
forall e a. Exception e => e -> IO a
throwIO (JSONError -> IO (Either e a))
-> (String -> JSONError) -> String -> IO (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JSONError
Wreq.JSONError)
                                         (Either e a -> IO (Either e a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> IO (Either e a))
-> (a -> Either e a) -> a -> IO (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either e a
forall (m :: * -> *) a. Monad m => a -> m a
return)
                                         (Value -> Either String a
forall a. FromJSON a => Value -> Either String a
toData Value
value)

    toData :: FromJSON a => Value -> Either String a
    toData :: Value -> Either String a
toData Value
value = case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
value of
                     Success a
a -> a -> Either String a
forall a b. b -> Either a b
Right a
a
                     Error String
e   -> String -> Either String a
forall a b. a -> Either a b
Left String
e

sendSchema :: MonadIO m => SchemaRegistry -> Subject -> Schema -> m (Either SchemaRegistryError SchemaId)
sendSchema :: SchemaRegistry
-> Subject -> Schema -> m (Either SchemaRegistryError SchemaId)
sendSchema SchemaRegistry
sr Subject
subj Schema
sc = do
  Maybe SchemaId
sid <- SchemaRegistry -> Subject -> SchemaName -> m (Maybe SchemaId)
forall (m :: * -> *).
MonadIO m =>
SchemaRegistry -> Subject -> SchemaName -> m (Maybe SchemaId)
cachedId SchemaRegistry
sr Subject
subj SchemaName
schemaName
  case Maybe SchemaId
sid of
    Just SchemaId
sid' -> Either SchemaRegistryError SchemaId
-> m (Either SchemaRegistryError SchemaId)
forall (m :: * -> *) a. Monad m => a -> m a
return (SchemaId -> Either SchemaRegistryError SchemaId
forall a b. b -> Either a b
Right SchemaId
sid')
    Maybe SchemaId
Nothing   -> do
      Either SchemaRegistryError SchemaId
res <- IO (Either SchemaRegistryError SchemaId)
-> m (Either SchemaRegistryError SchemaId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SchemaRegistryError SchemaId)
 -> m (Either SchemaRegistryError SchemaId))
-> IO (Either SchemaRegistryError SchemaId)
-> m (Either SchemaRegistryError SchemaId)
forall a b. (a -> b) -> a -> b
$ SchemaRegistry
-> Subject
-> RegisteredSchema
-> IO (Either SchemaRegistryError SchemaId)
putSchema SchemaRegistry
sr Subject
subj (Schema -> RegisteredSchema
RegisteredSchema Schema
sc)
      (SchemaId -> m ()) -> Either SchemaRegistryError SchemaId -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (SchemaRegistry -> Subject -> SchemaName -> SchemaId -> m ()
forall (m :: * -> *).
MonadIO m =>
SchemaRegistry -> Subject -> SchemaName -> SchemaId -> m ()
cacheId SchemaRegistry
sr Subject
subj SchemaName
schemaName) Either SchemaRegistryError SchemaId
res
      (SchemaId -> m ()) -> Either SchemaRegistryError SchemaId -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\SchemaId
sid' -> SchemaRegistry -> SchemaId -> Schema -> m ()
forall (m :: * -> *).
MonadIO m =>
SchemaRegistry -> SchemaId -> Schema -> m ()
cacheSchema SchemaRegistry
sr SchemaId
sid' Schema
sc) Either SchemaRegistryError SchemaId
res
      Either SchemaRegistryError SchemaId
-> m (Either SchemaRegistryError SchemaId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SchemaRegistryError SchemaId
res
  where
    schemaName :: SchemaName
schemaName = Schema -> SchemaName
fullTypeName Schema
sc

getVersions :: MonadIO m => SchemaRegistry -> Subject -> m (Either SchemaRegistryError [Version])
getVersions :: SchemaRegistry
-> Subject -> m (Either SchemaRegistryError [Version])
getVersions SchemaRegistry
sr (Subject Text
sbj) = do
  let url :: String
url = SchemaRegistry -> String
srBaseUrl SchemaRegistry
sr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/subjects/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
sbj String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/versions"
  Response ByteString
resp <- IO (Response ByteString) -> m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> m (Response ByteString))
-> IO (Response ByteString) -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> IO (Response ByteString)
Wreq.getWith (SchemaRegistry -> Options
wreqOpts SchemaRegistry
sr) String
url
  Either SchemaRegistryError [Version]
-> m (Either SchemaRegistryError [Version])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SchemaRegistryError [Version]
 -> m (Either SchemaRegistryError [Version]))
-> Either SchemaRegistryError [Version]
-> m (Either SchemaRegistryError [Version])
forall a b. (a -> b) -> a -> b
$ (SomeException -> SchemaRegistryError)
-> (Response [Word32] -> [Version])
-> Either SomeException (Response [Word32])
-> Either SchemaRegistryError [Version]
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap SomeException -> SchemaRegistryError
wrapError ((Word32 -> Version) -> [Word32] -> [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Version
Version ([Word32] -> [Version])
-> (Response [Word32] -> [Word32])
-> Response [Word32]
-> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [Word32] (Response [Word32]) [Word32]
-> Response [Word32] -> [Word32]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Word32] (Response [Word32]) [Word32]
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody) (Response ByteString -> Either SomeException (Response [Word32])
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Response ByteString -> m (Response a)
Wreq.asJSON Response ByteString
resp)

isCompatible :: MonadIO m => SchemaRegistry -> Subject -> Version -> Schema -> m (Either SchemaRegistryError Bool)
isCompatible :: SchemaRegistry
-> Subject
-> Version
-> Schema
-> m (Either SchemaRegistryError Bool)
isCompatible SchemaRegistry
sr (Subject Text
sbj) (Version Word32
version) Schema
schema = do
  let url :: String
url     =  SchemaRegistry -> String
srBaseUrl SchemaRegistry
sr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/compatibility/subjects/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
sbj String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/versions/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
version
  Response ByteString
resp        <- IO (Response ByteString) -> m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> m (Response ByteString))
-> IO (Response ByteString) -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> Value -> IO (Response ByteString)
forall a.
Postable a =>
Options -> String -> a -> IO (Response ByteString)
Wreq.postWith (SchemaRegistry -> Options
wreqOpts SchemaRegistry
sr) String
url (RegisteredSchema -> Value
forall a. ToJSON a => a -> Value
toJSON (RegisteredSchema -> Value) -> RegisteredSchema -> Value
forall a b. (a -> b) -> a -> b
$ Schema -> RegisteredSchema
RegisteredSchema Schema
schema)
  let wrapped :: Either SchemaRegistryError Value
wrapped =  (SomeException -> SchemaRegistryError)
-> (Response Value -> Value)
-> Either SomeException (Response Value)
-> Either SchemaRegistryError Value
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap SomeException -> SchemaRegistryError
wrapError (Getting Value (Response Value) Value -> Response Value -> Value
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Value (Response Value) Value
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody) (Response ByteString -> Either SomeException (Response Value)
forall (m :: * -> *).
MonadThrow m =>
Response ByteString -> m (Response Value)
Wreq.asValue Response ByteString
resp)
  (SchemaRegistryError -> m (Either SchemaRegistryError Bool))
-> (Value -> m (Either SchemaRegistryError Bool))
-> Either SchemaRegistryError Value
-> m (Either SchemaRegistryError Bool)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either SchemaRegistryError Bool
-> m (Either SchemaRegistryError Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SchemaRegistryError Bool
 -> m (Either SchemaRegistryError Bool))
-> (SchemaRegistryError -> Either SchemaRegistryError Bool)
-> SchemaRegistryError
-> m (Either SchemaRegistryError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaRegistryError -> Either SchemaRegistryError Bool
forall a b. a -> Either a b
Left) Value -> m (Either SchemaRegistryError Bool)
forall (m :: * -> *) e. MonadIO m => Value -> m (Either e Bool)
getCompatibility Either SchemaRegistryError Value
wrapped
  where
    getCompatibility :: MonadIO m => Value -> m (Either e Bool)
    getCompatibility :: Value -> m (Either e Bool)
getCompatibility = IO (Either e Bool) -> m (Either e Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either e Bool) -> m (Either e Bool))
-> (Value -> IO (Either e Bool)) -> Value -> m (Either e Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either e Bool)
-> (Bool -> IO (Either e Bool)) -> Maybe Bool -> IO (Either e Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (JSONError -> IO (Either e Bool)
forall e a. Exception e => e -> IO a
throwIO (JSONError -> IO (Either e Bool))
-> JSONError -> IO (Either e Bool)
forall a b. (a -> b) -> a -> b
$ String -> JSONError
Wreq.JSONError String
"Missing key 'is_compatible' in Schema Registry response") (Either e Bool -> IO (Either e Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e Bool -> IO (Either e Bool))
-> (Bool -> Either e Bool) -> Bool -> IO (Either e Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either e Bool
forall (m :: * -> *) a. Monad m => a -> m a
return) (Maybe Bool -> IO (Either e Bool))
-> (Value -> Maybe Bool) -> Value -> IO (Either e Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe Bool
viewCompatibility

    viewCompatibility :: Value -> Maybe Bool
    viewCompatibility :: Value -> Maybe Bool
viewCompatibility (Object Object
obj) = Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"is_compatible" Object
obj Maybe Value -> (Value -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe Bool
toBool
    viewCompatibility Value
_            = Maybe Bool
forall a. Maybe a
Nothing

    toBool :: Value -> Maybe Bool
    toBool :: Value -> Maybe Bool
toBool (Bool Bool
b) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b
    toBool Value
_        = Maybe Bool
forall a. Maybe a
Nothing

getGlobalConfig :: MonadIO m => SchemaRegistry -> m (Either SchemaRegistryError Compatibility)
getGlobalConfig :: SchemaRegistry -> m (Either SchemaRegistryError Compatibility)
getGlobalConfig SchemaRegistry
sr = do
  let url :: String
url = SchemaRegistry -> String
srBaseUrl SchemaRegistry
sr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/config"
  Response ByteString
resp <- IO (Response ByteString) -> m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> m (Response ByteString))
-> IO (Response ByteString) -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> IO (Response ByteString)
Wreq.getWith (SchemaRegistry -> Options
wreqOpts SchemaRegistry
sr) String
url
  Either SchemaRegistryError Compatibility
-> m (Either SchemaRegistryError Compatibility)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SchemaRegistryError Compatibility
 -> m (Either SchemaRegistryError Compatibility))
-> Either SchemaRegistryError Compatibility
-> m (Either SchemaRegistryError Compatibility)
forall a b. (a -> b) -> a -> b
$ (SomeException -> SchemaRegistryError)
-> (Response Compatibility -> Compatibility)
-> Either SomeException (Response Compatibility)
-> Either SchemaRegistryError Compatibility
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap SomeException -> SchemaRegistryError
wrapError (Getting Compatibility (Response Compatibility) Compatibility
-> Response Compatibility -> Compatibility
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Compatibility (Response Compatibility) Compatibility
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody) (Response ByteString
-> Either SomeException (Response Compatibility)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Response ByteString -> m (Response a)
Wreq.asJSON Response ByteString
resp)

getSubjectConfig :: MonadIO m => SchemaRegistry -> Subject -> m (Either SchemaRegistryError Compatibility)
getSubjectConfig :: SchemaRegistry
-> Subject -> m (Either SchemaRegistryError Compatibility)
getSubjectConfig SchemaRegistry
sr (Subject Text
sbj) = do
  let url :: String
url = SchemaRegistry -> String
srBaseUrl SchemaRegistry
sr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/config/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
sbj
  Response ByteString
resp <- IO (Response ByteString) -> m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> m (Response ByteString))
-> IO (Response ByteString) -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> IO (Response ByteString)
Wreq.getWith (SchemaRegistry -> Options
wreqOpts SchemaRegistry
sr) String
url
  Either SchemaRegistryError Compatibility
-> m (Either SchemaRegistryError Compatibility)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SchemaRegistryError Compatibility
 -> m (Either SchemaRegistryError Compatibility))
-> Either SchemaRegistryError Compatibility
-> m (Either SchemaRegistryError Compatibility)
forall a b. (a -> b) -> a -> b
$ (SomeException -> SchemaRegistryError)
-> (Response Compatibility -> Compatibility)
-> Either SomeException (Response Compatibility)
-> Either SchemaRegistryError Compatibility
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap SomeException -> SchemaRegistryError
wrapError (Getting Compatibility (Response Compatibility) Compatibility
-> Response Compatibility -> Compatibility
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Compatibility (Response Compatibility) Compatibility
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody) (Response ByteString
-> Either SomeException (Response Compatibility)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Response ByteString -> m (Response a)
Wreq.asJSON Response ByteString
resp)

getSubjects :: MonadIO m => SchemaRegistry -> m (Either SchemaRegistryError [Subject])
getSubjects :: SchemaRegistry -> m (Either SchemaRegistryError [Subject])
getSubjects SchemaRegistry
sr = do
  let url :: String
url = SchemaRegistry -> String
srBaseUrl SchemaRegistry
sr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/subjects"
  Response ByteString
resp <- IO (Response ByteString) -> m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> m (Response ByteString))
-> IO (Response ByteString) -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> IO (Response ByteString)
Wreq.getWith (SchemaRegistry -> Options
wreqOpts SchemaRegistry
sr) String
url
  Either SchemaRegistryError [Subject]
-> m (Either SchemaRegistryError [Subject])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SchemaRegistryError [Subject]
 -> m (Either SchemaRegistryError [Subject]))
-> Either SchemaRegistryError [Subject]
-> m (Either SchemaRegistryError [Subject])
forall a b. (a -> b) -> a -> b
$ (SomeException -> SchemaRegistryError)
-> (Response [Text] -> [Subject])
-> Either SomeException (Response [Text])
-> Either SchemaRegistryError [Subject]
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap SomeException -> SchemaRegistryError
wrapError ((Text -> Subject) -> [Text] -> [Subject]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Subject
Subject ([Text] -> [Subject])
-> (Response [Text] -> [Text]) -> Response [Text] -> [Subject]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [Text] (Response [Text]) [Text]
-> Response [Text] -> [Text]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Text] (Response [Text]) [Text]
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody) (Response ByteString -> Either SomeException (Response [Text])
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Response ByteString -> m (Response a)
Wreq.asJSON Response ByteString
resp)

------------------ PRIVATE: HELPERS --------------------------------------------

wreqOpts :: SchemaRegistry -> Wreq.Options
wreqOpts :: SchemaRegistry -> Options
wreqOpts SchemaRegistry
sr =
  let
    accept :: [ByteString]
accept       = [ByteString
"application/vnd.schemaregistry.v1+json", ByteString
"application/vnd.schemaregistry+json", ByteString
"application/json"]
    acceptHeader :: Options -> Options
acceptHeader = HeaderName -> Lens' Options [ByteString]
Wreq.header HeaderName
"Accept" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString]
accept
    authHeader :: Options -> Options
authHeader   = (Maybe Auth -> Identity (Maybe Auth))
-> Options -> Identity Options
Lens' Options (Maybe Auth)
Wreq.auth ((Maybe Auth -> Identity (Maybe Auth))
 -> Options -> Identity Options)
-> Maybe Auth -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SchemaRegistry -> Maybe Auth
srAuth SchemaRegistry
sr
  in Options
Wreq.defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Options -> Options
acceptHeader Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Options -> Options
authHeader

getSchemaById :: SchemaRegistry -> SchemaId -> IO (Either SchemaRegistryError RegisteredSchema)
getSchemaById :: SchemaRegistry
-> SchemaId -> IO (Either SchemaRegistryError RegisteredSchema)
getSchemaById SchemaRegistry
sr sid :: SchemaId
sid@(SchemaId Int32
i) = ExceptT SchemaRegistryError IO RegisteredSchema
-> IO (Either SchemaRegistryError RegisteredSchema)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT SchemaRegistryError IO RegisteredSchema
 -> IO (Either SchemaRegistryError RegisteredSchema))
-> ExceptT SchemaRegistryError IO RegisteredSchema
-> IO (Either SchemaRegistryError RegisteredSchema)
forall a b. (a -> b) -> a -> b
$ do
  let
    baseUrl :: String
baseUrl   = SchemaRegistry -> String
srBaseUrl SchemaRegistry
sr
    schemaUrl :: String
schemaUrl = String
baseUrl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/schemas/ids/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int32 -> String
forall a. Show a => a -> String
show Int32
i
  Response ByteString
resp <- (SomeException -> SchemaRegistryError)
-> ExceptT SomeException IO (Response ByteString)
-> ExceptT SchemaRegistryError IO (Response ByteString)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT SomeException -> SchemaRegistryError
wrapError (ExceptT SomeException IO (Response ByteString)
 -> ExceptT SchemaRegistryError IO (Response ByteString))
-> (IO (Response ByteString)
    -> ExceptT SomeException IO (Response ByteString))
-> IO (Response ByteString)
-> ExceptT SchemaRegistryError IO (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either SomeException (Response ByteString))
-> ExceptT SomeException IO (Response ByteString)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either SomeException (Response ByteString))
 -> ExceptT SomeException IO (Response ByteString))
-> (IO (Response ByteString)
    -> IO (Either SomeException (Response ByteString)))
-> IO (Response ByteString)
-> ExceptT SomeException IO (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Response ByteString)
-> IO (Either SomeException (Response ByteString))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (IO (Response ByteString)
 -> ExceptT SchemaRegistryError IO (Response ByteString))
-> IO (Response ByteString)
-> ExceptT SchemaRegistryError IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> IO (Response ByteString)
Wreq.getWith (SchemaRegistry -> Options
wreqOpts SchemaRegistry
sr) String
schemaUrl
  Either SchemaRegistryError RegisteredSchema
-> ExceptT SchemaRegistryError IO RegisteredSchema
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either SchemaRegistryError RegisteredSchema
 -> ExceptT SchemaRegistryError IO RegisteredSchema)
-> Either SchemaRegistryError RegisteredSchema
-> ExceptT SchemaRegistryError IO RegisteredSchema
forall a b. (a -> b) -> a -> b
$ (SomeException -> SchemaRegistryError)
-> (Response RegisteredSchema -> RegisteredSchema)
-> Either SomeException (Response RegisteredSchema)
-> Either SchemaRegistryError RegisteredSchema
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (SchemaRegistryError -> SomeException -> SchemaRegistryError
forall a b. a -> b -> a
const (SchemaId -> SchemaRegistryError
SchemaRegistryLoadError SchemaId
sid)) (Getting
  RegisteredSchema (Response RegisteredSchema) RegisteredSchema
-> Response RegisteredSchema -> RegisteredSchema
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  RegisteredSchema (Response RegisteredSchema) RegisteredSchema
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody) (Response ByteString
-> Either SomeException (Response RegisteredSchema)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Response ByteString -> m (Response a)
Wreq.asJSON Response ByteString
resp)

putSchema :: SchemaRegistry -> Subject -> RegisteredSchema -> IO (Either SchemaRegistryError SchemaId)
putSchema :: SchemaRegistry
-> Subject
-> RegisteredSchema
-> IO (Either SchemaRegistryError SchemaId)
putSchema SchemaRegistry
sr (Subject Text
sbj) RegisteredSchema
schema = ExceptT SchemaRegistryError IO SchemaId
-> IO (Either SchemaRegistryError SchemaId)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT SchemaRegistryError IO SchemaId
 -> IO (Either SchemaRegistryError SchemaId))
-> ExceptT SchemaRegistryError IO SchemaId
-> IO (Either SchemaRegistryError SchemaId)
forall a b. (a -> b) -> a -> b
$ do
  let
    baseUrl :: String
baseUrl   = SchemaRegistry -> String
srBaseUrl SchemaRegistry
sr
    schemaUrl :: String
schemaUrl = String
baseUrl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/subjects/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
sbj String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/versions"
  Response ByteString
resp <- (SomeException -> SchemaRegistryError)
-> ExceptT SomeException IO (Response ByteString)
-> ExceptT SchemaRegistryError IO (Response ByteString)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT SomeException -> SchemaRegistryError
wrapError (ExceptT SomeException IO (Response ByteString)
 -> ExceptT SchemaRegistryError IO (Response ByteString))
-> (IO (Response ByteString)
    -> ExceptT SomeException IO (Response ByteString))
-> IO (Response ByteString)
-> ExceptT SchemaRegistryError IO (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either SomeException (Response ByteString))
-> ExceptT SomeException IO (Response ByteString)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either SomeException (Response ByteString))
 -> ExceptT SomeException IO (Response ByteString))
-> (IO (Response ByteString)
    -> IO (Either SomeException (Response ByteString)))
-> IO (Response ByteString)
-> ExceptT SomeException IO (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Response ByteString)
-> IO (Either SomeException (Response ByteString))
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (IO (Response ByteString)
 -> ExceptT SchemaRegistryError IO (Response ByteString))
-> IO (Response ByteString)
-> ExceptT SchemaRegistryError IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> Value -> IO (Response ByteString)
forall a.
Postable a =>
Options -> String -> a -> IO (Response ByteString)
Wreq.postWith (SchemaRegistry -> Options
wreqOpts SchemaRegistry
sr) String
schemaUrl (RegisteredSchema -> Value
forall a. ToJSON a => a -> Value
toJSON RegisteredSchema
schema)
  Either SchemaRegistryError SchemaId
-> ExceptT SchemaRegistryError IO SchemaId
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either SchemaRegistryError SchemaId
 -> ExceptT SchemaRegistryError IO SchemaId)
-> Either SchemaRegistryError SchemaId
-> ExceptT SchemaRegistryError IO SchemaId
forall a b. (a -> b) -> a -> b
$ (SomeException -> SchemaRegistryError)
-> (Response SchemaId -> SchemaId)
-> Either SomeException (Response SchemaId)
-> Either SchemaRegistryError SchemaId
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap SomeException -> SchemaRegistryError
wrapError (Getting SchemaId (Response SchemaId) SchemaId
-> Response SchemaId -> SchemaId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SchemaId (Response SchemaId) SchemaId
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody) (Response ByteString -> Either SomeException (Response SchemaId)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Response ByteString -> m (Response a)
Wreq.asJSON Response ByteString
resp)

fromHttpError :: HttpException -> (HttpExceptionContent -> SchemaRegistryError) -> SchemaRegistryError
fromHttpError :: HttpException
-> (HttpExceptionContent -> SchemaRegistryError)
-> SchemaRegistryError
fromHttpError HttpException
err HttpExceptionContent -> SchemaRegistryError
f = case HttpException
err of
  InvalidUrlException String
fld String
err'                      -> String -> SchemaRegistryError
SchemaRegistryConnectError (String
fld String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err')
  HttpExceptionRequest Request
_ (ConnectionFailure SomeException
err)    -> String -> SchemaRegistryError
SchemaRegistryConnectError (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
err)
  HttpExceptionRequest Request
_ HttpExceptionContent
ConnectionTimeout          -> String -> SchemaRegistryError
SchemaRegistryConnectError (HttpException -> String
forall e. Exception e => e -> String
displayException HttpException
err)
  HttpExceptionRequest Request
_ ProxyConnectException{}    -> String -> SchemaRegistryError
SchemaRegistryConnectError (HttpException -> String
forall e. Exception e => e -> String
displayException HttpException
err)
  HttpExceptionRequest Request
_ HttpExceptionContent
ConnectionClosed           -> String -> SchemaRegistryError
SchemaRegistryConnectError (HttpException -> String
forall e. Exception e => e -> String
displayException HttpException
err)
  HttpExceptionRequest Request
_ (InvalidDestinationHost ByteString
_) -> String -> SchemaRegistryError
SchemaRegistryConnectError (HttpException -> String
forall e. Exception e => e -> String
displayException HttpException
err)
  HttpExceptionRequest Request
_ HttpExceptionContent
TlsNotSupported            -> String -> SchemaRegistryError
SchemaRegistryConnectError (HttpException -> String
forall e. Exception e => e -> String
displayException HttpException
err)

  HttpExceptionRequest Request
_ (InvalidProxySettings Text
_)   -> String -> SchemaRegistryError
SchemaRegistryConnectError (HttpException -> String
forall e. Exception e => e -> String
displayException HttpException
err)

  HttpExceptionRequest Request
_ HttpExceptionContent
err'                       -> HttpExceptionContent -> SchemaRegistryError
f HttpExceptionContent
err'

wrapError :: SomeException -> SchemaRegistryError
wrapError :: SomeException -> SchemaRegistryError
wrapError SomeException
someErr = case SomeException -> Maybe HttpException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
someErr of
  Maybe HttpException
Nothing      -> String -> SchemaRegistryError
SchemaRegistrySendError (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
someErr)
  Just HttpException
httpErr -> HttpException
-> (HttpExceptionContent -> SchemaRegistryError)
-> SchemaRegistryError
fromHttpError HttpException
httpErr (\HttpExceptionContent
_ -> String -> SchemaRegistryError
SchemaRegistrySendError (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
someErr))

---------------------------------------------------------------------
fullTypeName :: Schema -> SchemaName
fullTypeName :: Schema -> SchemaName
fullTypeName Schema
r = Text -> SchemaName
SchemaName (Text -> SchemaName) -> Text -> SchemaName
forall a b. (a -> b) -> a -> b
$ Schema -> Text
typeName Schema
r

cachedSchema :: MonadIO m => SchemaRegistry -> SchemaId -> m (Maybe Schema)
cachedSchema :: SchemaRegistry -> SchemaId -> m (Maybe Schema)
cachedSchema SchemaRegistry
sr SchemaId
k = IO (Maybe Schema) -> m (Maybe Schema)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Schema) -> m (Maybe Schema))
-> IO (Maybe Schema) -> m (Maybe Schema)
forall a b. (a -> b) -> a -> b
$ Cache SchemaId Schema -> SchemaId -> IO (Maybe Schema)
forall k v. (Eq k, Hashable k) => Cache k v -> k -> IO (Maybe v)
C.lookup (SchemaRegistry -> Cache SchemaId Schema
srCache SchemaRegistry
sr) SchemaId
k
{-# INLINE cachedSchema #-}

cacheSchema :: MonadIO m => SchemaRegistry -> SchemaId -> Schema -> m ()
cacheSchema :: SchemaRegistry -> SchemaId -> Schema -> m ()
cacheSchema SchemaRegistry
sr SchemaId
k Schema
v = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cache SchemaId Schema -> SchemaId -> Schema -> IO ()
forall k v. (Eq k, Hashable k) => Cache k v -> k -> v -> IO ()
C.insert (SchemaRegistry -> Cache SchemaId Schema
srCache SchemaRegistry
sr) SchemaId
k Schema
v
{-# INLINE cacheSchema #-}

cachedId :: MonadIO m => SchemaRegistry -> Subject -> SchemaName -> m (Maybe SchemaId)
cachedId :: SchemaRegistry -> Subject -> SchemaName -> m (Maybe SchemaId)
cachedId SchemaRegistry
sr Subject
subj SchemaName
scn = IO (Maybe SchemaId) -> m (Maybe SchemaId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe SchemaId) -> m (Maybe SchemaId))
-> IO (Maybe SchemaId) -> m (Maybe SchemaId)
forall a b. (a -> b) -> a -> b
$ Cache (Subject, SchemaName) SchemaId
-> (Subject, SchemaName) -> IO (Maybe SchemaId)
forall k v. (Eq k, Hashable k) => Cache k v -> k -> IO (Maybe v)
C.lookup (SchemaRegistry -> Cache (Subject, SchemaName) SchemaId
srReverseCache SchemaRegistry
sr) (Subject
subj, SchemaName
scn)
{-# INLINE cachedId #-}

cacheId :: MonadIO m => SchemaRegistry -> Subject -> SchemaName -> SchemaId -> m ()
cacheId :: SchemaRegistry -> Subject -> SchemaName -> SchemaId -> m ()
cacheId SchemaRegistry
sr Subject
subj SchemaName
scn SchemaId
sid = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cache (Subject, SchemaName) SchemaId
-> (Subject, SchemaName) -> SchemaId -> IO ()
forall k v. (Eq k, Hashable k) => Cache k v -> k -> v -> IO ()
C.insert (SchemaRegistry -> Cache (Subject, SchemaName) SchemaId
srReverseCache SchemaRegistry
sr) (Subject
subj, SchemaName
scn) SchemaId
sid
{-# INLINE cacheId #-}

instance FromJSON RegisteredSchema where
  parseJSON :: Value -> Parser RegisteredSchema
parseJSON (Object Object
v) =
    String
-> (Object -> Parser RegisteredSchema)
-> Value
-> Parser RegisteredSchema
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"expected schema" (\Object
obj -> do
      Text
sch <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"schema"
      Parser RegisteredSchema
-> (Schema -> Parser RegisteredSchema)
-> Maybe Schema
-> Parser RegisteredSchema
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser RegisteredSchema
forall a. Monoid a => a
mempty (RegisteredSchema -> Parser RegisteredSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (RegisteredSchema -> Parser RegisteredSchema)
-> (Schema -> RegisteredSchema)
-> Schema
-> Parser RegisteredSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> RegisteredSchema
RegisteredSchema) (ByteString -> Maybe Schema
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe Schema) -> ByteString -> Maybe Schema
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
LText.encodeUtf8 Text
sch)
    ) (Object -> Value
Object Object
v)

  parseJSON Value
_ = Parser RegisteredSchema
forall a. Monoid a => a
mempty

instance ToJSON RegisteredSchema where
  toJSON :: RegisteredSchema -> Value
toJSON (RegisteredSchema Schema
v) = [Pair] -> Value
object [Key
"schema" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
LText.decodeUtf8 (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ Schema -> Value
forall a. ToJSON a => a -> Value
toJSON Schema
v)]

instance FromJSON SchemaId where
  parseJSON :: Value -> Parser SchemaId
parseJSON (Object Object
v) = Int32 -> SchemaId
SchemaId (Int32 -> SchemaId) -> Parser Int32 -> Parser SchemaId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Int32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
  parseJSON Value
_          = Parser SchemaId
forall a. Monoid a => a
mempty

instance FromJSON Compatibility where
  parseJSON :: Value -> Parser Compatibility
parseJSON = String
-> (Object -> Parser Compatibility)
-> Value
-> Parser Compatibility
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Compatibility" ((Object -> Parser Compatibility) -> Value -> Parser Compatibility)
-> (Object -> Parser Compatibility)
-> Value
-> Parser Compatibility
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Value
compatibility <- Object
v Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"compatibilityLevel"
    case Value
compatibility of
      Value
"NONE"     -> Compatibility -> Parser Compatibility
forall (m :: * -> *) a. Monad m => a -> m a
return (Compatibility -> Parser Compatibility)
-> Compatibility -> Parser Compatibility
forall a b. (a -> b) -> a -> b
$ Compatibility
NoCompatibility
      Value
"FULL"     -> Compatibility -> Parser Compatibility
forall (m :: * -> *) a. Monad m => a -> m a
return (Compatibility -> Parser Compatibility)
-> Compatibility -> Parser Compatibility
forall a b. (a -> b) -> a -> b
$ Compatibility
FullCompatibility
      Value
"FORWARD"  -> Compatibility -> Parser Compatibility
forall (m :: * -> *) a. Monad m => a -> m a
return (Compatibility -> Parser Compatibility)
-> Compatibility -> Parser Compatibility
forall a b. (a -> b) -> a -> b
$ Compatibility
ForwardCompatibility
      Value
"BACKWARD" -> Compatibility -> Parser Compatibility
forall (m :: * -> *) a. Monad m => a -> m a
return (Compatibility -> Parser Compatibility)
-> Compatibility -> Parser Compatibility
forall a b. (a -> b) -> a -> b
$ Compatibility
BackwardCompatibility
      Value
_          -> String -> Value -> Parser Compatibility
forall a. String -> Value -> Parser a
typeMismatch String
"Compatibility" Value
compatibility