{-# language DataKinds        #-}
{-# language DeriveAnyClass   #-}
{-# language DeriveGeneric    #-}
{-# language TypeApplications #-}
{-# language TypeOperators    #-}
{-# language ViewPatterns     #-}
{-|
Description : Client for the Compendium schema registry

Client for the Compendium schema registry
-}
module Compendium.Client (
-- * Generic query of schemas
  IdlName
, transformation
-- * Query Protocol Buffer schemas
, obtainProtoBuf
, ObtainProtoBufError(..)
) where

import           Data.Aeson
import           Data.Char
import           Data.Proxy
import           Data.Text
import           Language.ProtocolBuffers.Parser
import           Language.ProtocolBuffers.Types
import           Network.HTTP.Client             (Manager)
import           Servant.API
import           Servant.Client
import           Text.Megaparsec

import           GHC.Generics

newtype Protocol
  = Protocol { Protocol -> Text
raw :: Text }
  deriving (Protocol -> Protocol -> Bool
(Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool) -> Eq Protocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Protocol -> Protocol -> Bool
$c/= :: Protocol -> Protocol -> Bool
== :: Protocol -> Protocol -> Bool
$c== :: Protocol -> Protocol -> Bool
Eq, Int -> Protocol -> ShowS
[Protocol] -> ShowS
Protocol -> String
(Int -> Protocol -> ShowS)
-> (Protocol -> String) -> ([Protocol] -> ShowS) -> Show Protocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Protocol] -> ShowS
$cshowList :: [Protocol] -> ShowS
show :: Protocol -> String
$cshow :: Protocol -> String
showsPrec :: Int -> Protocol -> ShowS
$cshowsPrec :: Int -> Protocol -> ShowS
Show, (forall x. Protocol -> Rep Protocol x)
-> (forall x. Rep Protocol x -> Protocol) -> Generic Protocol
forall x. Rep Protocol x -> Protocol
forall x. Protocol -> Rep Protocol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Protocol x -> Protocol
$cfrom :: forall x. Protocol -> Rep Protocol x
Generic, Value -> Parser [Protocol]
Value -> Parser Protocol
(Value -> Parser Protocol)
-> (Value -> Parser [Protocol]) -> FromJSON Protocol
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Protocol]
$cparseJSONList :: Value -> Parser [Protocol]
parseJSON :: Value -> Parser Protocol
$cparseJSON :: Value -> Parser Protocol
FromJSON)

-- | Interface Description Languages supported by Compendium.
data IdlName
  = Avro | Protobuf | Mu | OpenApi | Scala
  deriving (IdlName -> IdlName -> Bool
(IdlName -> IdlName -> Bool)
-> (IdlName -> IdlName -> Bool) -> Eq IdlName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdlName -> IdlName -> Bool
$c/= :: IdlName -> IdlName -> Bool
== :: IdlName -> IdlName -> Bool
$c== :: IdlName -> IdlName -> Bool
Eq, Int -> IdlName -> ShowS
[IdlName] -> ShowS
IdlName -> String
(Int -> IdlName -> ShowS)
-> (IdlName -> String) -> ([IdlName] -> ShowS) -> Show IdlName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdlName] -> ShowS
$cshowList :: [IdlName] -> ShowS
show :: IdlName -> String
$cshow :: IdlName -> String
showsPrec :: Int -> IdlName -> ShowS
$cshowsPrec :: Int -> IdlName -> ShowS
Show, (forall x. IdlName -> Rep IdlName x)
-> (forall x. Rep IdlName x -> IdlName) -> Generic IdlName
forall x. Rep IdlName x -> IdlName
forall x. IdlName -> Rep IdlName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdlName x -> IdlName
$cfrom :: forall x. IdlName -> Rep IdlName x
Generic)
instance ToHttpApiData IdlName where
  toQueryParam :: IdlName -> Text
toQueryParam (IdlName -> String
forall a. Show a => a -> String
show -> Char
x:String
xs)
    = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char -> Char
Data.Char.toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
  toQueryParam IdlName
_ = String -> Text
forall a. HasCallStack => String -> a
error String
"this should never happen"

type TransformationAPI
  = "protocol" :> Capture "id" Text
               :> "transformation"
               :> QueryParam' '[ Required ] "target" IdlName
               :> Get '[JSON] Protocol

-- | Obtain a schema from the registry.
transformation :: Manager  -- ^ Connection details (from 'http-client').
               -> BaseUrl  -- ^ URL in which Compendium is running.
               -> Text     -- ^ Name that identifies the schema.
               -> IdlName  -- ^ Format of the returned schema.
               -> IO (Either ClientError Text)
transformation :: Manager
-> BaseUrl -> Text -> IdlName -> IO (Either ClientError Text)
transformation Manager
m BaseUrl
url Text
ident IdlName
idl
  = ClientM Text -> ClientEnv -> IO (Either ClientError Text)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (Text -> IdlName -> ClientM Text
transformation' Text
ident IdlName
idl) (Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
m BaseUrl
url)

transformation' :: Text
                -> IdlName
                -> ClientM Text
transformation' :: Text -> IdlName -> ClientM Text
transformation' Text
ident IdlName
idl
  = Protocol -> Text
raw (Protocol -> Text) -> ClientM Protocol -> ClientM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy TransformationAPI -> Text -> IdlName -> ClientM Protocol
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy TransformationAPI
forall k (t :: k). Proxy t
Proxy @TransformationAPI) Text
ident IdlName
idl

-- | Errors which may arise during 'obtainProtoBuf'.
data ObtainProtoBufError
  = OPEClient ClientError  -- ^ Error obtaining schema from Compendium
  | OPEParse  (ParseErrorBundle Text Char)  -- ^ Obtaining the schema was OK, error parsing it
  deriving (Int -> ObtainProtoBufError -> ShowS
[ObtainProtoBufError] -> ShowS
ObtainProtoBufError -> String
(Int -> ObtainProtoBufError -> ShowS)
-> (ObtainProtoBufError -> String)
-> ([ObtainProtoBufError] -> ShowS)
-> Show ObtainProtoBufError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObtainProtoBufError] -> ShowS
$cshowList :: [ObtainProtoBufError] -> ShowS
show :: ObtainProtoBufError -> String
$cshow :: ObtainProtoBufError -> String
showsPrec :: Int -> ObtainProtoBufError -> ShowS
$cshowsPrec :: Int -> ObtainProtoBufError -> ShowS
Show)

-- | Obtain a schema from the registry,
--   and parse it as Protocol Buffers.
obtainProtoBuf :: Manager -> BaseUrl
               -> Text -> IO (Either ObtainProtoBufError ProtoBuf)
obtainProtoBuf :: Manager
-> BaseUrl -> Text -> IO (Either ObtainProtoBufError ProtoBuf)
obtainProtoBuf Manager
m BaseUrl
url Text
ident = do
  Either ClientError Text
r <- Manager
-> BaseUrl -> Text -> IdlName -> IO (Either ClientError Text)
transformation Manager
m BaseUrl
url Text
ident IdlName
Protobuf
  case Either ClientError Text
r of
    Left ClientError
e
      -> Either ObtainProtoBufError ProtoBuf
-> IO (Either ObtainProtoBufError ProtoBuf)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ObtainProtoBufError ProtoBuf
 -> IO (Either ObtainProtoBufError ProtoBuf))
-> Either ObtainProtoBufError ProtoBuf
-> IO (Either ObtainProtoBufError ProtoBuf)
forall a b. (a -> b) -> a -> b
$ ObtainProtoBufError -> Either ObtainProtoBufError ProtoBuf
forall a b. a -> Either a b
Left (ClientError -> ObtainProtoBufError
OPEClient ClientError
e)
    Right Text
p
      -> case Text -> Either (ParseErrorBundle Text Char) ProtoBuf
parseProtoBuf Text
p of
          Left ParseErrorBundle Text Char
e   -> Either ObtainProtoBufError ProtoBuf
-> IO (Either ObtainProtoBufError ProtoBuf)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ObtainProtoBufError ProtoBuf
 -> IO (Either ObtainProtoBufError ProtoBuf))
-> Either ObtainProtoBufError ProtoBuf
-> IO (Either ObtainProtoBufError ProtoBuf)
forall a b. (a -> b) -> a -> b
$ ObtainProtoBufError -> Either ObtainProtoBufError ProtoBuf
forall a b. a -> Either a b
Left (ParseErrorBundle Text Char -> ObtainProtoBufError
OPEParse ParseErrorBundle Text Char
e)
          Right ProtoBuf
pb -> Either ObtainProtoBufError ProtoBuf
-> IO (Either ObtainProtoBufError ProtoBuf)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ObtainProtoBufError ProtoBuf
 -> IO (Either ObtainProtoBufError ProtoBuf))
-> Either ObtainProtoBufError ProtoBuf
-> IO (Either ObtainProtoBufError ProtoBuf)
forall a b. (a -> b) -> a -> b
$ ProtoBuf -> Either ObtainProtoBufError ProtoBuf
forall a b. b -> Either a b
Right ProtoBuf
pb