{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} -- | -- Module : Clod.AdvancedCapabilitySpec -- Description : Tests for the advanced capability system -- Copyright : (c) Fuzz Leonard, 2025 -- License : MIT -- Maintainer : ink@fuzz.ink -- Stability : experimental -- -- This module contains tests for the advanced capability-based security system -- that uses type-level programming to enforce security constraints. module Clod.AdvancedCapabilitySpec (spec) where import Test.Hspec import System.Directory (createDirectoryIfMissing, doesFileExist) import System.FilePath (()) import System.IO.Temp (withSystemTempDirectory) import qualified Data.ByteString as BS import Control.Monad.IO.Class (liftIO) import Clod.AdvancedCapability hiding (readFile, writeFile) import qualified Clod.AdvancedCapability as AC -- | Test specification for AdvancedCapability module spec :: Spec spec = do describe "Advanced capability system" $ do typeRestrictedFileAccessSpec pathTraversalProtectionSpec permissionConstraintsSpec -- | Tests for type-restricted file access typeRestrictedFileAccessSpec :: Spec typeRestrictedFileAccessSpec = describe "Type-restricted file access" $ do it "allows access to files inside permitted directories" $ do withSystemTempDirectory "clod-test" $ \tmpDir -> do -- Create test directory and file let testDir = tmpDir "test-dir" let testFile = testDir "test-file.txt" createDirectoryIfMissing True testDir BS.writeFile testFile "Hello, World!" -- Create capability for the test directory let cap = createCapability @'Read [testDir] -- Use withPath to create a typed path withPath cap testFile $ \pathMaybe -> do -- pathMaybe should be Just because the path is allowed case pathMaybe of Nothing -> expectationFailure "Path should be allowed but wasn't" Just typedPath -> do -- Read file with the capability content <- AC.readFile cap typedPath content `shouldBe` "Hello, World!" it "denies access to files outside permitted directories" $ do withSystemTempDirectory "clod-test" $ \tmpDir -> do -- Create allowed and forbidden directories let allowedDir = tmpDir "allowed" let forbiddenDir = tmpDir "forbidden" createDirectoryIfMissing True allowedDir createDirectoryIfMissing True forbiddenDir -- Create files in both directories let allowedFile = allowedDir "allowed.txt" let forbiddenFile = forbiddenDir "forbidden.txt" BS.writeFile allowedFile "Allowed content" BS.writeFile forbiddenFile "Forbidden content" -- Create capability for the allowed directory only let cap = createCapability @'Read [allowedDir] -- Try to access forbidden file withPath cap forbiddenFile $ \pathMaybe -> do -- pathMaybe should be Nothing because the path is not allowed pathMaybe `shouldBe` Nothing -- | Tests for path traversal protection pathTraversalProtectionSpec :: Spec pathTraversalProtectionSpec = describe "Path traversal protection" $ do it "prevents path traversal attacks with ../" $ do withSystemTempDirectory "clod-test" $ \tmpDir -> do -- Create test directory structure let safeDir = tmpDir "safe" let dataFile = safeDir "data.txt" let secretDir = tmpDir "secret" let secretFile = secretDir "secret.txt" createDirectoryIfMissing True safeDir createDirectoryIfMissing True secretDir BS.writeFile dataFile "Safe data" BS.writeFile secretFile "Secret data" -- Create capability for the safe directory only let cap = createCapability @'Read [safeDir] -- Try to access secret file through path traversal let traversalPath = safeDir "../secret/secret.txt" withPath cap traversalPath $ \pathMaybe -> do -- pathMaybe should be Nothing because path traversal is prevented pathMaybe `shouldBe` Nothing -- | Tests for permission constraints permissionConstraintsSpec :: Spec permissionConstraintsSpec = describe "Permission constraints" $ do it "allows write operations with write capability" $ do withSystemTempDirectory "clod-test" $ \tmpDir -> do -- Create test directory let testDir = tmpDir "write-test" let testFile = testDir "writeable.txt" createDirectoryIfMissing True testDir -- Create write capability let writeCap = createCapability @'Write [testDir] -- Use withPath to get a typed path withPath writeCap testFile $ \pathMaybe -> do case pathMaybe of Nothing -> expectationFailure "Path should be allowed for writing" Just typedPath -> do -- Write to the file AC.writeFile writeCap typedPath "Written with capability" -- Verify content was written fileExists <- liftIO $ doesFileExist testFile fileExists `shouldBe` True content <- liftIO $ BS.readFile testFile content `shouldBe` "Written with capability" it "allows using AllPerm for both read and write" $ do withSystemTempDirectory "clod-test" $ \tmpDir -> do -- Create test directory let testDir = tmpDir "all-perm-test" let testFile = testDir "all-access.txt" createDirectoryIfMissing True testDir -- Create all-permission capability let allCap = createCapability @'All [testDir] -- Use withPath to get a typed path withPath allCap testFile $ \pathMaybe -> do case pathMaybe of Nothing -> expectationFailure "Path should be allowed with AllPerm" Just typedPath -> do -- Write to file AC.writeFile allCap typedPath "Initial content" -- Read from file content <- AC.readFile allCap typedPath content `shouldBe` "Initial content" it "allows capability restriction to more limited permissions" $ do withSystemTempDirectory "clod-test" $ \tmpDir -> do -- Create test directory let testDir = tmpDir "restriction-test" let testFile = testDir "restrict.txt" createDirectoryIfMissing True testDir BS.writeFile testFile "Original content" -- Create all-permission capability let allCap = createCapability @'All [testDir] -- Restrict to read-only let readCap = restrictCapability allCap -- Use withPath to get a typed path withPath readCap testFile $ \pathMaybe -> do case pathMaybe of Nothing -> expectationFailure "Path should be allowed for reading" Just typedPath -> do -- Read should be allowed content <- AC.readFile readCap typedPath content `shouldBe` "Original content" -- This would fail to compile: -- writeFile readCap typedPath "New content" -- Type error!