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 ) -- check that all nested objects are with valid properties 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 -- we should not get an empty query 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 -- replace variables with values and do type checking -- ASSUME: variables are prefixed with $ 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] -- TODO -- check parent object subselection -- finish no dups in parse schema -- change all left/right pattern match to also pattern match inside 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 -- findScalars :: [(String,[(String,String,[(String,[(String,String,String)])])])] -> [(String,[String],[String])] -> String -> [(String,String,[(String,[(String,String,String)])])] -- findScalars [] _ _ = throw InvalidObjectException -- findScalars sss ((pnt,_,cld):t) sobj = if sobj==pnt then foldl' (\y x->) [] cld else findScalars sss t sobj -- findScalars ((name,sclrs):t) [] sobj = if sobj==name then sclrs else findScalars t [] sobj 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 -- findScalarType :: [(String,String,[(String,[(String,String,String)])])] -> String -> String -- findScalarType [] _ = throw InvalidObjectScalarFieldException -- findScalarType ((name,typ,_):t) sname = if sname==name then typ else findScalarType t sname -- findReplacement :: String -> String -> [(String,String,String)] -> String -- findReplacement styp arg [] = throw InvalidVariableNameException -- findReplacement styp arg ((name,typ,val):t) -- | (name==arg)&&(typ==styp) = val -- | (name==arg) = throw MismatchedVariableTypeException -- | otherwise = findReplacement styp arg t 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 '$'