dhscanner-kbgen 1.0.35 → 1.0.36

raw patch · 4 files changed

+162/−84 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• dhscanner-kbgen.cabal +1/−1
• src/Kbgen.hs +78/−0
• test/SmokeTests.hs +48/−48
• test/Test.hs +35/−35

@@ -33,7 +33,7 @@         * explain in plain English your query's purpose
         * et voilà !
 
-version:            1.0.35
+version:            1.0.36
 license:            GPL-3.0-only
 license-file:       LICENSE
 author:             OrenGitHub

@@ -90,6 +90,7 @@     MethodName(..),
     ResolvedType(..),
     CallResolved(..),
+    CalledFrom(..),
     AssignedValue(..),
     ResolvedSuper(..),
     FuncDefinedInDir(..),
@@ -770,7 +771,76 @@     Resolved -- ^
     deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON )
 
+-- |
+--
+-- __Name__
+--
+-- This is how the fact will look inside the Prolog file
+--
+-- @
+-- kb_called_from( Call, Callable ).
+-- @
+--
+-- __When should I use this fact__
+--
+-- Web-app request handlers routinely /extract fields/ from the incoming
+-- request \- headers, cookies, query parameters, body \- and the /name/
+-- of the field is often the security-relevant piece ( e.g. the constant
+-- string \'x-api-key\' says "this callable does API-key authentication" ).
+-- To reason about /which/ callable extracts /which/ field, you need to
+-- know that a particular call site lives inside the body of a particular
+-- callable.
+--
+-- No pre-existing fact tied a 'Call' back to its enclosing 'Callable' \-
+-- 'ParamiOfCallable' does the analogous thing for /parameters/ only.
+-- Because 'CalledFrom' exposes the 'Call' /location/ ( not just its FQN ),
+-- it composes with 'ArgiForCall' and 'ConstString' to also surface the
+-- /arguments/ passed at that specific call site.
+--
+-- Code snippet ( Typescript, Next.js \- formbricks at v3.16.0 ):
+--
+-- @
+-- export const authenticateRequest = async (request: Request) => {
+--     const apiKey = request.headers.get(\"x-api-key\");
+--     if (!apiKey) return null;
+--     const apiKeyData = await getApiKeyWithPermissions(apiKey);
+--     ...
+-- };
+-- @
+--
+-- See complete source example [here](https://github.com/formbricks/formbricks/blob/v3.16.0/apps/web/app/api/v1/auth.ts#L7-L36)
+--
+-- __Writing a predicate with this fact and others__
+--
+-- Compose 'CalledFrom' with 'ArgiForCall' and 'ConstString' to enumerate
+-- the constant-string header names each callable extracts from the
+-- incoming request:
+--
+-- @
+-- extracts_request_header_named( Callable, HeaderName ) :-
+--     kb_called_from( Call, Callable ),
+--     kb_call_resolved( Call, \'Request.headers.get\' ),
+--     kb_arg_i_for_call( HeaderConst, 0, Call ),
+--     kb_const_string( HeaderConst, HeaderName ).
+-- @
+--
+-- Applied to @authenticateRequest@ above, this yields
+-- @extracts_request_header_named( authenticateRequest, \'x-api-key\' )@ \-
+-- one of the six structural indicators for recognizing Shape-A
+-- ( identity-carrier ) request authenticators.
+--
+-- Other facts combined in this predicate:
+--
+--     * 'CallResolved'
+--     * 'ArgiForCall'
+--     * 'ConstString'
+--
+data CalledFrom = CalledFrom
+    Call -- ^
+    Callable -- ^
+    deriving ( Show, Eq, Ord, Generic, ToJSON, FromJSON )
 
+
 -- |
 --
 -- Usage:
@@ -852,6 +922,7 @@    | ConstStringCtor ConstString
    | DataflowEdgeCtor DataflowEdge
    | CallResolvedCtor CallResolved
+   | CalledFromCtor CalledFrom
    | ConstBoolTrueCtor ConstBoolTrue
    | MethodOfClassCtor MethodOfClass
    | ClassAnnotationCtor ClassAnnotation
@@ -885,6 +956,7 @@ prologify (ConstStringCtor content) = prologify_ConstString content
 prologify (DataflowEdgeCtor content) = prologify_DataflowEdge content
 prologify (CallResolvedCtor content) = prologify_CallResolved content
+prologify (CalledFromCtor content) = prologify_CalledFrom content
 prologify (ConstBoolTrueCtor content) = prologify_ConstBoolTrue content
 prologify (MethodOfClassCtor content) = prologify_MethodOfClass content
 prologify (ClassAnnotationCtor content) = prologify_ClassAnnotation content
@@ -1044,6 +1116,12 @@ 
 prologify_ParamiOfCallable :: ParamiOfCallable -> String
 prologify_ParamiOfCallable (ParamiOfCallable (Param p) (ParamIndex i) (Callable c)) = prologify_ParamiOfCallable' p i c
+
+prologify_CalledFrom' :: Location -> Location -> String
+prologify_CalledFrom' call callable = printf "kb_called_from( %s, %s )." (locationify call) (locationify callable)
+
+prologify_CalledFrom :: CalledFrom -> String
+prologify_CalledFrom (CalledFrom (Call call) (Callable callable)) = prologify_CalledFrom' call callable
 
 normalizeChar :: Char -> String
 normalizeChar '/' = "_slash_"

@@ -1,48 +1,48 @@-module SmokeTests (runSmokeTests) where--import Kbgen (restoreloc)-import Test.Hspec (Spec, hspec, it, shouldBe)--it' :: IO () -> String -> Spec-it' testBody label = it label testBody--completelyInvalidLocationString :: String-completelyInvalidLocationString = "Blahhh"--testCompletelyInvalidLocationString :: IO ()-testCompletelyInvalidLocationString = restoreloc completelyInvalidLocationString `shouldBe` Nothing--locationStringWithoutProperPrefix :: String-locationStringWithoutProperPrefix = "____startloc_1_2_endloc_3_4_foo_dot_c"--testLocationStringWithoutProperPrefix :: IO ()-testLocationStringWithoutProperPrefix = restoreloc locationStringWithoutProperPrefix `shouldBe` Nothing--locationStringWithoutProperFormatExample1 :: String-locationStringWithoutProperFormatExample1 = "startloc_1_2_end_3_4_foo_dot_c"--testLocationStringWithoutProperFormatExample1 :: IO ()-testLocationStringWithoutProperFormatExample1 = restoreloc locationStringWithoutProperFormatExample1 `shouldBe` Nothing--locationStringWithoutProperFormatExample2 :: String-locationStringWithoutProperFormatExample2 = "startloc_1_2_endloc____3_4_foo_dot_c"--testLocationStringWithoutProperFormatExample2 :: IO ()-testLocationStringWithoutProperFormatExample2 = restoreloc locationStringWithoutProperFormatExample2 `shouldBe` Nothing--locationStringWithoutProperFormatExample3 :: String-locationStringWithoutProperFormatExample3 = "startloc_1_2_endloc_3______4_foo_dot_c"--testLocationStringWithoutProperFormatExample3 :: IO ()-testLocationStringWithoutProperFormatExample3 = restoreloc locationStringWithoutProperFormatExample3 `shouldBe` Nothing--tests :: Spec-tests = do-    it' testCompletelyInvalidLocationString "completelyInvalidLocationString should return Nothing"-    it' testLocationStringWithoutProperPrefix "locationStringWithoutProperPrefix should return Nothing"-    it' testLocationStringWithoutProperFormatExample1 "locationStringWithoutProperFormatExample1 should return Nothing"-    it' testLocationStringWithoutProperFormatExample2 "locationStringWithoutProperFormatExample2 should return Nothing"-    it' testLocationStringWithoutProperFormatExample3 "locationStringWithoutProperFormatExample3 should return Nothing"--runSmokeTests :: IO ()-runSmokeTests = hspec tests+module SmokeTests (runSmokeTests) where
+
+import Kbgen (restoreloc)
+import Test.Hspec (Spec, hspec, it, shouldBe)
+
+it' :: IO () -> String -> Spec
+it' testBody label = it label testBody
+
+completelyInvalidLocationString :: String
+completelyInvalidLocationString = "Blahhh"
+
+testCompletelyInvalidLocationString :: IO ()
+testCompletelyInvalidLocationString = restoreloc completelyInvalidLocationString `shouldBe` Nothing
+
+locationStringWithoutProperPrefix :: String
+locationStringWithoutProperPrefix = "____startloc_1_2_endloc_3_4_foo_dot_c"
+
+testLocationStringWithoutProperPrefix :: IO ()
+testLocationStringWithoutProperPrefix = restoreloc locationStringWithoutProperPrefix `shouldBe` Nothing
+
+locationStringWithoutProperFormatExample1 :: String
+locationStringWithoutProperFormatExample1 = "startloc_1_2_end_3_4_foo_dot_c"
+
+testLocationStringWithoutProperFormatExample1 :: IO ()
+testLocationStringWithoutProperFormatExample1 = restoreloc locationStringWithoutProperFormatExample1 `shouldBe` Nothing
+
+locationStringWithoutProperFormatExample2 :: String
+locationStringWithoutProperFormatExample2 = "startloc_1_2_endloc____3_4_foo_dot_c"
+
+testLocationStringWithoutProperFormatExample2 :: IO ()
+testLocationStringWithoutProperFormatExample2 = restoreloc locationStringWithoutProperFormatExample2 `shouldBe` Nothing
+
+locationStringWithoutProperFormatExample3 :: String
+locationStringWithoutProperFormatExample3 = "startloc_1_2_endloc_3______4_foo_dot_c"
+
+testLocationStringWithoutProperFormatExample3 :: IO ()
+testLocationStringWithoutProperFormatExample3 = restoreloc locationStringWithoutProperFormatExample3 `shouldBe` Nothing
+
+tests :: Spec
+tests = do
+    it' testCompletelyInvalidLocationString "completelyInvalidLocationString should return Nothing"
+    it' testLocationStringWithoutProperPrefix "locationStringWithoutProperPrefix should return Nothing"
+    it' testLocationStringWithoutProperFormatExample1 "locationStringWithoutProperFormatExample1 should return Nothing"
+    it' testLocationStringWithoutProperFormatExample2 "locationStringWithoutProperFormatExample2 should return Nothing"
+    it' testLocationStringWithoutProperFormatExample3 "locationStringWithoutProperFormatExample3 should return Nothing"
+
+runSmokeTests :: IO ()
+runSmokeTests = hspec tests

@@ -1,35 +1,35 @@-module Main (main) where--import Kbgen (locationify, restoreloc)-import Location (Location (..))-import SmokeTests (runSmokeTests)-import Test.QuickCheck (Arbitrary (arbitrary), Gen, Property, forAll, quickCheck, suchThat)--genLocation :: Gen Location-genLocation = do-    arbitraryLineStart <- arbitrary-    arbitraryLineEnd <- arbitrary `suchThat` (>= arbitraryLineStart)-    arbitraryColStart <- arbitrary-    arbitraryColEnd <- arbitrary-    arbitraryFilename <- arbitrary-    pure-        Location-            { lineStart = arbitraryLineStart-            , colStart = arbitraryColStart-            , lineEnd = arbitraryLineEnd-            , colEnd = arbitraryColEnd-            , filename = arbitraryFilename-            }--prop_restoreloc_locationify_roundtrip :: Property-prop_restoreloc_locationify_roundtrip =-    forAll genLocation prop_restoreloc_locationify_roundtrip_for--prop_restoreloc_locationify_roundtrip_for :: Location -> Bool-prop_restoreloc_locationify_roundtrip_for loc =-    restoreloc (locationify loc) == Just loc--main :: IO ()-main = do-    runSmokeTests-    quickCheck prop_restoreloc_locationify_roundtrip+module Main (main) where
+
+import Kbgen (locationify, restoreloc)
+import Location (Location (..))
+import SmokeTests (runSmokeTests)
+import Test.QuickCheck (Arbitrary (arbitrary), Gen, Property, forAll, quickCheck, suchThat)
+
+genLocation :: Gen Location
+genLocation = do
+    arbitraryLineStart <- arbitrary
+    arbitraryLineEnd <- arbitrary `suchThat` (>= arbitraryLineStart)
+    arbitraryColStart <- arbitrary
+    arbitraryColEnd <- arbitrary
+    arbitraryFilename <- arbitrary
+    pure
+        Location
+            { lineStart = arbitraryLineStart
+            , colStart = arbitraryColStart
+            , lineEnd = arbitraryLineEnd
+            , colEnd = arbitraryColEnd
+            , filename = arbitraryFilename
+            }
+
+prop_restoreloc_locationify_roundtrip :: Property
+prop_restoreloc_locationify_roundtrip =
+    forAll genLocation prop_restoreloc_locationify_roundtrip_for
+
+prop_restoreloc_locationify_roundtrip_for :: Location -> Bool
+prop_restoreloc_locationify_roundtrip_for loc =
+    restoreloc (locationify loc) == Just loc
+
+main :: IO ()
+main = do
+    runSmokeTests
+    quickCheck prop_restoreloc_locationify_roundtrip