summaryrefslogtreecommitdiff
path: root/src/Components/ObjectHandlers/ServerObjectValidator.hs
blob: 67b94e98f0659bed84efdd12435b77f9f98d47eb (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
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 _ [] _ _ = True  -- 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