module Fluid.Endpoint
( runFluid
, runFluidSingleton
) where
import qualified Data.Map as Map
import qualified Data.HashMap.Lazy as HML
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Except
import Control.Concurrent.Async.Lifted ()
import Data.Aeson
import Data.Aeson.Types (parseMaybe)
import Data.Text (Text)
import Data.Map (Map)
import Fluid.Types
import Fluid.Server.Exchange
import Fluid.RuntimeThrower
runFluidSingleton
:: MonadIO m
=> Version
-> (Request -> m (Either Response Response))
-> Value
-> m Value
runFluidSingleton Version{major,minor} handleRequest = runFluid (Map.singleton major (minor, handleRequest))
runFluid
:: MonadIO m
=> Map Major (Minor, Request -> m (Either Response Response))
-> Value
-> m Value
runFluid handleRequestMap v = do
e <- runExceptT $ do
fluidVersion <- getFluidVersion v
assertFluidVersionCompatiability fluidVersion
apiVersion <- getApiVersion v
let apiMajor = major apiVersion
case Map.lookup apiMajor handleRequestMap of
Nothing -> case leastAndGreatest (Map.keys handleRequestMap) of
Nothing -> runtimeThrow RuntimeError'NoImplementation
Just (minMajor, maxMajor) ->
if minMajor > apiMajor
then runtimeThrow RuntimeError'ApiMajorVersionTooLow
else if maxMajor < apiMajor
then runtimeThrow RuntimeError'ApiMajorVersionTooHigh
else runtimeThrow RuntimeError'NoImplementation
Just (maxMinor, handleRequest) -> if minor apiVersion > maxMinor
then runtimeThrow RuntimeError'ApiMinorVersionTooHigh
else case parseRequest v of
Nothing -> runtimeThrow RuntimeError'UnparsableFormat
Just req -> toJSON <$> ExceptT (handleRequest req)
return $ either toJSON id e
leastAndGreatest :: Ord a => [a] -> Maybe (a,a)
leastAndGreatest [] = Nothing
leastAndGreatest xs = Just (minimum xs, maximum xs)
assertFluidVersionCompatiability :: RuntimeThrower m => Version -> m ()
assertFluidVersionCompatiability Version{major,minor}
| major > mustMajor = runtimeThrow RuntimeError'FluidMajorVersionTooHigh
| major < mustMajor = runtimeThrow RuntimeError'FluidMajorVersionTooLow
| minor > maxMinor = runtimeThrow RuntimeError'FluidMinorVersionTooHigh
| otherwise = return ()
where
mustMajor = 0
maxMinor = 0
getApiVersion :: RuntimeThrower m => Value -> m Version
getApiVersion = getVersion "version" RuntimeError'NoApiVersion
getFluidVersion :: RuntimeThrower m => Value -> m Version
getFluidVersion = getVersion "fluid" RuntimeError'NoFluidVersion
getVersion :: RuntimeThrower m => Text -> RuntimeError -> Value -> m Version
getVersion name err (Object o) = case HML.lookup name o of
Just x -> maybe (runtimeThrow err) return (parseMaybe parseJSON x)
Nothing -> runtimeThrow err
getVersion _ err _ = runtimeThrow err
parseRequest :: Value -> Maybe Request
parseRequest = parseMaybe parseJSON