module Components.ObjectHandlers.ServerObjectValidator (checkObjectsAttributes,replaceObjectsVariables) where import Model.ServerObjectTypes ( ServerObject, RootObject, ScalarType(..), SubSelection, Field, FieldObject, InlinefragmentObject(..), NestedObject(..) ) import Model.ServerExceptions ( QueryException( InvalidObjectException, InvalidVariableNameException, InvalidObjectScalarFieldException, MismatchedVariableTypeException ) ) import Components.ObjectHandlers.ObjectsHandler ( getObjectName, getInlinefragmentFields, getInlinefragmentObject, isValidServerObjectChild, isValidServerObjectNestedObjectField, getScalarName, isValidServerObjectScalarField ) import Control.Exception (throw) import Data.Maybe (fromJust,Maybe(Just,Nothing)) import Data.Either (Either(Right,Left)) -- check that all nested objects are with valid properties checkObjectsAttributes :: [RootObject] -> [(String,[(String,String)])] -> [(String,[String])] -> [(String,[String],[String])] -> Bool checkObjectsAttributes objs sss sos soa = foldr (\x y -> (hasValidAttributes x sss sos soa)&&y) True objs hasValidAttributes :: NestedObject -> [(String,[(String,String)])] -> [(String,[String])] -> [(String,[String],[String])] -> Bool hasValidAttributes (NestedObject alias name sobject ss sfs) sss sos soa = (if ss==Nothing then True else isValidSubSelection sobject (fromJust ss) sss soa)&&(isValidSubFields sobject sfs sss sos soa) isValidSubSelection :: ServerObject -> ScalarType -> [(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) isValidSubFields :: ServerObject -> [Field] -> [(String,[(String,String)])] -> [(String,[String])] -> [(String,[String],[String])] -> Bool isValidSubFields _ [] _ _ _ = True -- we should not get an empty query isValidSubFields obj sfs sss sos soa = foldr (\x y -> (isValidSubField obj x sss sos soa)&&y) True sfs isValidSubField :: ServerObject -> Field -> [(String,[(String,String)])]-> [(String,[String])] -> [(String,[String],[String])] -> Bool isValidSubField obj (Left sf) sss sos soa = (isValidServerObjectScalarField obj (getScalarName sf) sss soa) -- &&(isValidScalarTransformation obj sname trans arg) isValidSubField obj (Right (Left no)) sss sos soa = (isValidServerObjectNestedObjectField obj (getObjectName no) sos soa)&&(hasValidAttributes no sss sos soa) isValidSubField obj (Right (Right ifo)) sss sos soa = (isValidServerObjectChild obj soj soa)&&(isValidSubFields soj (getInlinefragmentFields ifo) sss sos soa) where soj = getInlinefragmentObject ifo -- replace variables with values and do type checking -- ASSUME: variables are prefixed with $ replaceObjectsVariables :: [(String,[(String,String)])] -> [RootObject] -> [(String,String,String)] -> [RootObject] replaceObjectsVariables _ [] _ = [] replaceObjectsVariables sss objs vars = [replaceObjectVariables sss obj vars | obj<-objs] replaceObjectVariables :: [(String,[(String,String)])] -> RootObject -> [(String,String,String)] -> RootObject replaceObjectVariables sss (NestedObject alias name sobject ss sfs) vars = NestedObject alias name sobject (if ss/=Nothing then (replaceScalarVariable (findScalars sss sobject) vars $ fromJust ss) else Nothing) [replaceSubfieldVariables sss sobject vars sf | sf<-sfs] findScalars :: [(String,[(String,String)])] -> String -> [(String,String)] findScalars [] _ = throw InvalidObjectException findScalars ((name,sclrs):t) sobj = if (sobj==name) then sclrs else (findScalars t sobj) replaceScalarVariable :: [(String,String)] -> [(String,String,String)] -> ScalarType -> SubSelection replaceScalarVariable sclrs vars (ScalarType alias name trans arg) = if (isValue arg)&&(elem '$' $ getValue arg) then (Just $ ScalarType alias name trans (Just $ findReplacement (findScalarType sclrs name) (getValue arg) vars)) else (Just $ ScalarType alias name trans arg) findScalarType :: [(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)] -> Field -> Field replaceSubfieldVariables sss sobj vars (Left (ScalarType alias name trans arg)) = if (isValue arg)&&(elem '$' $ getValue arg) then (Left (ScalarType alias name trans (Just $ findReplacement (findScalarType (findScalars sss sobj) name) (getValue arg) vars)) :: Field) else (Left (ScalarType alias name trans arg) :: Field) replaceSubfieldVariables sss sobj vars (Right (Left (NestedObject alias name nsobj ss sfs))) = (Right (Left $ NestedObject alias name nsobj (if ss/=Nothing then (replaceScalarVariable (findScalars sss nsobj) vars $ fromJust ss) else Nothing) [replaceSubfieldVariables sss nsobj vars sf | sf<-sfs] :: FieldObject) :: Field) replaceSubfieldVariables sss sobj vars (Right (Right (InlinefragmentObject ifsobj sfs))) = (Right (Right $ InlinefragmentObject ifsobj [replaceSubfieldVariables sss ifsobj vars sf | sf<-sfs] :: FieldObject) :: Field) isValue :: Maybe String -> Bool isValue Nothing = False isValue _ = True getValue :: Maybe String -> String getValue arg = fromJust arg