module CheckSpec where import Check.Gen () import Check.Internal import Check.TestUtils import Check.Types import Compiler.Types import Control.Monad (forM_) import CoreTypes import qualified Data.ByteString as SB import Parser.Gen import System.Directory (removeDirectoryRecursive, removeFile, withCurrentDirectory) import System.Posix.Files import Test.Hspec import Test.QuickCheck import TestUtils import Utils spec :: Spec spec = do diagnoseSpec checkSpec hashSpec diagnoseSpec :: Spec diagnoseSpec = do let sandbox = "test_sandbox" let setup = createDirectoryIfMissing sandbox let teardown = removeDirectoryRecursive sandbox beforeAll_ setup $ afterAll_ teardown $ do describe "diagnoseDeployment" $ do it "retains the filepaths and deploymentkind that it diagnoses for very simple filepaths" $ do once $ forAll (resize 5 $ listOf generateWord) $ \srcs -> do forAll generateWord $ \dst -> do forAll arbitrary $ \kind -> do (Diagnosed dsrcs ddst dkind) <- diagnoseDeployment $ Put srcs dst kind map diagnosedFilePath dsrcs `shouldBe` srcs diagnosedFilePath ddst `shouldBe` dst dkind `shouldBe` kind pend describe "diagnose" $ do it "retains the filepath that it diagnoses for very simple filepaths" $ do once $ forAll generateWord $ \fp -> do (D dfp _ _) <- diagnose fp dfp `shouldBe` fp pend describe "diagnoseFp" $ do it "figures out this test file" $ do withCurrentDirectory sandbox $ do let file = "test.txt" writeFile file "This is a test" diagnoseFp file `shouldReturn` IsFile removeFile file diagnoseFp file `shouldReturn` Nonexistent it "figures out this test directory" $ do withCurrentDirectory sandbox $ do let dir = "testdir" createDirectoryIfMissing dir diagnoseFp dir `shouldReturn` IsDirectory removeDirectoryRecursive dir diagnoseFp dir `shouldReturn` Nonexistent it "figures out this test symbolic link with a destination" $ do withCurrentDirectory sandbox $ do let link = "testlink" let file = "testfile" writeFile file "This is a test" createSymbolicLink file link diagnoseFp file `shouldReturn` IsFile diagnoseFp link `shouldReturn` IsLinkTo file removeLink link removeFile file diagnoseFp link `shouldReturn` Nonexistent it "figures out this test symbolic link without a destination" $ do withCurrentDirectory sandbox $ do let link = "testlink" let file = "testfile" createSymbolicLink file link diagnoseFp file `shouldReturn` Nonexistent diagnoseFp link `shouldReturn` IsLinkTo file removeLink link diagnoseFp file `shouldReturn` Nonexistent diagnoseFp link `shouldReturn` Nonexistent it "figures out that /dev/null is weird" $ do diagnoseFp "/dev/null" `shouldReturn` IsWeird it "figures out that /dev/random is weird" $ do diagnoseFp "/dev/random" `shouldReturn` IsWeird checkSpec :: Spec checkSpec = parallel $ do checkSingleSpec checkDeploymentSpec checkDeploymentSpec :: Spec checkDeploymentSpec = do describe "checkDeployment" $ do it "says 'impossible' for deployments with an empty list of sources" $ do forAll arbitrary $ \dst -> forAll arbitrary $ \kind -> shouldBeImpossible' $ Diagnosed [] dst kind it "says 'impossible' for deployments where all singles are impossible" $ do forAll (arbitrary `suchThat` (\(Diagnosed srcs dst kind) -> all (\src -> isImpossible $ checkSingle src dst kind) srcs)) $ \dd -> shouldBeImpossible' dd it "gives the same result as bestResult (just with a better error for empty lists)" $ do property $ \dd@(Diagnosed srcs dst kind) -> case (bestResult (map (\src -> checkSingle src dst kind) srcs), checkDeployment dd) of (ImpossibleDeployment r1, ImpossibleDeployment r2) -> length r1 `shouldSatisfy` (<= (length r2)) (r1, r2) -> r1 `shouldBe` r2 describe "bestResult" $ do it "says 'impossible' if all checkresults are impossible" $ do forAll (arbitrary `suchThat` all isImpossible) shouldBeImpossibleDeployment it "says 'done' if the first non-impossible in 'done'" $ do forAll (arbitrary `suchThat` (any (not . isImpossible) &&& (isDone . head . dropWhile isImpossible))) $ \dd -> bestResult dd `shouldSatisfy` deploymentIsDone it "says 'dirty' if the first non-impossible in 'dirty'" $ do forAll (arbitrary `suchThat` (any (not . isImpossible) &&& (isDirty . head . dropWhile isImpossible))) $ \dd -> bestResult dd `shouldSatisfy` dirtyDeployment it "says 'ready' if the first non-impossible in 'ready'" $ do forAll (arbitrary `suchThat` (any (not . isImpossible) &&& (isReady . head . dropWhile isImpossible))) $ \dd -> bestResult dd `shouldSatisfy` deploymentReadyToDeploy checkSingleSpec :: Spec checkSingleSpec = describe "checkSingle" $ do it "says 'impossible' if the source does not exist" $ do forAll (arbitraryWith Nonexistent) $ \src -> forAll arbitrary $ \dst -> forAll arbitrary $ \kind -> shouldBeImpossible src dst kind it "says 'ready' if the source is a file and the destination does not exist" $ do forAll (arbitraryWith IsFile) $ \src -> forAll (arbitraryWith Nonexistent) $ \dst -> forAll arbitrary $ \kind -> shouldBeReady src dst kind it "says 'dirty' if both the source and destination are files and it's a link deployment" $ do forAll (arbitraryWith IsFile) $ \src -> forAll (arbitraryWith IsFile) $ \dst -> shouldBeDirty src dst LinkDeployment $ CleanFile $ diagnosedFilePath dst it "says 'done' if both the source and destination are files and it's a copy deployment and the files are equal" $ do forAll arbitrary $ \src -> forAll arbitrary $ \dst -> forAll arbitrary $ \h1 -> shouldBeDone (D src IsFile h1) (D dst IsFile h1) CopyDeployment it "says 'dirty' if both the source and destination are files and it's a copy deployment but the files are unequal" $ do forAll arbitrary $ \src -> forAll arbitrary $ \dst -> forAll arbitrary $ \h1 -> forAll (arbitrary `suchThat` (/= h1)) $ \h2 -> shouldBeDirty (D src IsFile h1) (D dst IsFile h2) CopyDeployment $ CleanFile dst it "says 'dirty' if the source is a file and the destination is a directory" $ do forAll (arbitraryWith IsFile) $ \src -> forAll (arbitraryWith IsDirectory) $ \dst -> forAll arbitrary $ \kind -> shouldBeDirty src dst kind $ CleanDirectory $ diagnosedFilePath dst it "says 'dirty' if the source is a file and the destination is a link for a link deployment but the destination doesn't point to the source" $ do forAll (arbitraryWith IsFile) $ \src@(D srcp _ _) -> forAll (arbitrary `suchThat` (/= srcp)) $ \l -> forAll (arbitraryWith $ IsLinkTo l) $ \dst -> shouldBeDirty src dst LinkDeployment $ CleanLink $ diagnosedFilePath dst it "says 'done' if the source is a file and the destination is a link for a link deployment and the destination points to the source" $ do forAll (arbitraryWith IsFile) $ \src@(D srcp _ _) -> forAll (arbitraryWith $ IsLinkTo srcp) $ \dst -> shouldBeDone src dst LinkDeployment it "says 'dirty' if the source is a file and the destination is a link for a copy deployment" $ do forAll (arbitraryWith IsFile) $ \src -> forAll arbitrary $ \l -> forAll (arbitraryWith $ IsLinkTo l) $ \dst -> shouldBeDirty src dst CopyDeployment $ CleanLink $ diagnosedFilePath dst it "says 'ready' if the source is a directory and the destination does not exist" $ do forAll (arbitraryWith IsDirectory) $ \src -> forAll (arbitraryWith Nonexistent) $ \dst -> forAll arbitrary $ \kind -> shouldBeReady src dst kind it "says 'dirty' if the source is a directory and the destination is a file" $ do forAll (arbitraryWith IsDirectory) $ \src -> forAll (arbitraryWith IsFile) $ \dst -> forAll arbitrary $ \kind -> shouldBeDirty src dst kind $ CleanFile $ diagnosedFilePath dst it "says 'dirty' if both the source and destination are directories for a link deployment" $ do forAll (arbitraryWith IsDirectory) $ \src -> forAll (arbitraryWith IsDirectory) $ \dst -> shouldBeDirty src dst LinkDeployment $ CleanDirectory $ diagnosedFilePath dst it "says 'done' if both the source and destination are directories and it's a copy deployment and the directories are equal" $ do forAll arbitrary $ \src -> forAll arbitrary $ \dst -> forAll arbitrary $ \h1 -> shouldBeDone (D src IsDirectory h1) (D dst IsDirectory h1) CopyDeployment it "says 'dirty' if both the source and destination are directories and it's a copy deployment but the directories are unequal" $ do forAll arbitrary $ \src -> forAll arbitrary $ \dst -> forAll arbitrary $ \h1 -> forAll (arbitrary `suchThat` (/= h1)) $ \h2 -> shouldBeDirty (D src IsDirectory h1) (D dst IsDirectory h2) CopyDeployment $ CleanDirectory dst it "says 'dirty' if the source is a directory and the destination is a link for a link deployment but the destination doesn't point to the source" $ do forAll (arbitraryWith IsDirectory) $ \src@(D srcp _ _) -> forAll (arbitrary `suchThat` (/= srcp)) $ \l -> forAll (arbitraryWith $ IsLinkTo l) $ \dst -> shouldBeDirty src dst LinkDeployment $ CleanLink $ diagnosedFilePath dst it "says 'done' if the source is a directory and the destination is a link for a link deployment and the destination points to the source" $ do forAll (arbitraryWith IsDirectory) $ \src@(D srcp _ _) -> forAll (arbitraryWith $ IsLinkTo srcp) $ \dst -> shouldBeDone src dst LinkDeployment it "says 'dirty' if the source is a directory and the destination is a link for a copy deployment" $ do forAll (arbitraryWith IsDirectory) $ \src -> forAll arbitrary $ \l -> forAll (arbitraryWith $ IsLinkTo l) $ \dst -> shouldBeDirty src dst CopyDeployment $ CleanLink $ diagnosedFilePath dst it "says 'dirty' if the source is a link" $ do forAll arbitrary $ \l -> forAll (arbitraryWith $ IsLinkTo l) $ \src -> forAll arbitrary $ \dst -> forAll arbitrary $ \kind -> shouldBeImpossible src dst kind it "says 'dirty' for a weird source" $ do forAll (arbitraryWith IsWeird) $ \src -> forAll arbitrary $ \dst -> forAll arbitrary $ \kind -> shouldBeImpossible src dst kind it "says 'dirty' for a weird destination" $ do forAll arbitrary $ \src -> forAll (arbitraryWith IsWeird) $ \dst -> forAll arbitrary $ \kind -> shouldBeImpossible src dst kind it "works for these unit tests" $ do pending hashSpec :: Spec hashSpec = do tooManyFilesTest tooManyFilesTest :: Spec tooManyFilesTest = do let sandbox = "test_sandbox" let setup = createDirectoryIfMissing sandbox let teardown = removeDirectoryRecursive sandbox let aLot = 20000 :: Int let setupALotOfFiles = do forM_ [1..aLot] $ \i -> writeFile (sandbox ++ "/file" ++ show i) $ "This is file " ++ show i ++ ".\n" beforeAll_ setup $ afterAll_ teardown $ do describe "hashFilePath" $ do beforeAll_ setupALotOfFiles $ do it ("has no problem with hashing a directory of " ++ show aLot ++ " files") $ do hashFilePath "test_sandbox" `shouldNotReturn` md5 SB.empty