module Components.ObjectHandlers.ServerObjectValidator (checkObjectsAttributes,replaceObjectsVariables) where import qualified Control.Exception as E import Data.Maybe import Data.Either import Model.ServerObjectTypes import Model.ServerExceptions import Components.ObjectHandlers.ObjectsHandler -- check that all nested objects are with valid properties checkObjectsAttributes :: [RootObject] -> [(String,[(String,String)])] -> [(String,[String])] -> Bool checkObjectsAttributes objs sss sos = foldr (\x y -> (hasValidAttributes x sss sos)&&y) True objs hasValidAttributes :: NestedObject -> [(String,[(String,String)])] -> [(String,[String])] -> Bool hasValidAttributes (NestedObject alias name sobject ss sfs) sss sos = (if ss==Nothing then True else isValidSubSelection sobject (fromJust ss) sss)&&(isValidSubFields sobject sfs sss sos) isValidSubSelection :: ServerObject -> ScalarType -> [(String,[(String,String)])] -> Bool isValidSubSelection obj (ScalarType alias name trans arg) sss = (isValidServerObjectScalarField obj name sss) -- &&(isValidScalarTransformation obj name trans arg) isValidSubFields :: ServerObject -> [Field] -> [(String,[(String,String)])] -> [(String,[String])] -> Bool isValidSubFields _ [] _ _ = False -- we should not get an empty query isValidSubFields obj sfs sss sos = foldr (\x y -> (isValidSubField obj x sss sos)&&y) True sfs isValidSubField :: ServerObject -> Field -> [(String,[(String,String)])]-> [(String,[String])] -> Bool isValidSubField obj (Left sf) sss sos = (isValidServerObjectScalarField obj sname sss) -- &&(isValidScalarTransformation obj sname trans arg) where sname = getScalarName sf isValidSubField obj sf sss sos = (isValidServerObjectNestedObjectField obj ofname sos)&&(hasValidAttributes nestedObjectField sss sos) where nestedObjectField = fromRight (E.throw InvalidObjectException) sf ofname = getObjectName nestedObjectField -- 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 [] _ = E.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 [] _ = E.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 [] = E.throw InvalidVariableNameException findReplacement styp arg ((name,typ,val):t) | (name==arg)&&(typ==styp) = val | (name==arg) = E.throw MismatchedVariableTypeException | otherwise = findReplacement styp arg t replaceSubfieldVariables :: [(String,[(String,String)])] -> String -> [(String,String,String)] -> Field -> Field replaceSubfieldVariables sss sobj vars (Right (NestedObject alias name nsobj ss sfs)) = (Right $ NestedObject alias name nsobj (if ss/=Nothing then (replaceScalarVariable (findScalars sss nsobj) vars $ fromJust ss) else Nothing) [replaceSubfieldVariables sss nsobj vars sf | sf<-sfs]) :: 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) isValue :: Maybe String -> Bool isValue Nothing = False isValue _ = True getValue :: Maybe String -> String getValue arg = fromJust arg