module Data.Git.Phoenix.Test where import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as C8 import Data.Git.Phoenix.CmdArgs import Data.Git.Phoenix.CmdRun import Data.Git.Phoenix.Prelude import Test.QuickCheck as QC import UnliftIO.Directory import UnliftIO.IO (hSeek, SeekMode (..)) import UnliftIO.Temporary currentHead :: String currentHead = "62324a152b2f9272c922571ab1e08a5212da2d65" readBranchCommit :: FilePath -> IO String readBranchCommit fp = C8.unpack . BS.takeWhile isHexDigit <$> BS.readFile fp data Root data Uber withUber :: (Tagged Root FilePath -> Tagged Uber FilePath -> IO ()) -> IO () withUber doWithUberDir = withSystemTempDirectory "gitphoenix" $ \rdir -> let phOut = rdir "photorec-output" in do createDirectory phOut forM_ cases $ \(d, f) -> do let destDir = phOut d createDirectory destDir runConduitRes ( sourceDirectoryDeep False "test-git-objects" .| foldMC (f destDir) (0 :: Int) ) let uberOut = rdir "uber" runCmd BuildUberRepo { inDir = Tagged phOut , outDir = Tagged uberOut } doWithUberDir (Tagged @Root rdir) (Tagged @Uber uberOut) where cases = [ ("trail-trash", trailTrash) , ("middle-trash", middleTrash) , ("symlinks", symlinks) , ("clean-copy", cleanCopy) ] markWritable fp = setPermissions fp . setOwnerWritable True =<< getPermissions fp trailTrash destDir nextFileName gitObjFp = liftIO $ do let destFp = destDir show nextFileName <> ".go1" copyFile gitObjFp destFp markWritable destFp withBinaryFile destFp AppendMode $ \h -> genBs >>= BS.hPut h pure $ nextFileName + 1 middleTrash destDir nextFileName gitObjFp = liftIO $ do let destFp = destDir show nextFileName <> ".go1" copyFile gitObjFp destFp markWritable destFp withBinaryFile destFp WriteMode $ \h -> do hs <- fromIntegral <$> getFileSize gitObjFp i <- fromIntegral <$> generate (chooseInt (0, hs - 1)) hSeek h AbsoluteSeek i genBs >>= BS.hPut h pure $ nextFileName + 1 symlinks destDir nextFileName gitObjFp = liftIO $ do let destFp = destDir show nextFileName <> ".go1" (`createFileLink` destFp) =<< makeAbsolute gitObjFp pure $ nextFileName + 1 cleanCopy destDir nextFileName gitObjFp = liftIO $ do let destFp = destDir show nextFileName <> ".go1" copyFile gitObjFp destFp pure $ nextFileName + 1 genBs :: MonadIO m => m ByteString genBs = liftIO $ generate go where go = do s <- QC.getSize BS.pack <$> QC.vector (1 + s)