module Components.ObjectHandlers.ServerObjectValidator (checkObjectsAttributes,replaceObjectsVariables) where
import Control.Exception (throw)
import Data.Foldable (foldr')
import Model.ServerObjectTypes (
ServerObject,
RootObject,
ScalarType(..),
Field,
InlinefragmentObject(..),
NestedObject(..)
)
import Model.ServerExceptions (
QueryException(
InvalidObjectException,
InvalidScalarException,
MismatchedVariableTypeException
)
)
import Components.ObjectHandlers.ObjectsHandler (
isValidServerObjectChild,
isValidServerObjectScalarField,
isValidScalarTransformation
)
checkObjectsAttributes :: [RootObject] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool
checkObjectsAttributes objs sss soa = foldr' (\x y-> (hasValidAttributes x sss soa)&&y) True objs
hasValidAttributes :: NestedObject -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool
hasValidAttributes (NestedObject alias name sobject Nothing sfs) sss soa = isValidSubFields sobject sfs sss soa
hasValidAttributes (NestedObject alias name sobject (Just ss) sfs) sss soa = (isValidSubSelection sobject ss sss soa)&&isValidSubFields sobject sfs sss soa
isValidSubSelection :: ServerObject -> ScalarType -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool
isValidSubSelection obj (ScalarType alias name trans arg) sss soa = (isValidServerObjectScalarField obj name sss soa)&&isValidScalarTransformation obj name trans arg sss soa
isValidSubFields :: ServerObject -> [Field] -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool
isValidSubFields _ [] _ _ = True
isValidSubFields obj sfs sss soa = foldr' (\x y-> (isValidSubField obj x sss soa)&&y) True sfs
isValidSubField :: ServerObject -> Field -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> Bool
isValidSubField obj (Left (ScalarType alias "__typename" trans arg)) sss soa = True
isValidSubField obj (Left (ScalarType alias name trans arg)) sss soa = (isValidServerObjectScalarField obj name sss soa)&&isValidScalarTransformation obj name trans arg sss soa
isValidSubField obj (Right (Left (NestedObject alias name sobject ss sfs))) sss soa = hasValidAttributes (NestedObject alias name sobject ss sfs) sss soa
isValidSubField obj (Right (Right (InlinefragmentObject ifo sfs))) sss soa = (isValidServerObjectChild obj ifo soa)&&isValidSubFields ifo sfs sss soa
replaceObjectsVariables :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> [RootObject] -> [(String,String,String)] -> [RootObject]
replaceObjectsVariables _ _ [] _ = []
replaceObjectsVariables sss soa objs vars = [replaceObjectVariables sss soa obj vars | obj<-objs]
replaceObjectVariables :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> RootObject -> [(String,String,String)] -> RootObject
replaceObjectVariables sss soa (NestedObject alias name sobject Nothing sfs) vars = NestedObject alias name sobject Nothing [replaceSubfieldVariables sss soa sobject vars sf | sf<-sfs]
replaceObjectVariables sss soa (NestedObject alias name sobject (Just (ScalarType sAlias sName trans Nothing)) sfs) vars = NestedObject alias name sobject (Just $ ScalarType sAlias sName trans Nothing) [replaceSubfieldVariables sss soa sobject vars sf | sf<-sfs]
replaceObjectVariables sss soa (NestedObject alias name sobject (Just (ScalarType sAlias sName trans (Just arg))) sfs) vars = NestedObject alias name sobject newScalar [replaceSubfieldVariables sss soa sobject vars sf | sf<-sfs]
where
newScalar = Just $ ScalarType sAlias sName trans $ Just newValue
newValue = if isVariable arg then replaceScalarVariable (getScalarTypeForVariableReplacement sobject sName sss soa) arg vars else arg
getScalarTypeForVariableReplacement :: ServerObject -> String -> [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> String
getScalarTypeForVariableReplacement obj st sss ((pnt,_,[]):rst) = if pnt==obj then throw InvalidObjectException else getScalarTypeForVariableReplacement obj st sss rst
getScalarTypeForVariableReplacement obj st sss ((pnt,_,(fst:_)):rst) = if pnt==obj then getScalarTypeForVariableReplacement fst st sss [] else getScalarTypeForVariableReplacement obj st sss rst
getScalarTypeForVariableReplacement _ _ [] _ = throw InvalidObjectException
getScalarTypeForVariableReplacement obj st ((h,sts):rst) _
| h==obj = findScalarType st sts
| otherwise = getScalarTypeForVariableReplacement obj st rst []
findScalarType :: String -> [(String,String,[(String,[(String,String,String,String)])])] -> String
findScalarType _ [] = throw InvalidScalarException
findScalarType st ((name,typ,_):rst)
| st==name = typ
| otherwise = findScalarType st rst
replaceScalarVariable :: String -> String -> [(String,String,String)] -> String
replaceScalarVariable _ _ [] = throw InvalidScalarException
replaceScalarVariable typ arg ((vn,vt,vval):rst)
| arg==vn&&typ==vt = vval
| arg==vn = throw MismatchedVariableTypeException
| otherwise = replaceScalarVariable typ arg rst
replaceSubfieldVariables :: [(String,[(String,String,[(String,[(String,String,String,String)])])])] -> [(String,[String],[String])] -> String -> [(String,String,String)] -> Field -> Field
replaceSubfieldVariables _ _ _ _ (Left (ScalarType alias name trans Nothing)) = Left $ ScalarType alias name trans Nothing
replaceSubfieldVariables sss soa sobj vars (Left (ScalarType alias name trans (Just arg)))
| (isVariable arg)==False = Left $ ScalarType alias name trans $ Just arg
| otherwise = Left $ ScalarType alias name trans $ Just $ replaceScalarVariable (getScalarTypeForVariableReplacement sobj name sss soa) arg vars
replaceSubfieldVariables sss soa sobj vars (Right (Left (NestedObject alias name nsobj Nothing sfs))) = Right $ Left $ NestedObject alias name nsobj Nothing [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs]
replaceSubfieldVariables sss soa sobj vars (Right (Left (NestedObject alias name nsobj (Just (ScalarType sAlias sName trans Nothing)) sfs))) = Right $ Left $ NestedObject alias name nsobj (Just $ ScalarType sAlias sName trans Nothing) [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs]
replaceSubfieldVariables sss soa sobj vars (Right (Left (NestedObject alias name nsobj (Just (ScalarType sAlias sName trans (Just arg))) sfs)))
| (isVariable arg)==False = Right $ Left $ NestedObject alias name nsobj (Just $ ScalarType sAlias sName trans $ Just arg) [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs]
| otherwise = Right $ Left $ NestedObject alias name nsobj (Just $ ScalarType sAlias sName trans $ Just $ replaceScalarVariable (getScalarTypeForVariableReplacement nsobj name sss soa) arg vars) [replaceSubfieldVariables sss soa nsobj vars sf | sf<-sfs]
replaceSubfieldVariables sss soa sobj vars (Right (Right (InlinefragmentObject ifsobj sfs))) = Right $ Right $ InlinefragmentObject ifsobj [replaceSubfieldVariables sss soa ifsobj vars sf | sf<-sfs]
isVariable :: String -> Bool
isVariable = elem '$'