diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,4 +1,7 @@
 # git-phoenix changelog
 
+## Version 0.0.2 2025-07-14
+  * use lazy-scope
+
 ## Version 0.0.1 2025-06-28
   * init
diff --git a/git-phoenix.cabal b/git-phoenix.cabal
--- a/git-phoenix.cabal
+++ b/git-phoenix.cabal
@@ -1,6 +1,6 @@
 cabal-version: 3.0
 name:          git-phoenix
-version:       0.0.1
+version:       0.0.2
 
 synopsis:      Recover Git repositories from disk recovery tool output (photorec)
 description:
@@ -201,6 +201,7 @@
     , deepseq                 < 2
     , extra                   < 2
     , filepath                < 2
+    , lazy-scope              < 1
     , lens                    < 6
     , memory                  < 1
     , pretty-hex              < 2
diff --git a/src/Data/Git/Phoenix/Commit.hs b/src/Data/Git/Phoenix/Commit.hs
--- a/src/Data/Git/Phoenix/Commit.hs
+++ b/src/Data/Git/Phoenix/Commit.hs
@@ -1,57 +1,56 @@
 module Data.Git.Phoenix.Commit where
 
-import Data.ByteString.Lazy qualified as L
 import Data.ByteString.Lazy.Char8 qualified as L8
 import Data.Time
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
--- import Data.Time.Format.Internal
 import Data.Word8 qualified as W
+import Lazy.Scope as S
 import Relude
 
-type LbsPair = (LByteString, LByteString)
-
 extractField ::
-  Word8 -> LByteString -> (LByteString -> LbsPair) -> LByteString -> LbsPair
+  Monad m =>
+  Word8 -> Bs s -> (Bs s -> LazyT s m  (Bs s, Bs s)) -> Bs s -> LazyT s m (Bs s, Bs s)
 extractField b field parseValue bs =
-  case L.dropWhile (/= b) bs of
-    "" -> ("", "")
-    bs' ->
-      if field `L.isPrefixOf` bs'
-      then parseValue $ L.drop (L.length field) bs'
-      else extractField b field parseValue $ L.drop 1 bs'
+  case S.dropWhile (/= b) bs of
+    "" -> pure ("", "")
+    bs' -> condM
+      [ ( field `S.isPrefixOf` bs'
+        , parseValue (S.length field `S.drop` bs') )
+      ]
+      (extractField b field parseValue $ S.drop 1 bs')
 
-extractParent :: L.ByteString -> LbsPair
+extractParent :: Monad m => Bs s -> LazyT s m (Bs s, Bs s)
 extractParent =
-  extractField W._lf "\nparent " (L.span W.isHexDigit)
+  extractField W._lf "\nparent " (pure . S.span W.isHexDigit)
 
-extractAuthor :: LByteString -> LbsPair
+extractAuthor :: Monad m => Bs s -> LazyT s m (Bs s, Bs s)
 extractAuthor =
-  extractField W._lf "\nauthor " (L.span (/= W._less))
+  extractField W._lf "\nauthor " (pure . S.span (/= W._less))
 
-extractCommitTs :: LByteString -> Maybe (Int64, LByteString)
+extractCommitTs :: Monad m => Bs s -> LazyT s m (Maybe (Int64, Bs s))
 extractCommitTs bs =
-  case extractField W._greater "> " (L.span (/= W._lf)) bs of
+  extractField W._greater "> " (pure . S.span (/= W._lf)) bs >>= \case
     (tsBs, bs') ->
-      case L8.readInt64 tsBs of
-        Nothing -> Nothing
+      unScope (bs2Scoped L8.readInt64 tsBs) >>= \case
+        Nothing -> pure $ Nothing
         Just (epoch', spcTzBs) ->
-          case L8.readInt64 $ L.dropWhile W.isSpace spcTzBs of
-            Nothing -> Nothing
+          unScope (bs2Scoped L8.readInt64 $ S.dropWhile W.isSpace $ toBs spcTzBs) >>= \case
+            Nothing -> pure $ Nothing
             Just (tz, _) ->
               let
                 tzAbs = abs tz
                 (tzH, tzM) = tzAbs `divMod` 100
               in
-                Just (epoch' + (tzH * 3600 + tzM * 60) * signum tz, bs')
+                pure $ Just (epoch' + (tzH * 3600 + tzM * 60) * signum tz, bs')
 
-extractMessage :: LByteString -> LByteString
+extractMessage :: Monad m => Bs s -> LazyT s m (Bs s)
 extractMessage bs =
-  case extractField W._lf "\n\n" (L.span (/= W._lf)) bs of
-    (msgFirstLine, _) -> msgFirstLine
+  extractField W._lf "\n\n" (pure . S.span (/= W._lf)) bs >>= \case
+    (msgFirstLine, _) -> pure msgFirstLine
 
-extractTreeHash :: LByteString -> LbsPair
+extractTreeHash :: Monad m => Bs s -> LazyT s m (Bs s, Bs s)
 extractTreeHash =
-  extractField 0 "\0tree " (L.span W.isHexDigit)
+  extractField 0 "\0tree " (pure . S.span W.isHexDigit)
 
 epoch :: UTCTime
 epoch = posixSecondsToUTCTime 0
diff --git a/src/Data/Git/Phoenix/CommitSearch.hs b/src/Data/Git/Phoenix/CommitSearch.hs
--- a/src/Data/Git/Phoenix/CommitSearch.hs
+++ b/src/Data/Git/Phoenix/CommitSearch.hs
@@ -16,6 +16,8 @@
 import Text.Regex.TDFA.ByteString.Lazy
 import Text.Regex.TDFA
 
+
+
 data CommitObject
   = CommitObject
     { message :: LByteString
@@ -31,27 +33,29 @@
   where
     -- "commit 192\NULtree 844eaa6a04859d069e9ae10f2c6c293d23efc459\nauthor Daniil Iaitskov <dyaitskov@gmail.com> 1750985584 -0800\ncommitter Daniil Iaitskov <dyaitskov@gmail.com> 1 750 985 584 -0800\n\n init git-phoenix\n"
     goCommit bs =
-      case extractAuthor bs of
+      extractAuthor bs >>= \case
         ("", _) -> pure []
-        (author, bs') ->
-          case extractCommitTs bs' of
+        (authorBs, bs') ->
+          extractCommitTs bs' >>= \case
             Nothing -> pure []
             Just (commitTs, bs'') ->
-              case extractMessage bs'' of
-                message ->
-                  let sha = gitPath2Bs . shaToPath . showDigest $ sha1 bs in
-                    pure [CommitObject {message, sha, commitTs, author}]
+              extractMessage bs'' >>= toLbs >>=
+                \message -> do
+                  author <- toLbs authorBs
+                  sha <- unScope $ bs2Scoped (gitPath2Bs . shaToPath . showDigest . sha1) bs
+                  pure [CommitObject {message, sha, commitTs, author}]
 
 
     go :: FilePath -> m [CommitObject]
     go absGop = do
-      lr <- withCompressedH absGop $ \cbs bs ->
-        case classifyGitObject bs of
-          Just BlobType -> pure $ Right []
-          Just TreeType -> pure $ Right []
-          Just CommitType -> Right <$> goCommit bs
-          Just CollidedHash -> pure $ Left cbs
-          Nothing -> pure $ Right []
+      lr <-
+        withCompressedH absGop $ \cbs bs ->
+          classifyGitObject bs >>= \case
+            Just BlobType -> pure $ Right []
+            Just TreeType -> pure $ Right []
+            Just CommitType -> Right <$> goCommit bs
+            Just CollidedHash -> Left <$> sequenceA (fmap toLbs cbs)
+            Nothing -> pure $ Right []
       case lr of
         Right cmt -> pure cmt
         Left cbs -> do
diff --git a/src/Data/Git/Phoenix/Extraction.hs b/src/Data/Git/Phoenix/Extraction.hs
--- a/src/Data/Git/Phoenix/Extraction.hs
+++ b/src/Data/Git/Phoenix/Extraction.hs
@@ -2,51 +2,61 @@
 
 import Data.ByteString.Lazy.Char8 qualified as L8
 import Data.Git.Phoenix.App
-import Data.Git.Phoenix.CmdArgs
-import Data.Git.Phoenix.Commit
+    ( PhoenixExtractConf(destGitDir, uberDir), PhoenixExtractM )
+import Data.Git.Phoenix.CmdArgs ( ShaPrefix )
+import Data.Git.Phoenix.Commit ( extractParent, extractTreeHash )
 import Data.Git.Phoenix.Io
+    ( writeBinaryFile,
+      hPutLbs,
+      saveCompressedBs,
+      withCompressed,
+      withCompressedH )
 import Data.Git.Phoenix.Object
+    ( classifyGitObject,
+      toCommitSha,
+      GitObjType(CommitType, BlobType, TreeType, CollidedHash),
+      GitObjTypeG(Tree, Commit),
+      GitPath(..) )
 import Data.Git.Phoenix.Prelude
-import Data.Git.Phoenix.Repo
-import Data.Git.Phoenix.Sha
-import Data.Git.Phoenix.ShaCollision
-import Data.Git.Phoenix.Tree
+import Data.Git.Phoenix.Repo ( initGitRepo )
+import Data.Git.Phoenix.Sha ( shaToPath )
+import Data.Git.Phoenix.ShaCollision ( uniqBs )
+import Data.Git.Phoenix.Tree ( extractTree )
 
 
-readCommitObject :: PhoenixExtractM m => GitPath Commit -> m (Maybe (GitPath Commit), GitPath Tree)
+readCommitObject :: forall m. PhoenixExtractM m => GitPath Commit -> m (Maybe (GitPath Commit), GitPath Tree)
 readCommitObject gop = go . (</> toFp gop) . untag =<< asks uberDir
   where
+    goCommit :: forall s. Bs s -> LazyT s m (Maybe (GitPath Commit), GitPath Tree)
     goCommit bs =
-      case extractTreeHash $ $(tr "eee/bs") bs of
+      extractTreeHash {- fix traceEmbrace to uncomment this snippet: $ $(tr "eee/bs") -} bs >>= \case
         ("", _) -> fail $ show gop <> " does not have tree field"
         (treeComit, bs') -> do
           gitDir <- untag <$> asks destGitDir
-          saveCompressedBs
-            (gitDir </> ".git" </> "objects" </> toFp gop)
-            bs
-          case extractParent bs' of
-            ("", _) -> pure (Nothing, shaToPath $ L8.unpack treeComit)
-            (!ph, _) -> pure ( Just . shaToPath $ L8.unpack ph
-                            , $(tr "/treeComit") . shaToPath $ L8.unpack treeComit
-                            )
+          saveCompressedBs (gitDir </> ".git" </> "objects" </> toFp gop) =<< toLbs bs
+          extractParent bs' >>= \case
+            ("", _) -> (Nothing, ) . shaToPath . L8.unpack <$> toLbs treeComit
+            (!ph, _) -> (,)
+                        <$> (Just . shaToPath . L8.unpack <$> toLbs ph)
+                        <*> ( $(tr "/treeComit") . shaToPath . L8.unpack <$> toLbs treeComit)
     go absGop = do
-      lr <- withCompressedH absGop $ \cbs bs ->
-        case classifyGitObject bs of
-          Just BlobType -> fail $ show gop <> " is Git blob but expected Git commit"
-          Just TreeType -> fail $ show gop <> " is Git tree but expected Git commit"
-          Just CommitType -> Right <$> goCommit bs
-          Just CollidedHash -> pure $ Left cbs
-          Nothing -> fail $ show gop <> " is not a Git commit object"
+      lr <-
+        withCompressedH absGop $ \cbs bs ->
+          classifyGitObject bs >>= \case
+            Just BlobType -> fail $ show gop <> " is Git blob but expected Git commit"
+            Just TreeType -> fail $ show gop <> " is Git tree but expected Git commit"
+            Just CommitType -> Right <$> goCommit bs
+            Just CollidedHash -> Left <$> sequenceA (fmap toLbs cbs)
+            Nothing -> fail $ show gop <> " is not a Git commit object"
       case lr of
         Right cmt -> pure cmt
         Left cbs -> do
             uniPath <- uniqBs gop cbs CommitType
             withCompressed uniPath $ \ubs ->
-              case classifyGitObject ubs of
+              classifyGitObject ubs >>= \case
                 Just CommitType -> goCommit ubs
                 ops -> fail $ "Uniq BS of " <> show gop <> " is not commit but " <> show ops
 
-
 extractCommit :: PhoenixExtractM m => GitPath Commit -> m ()
 extractCommit ohp = do
   liftIO $(trIo "/ohp")
@@ -63,10 +73,10 @@
       initGitRepo gitDir
       let uc = GitPath . $(tw "/udr up") $ makeRelative udr up
       extractCommit uc
-      withBinaryFile
+      writeBinaryFile
         (gitDir </> ".git" </> "refs" </> "heads" </> "master")
         WriteMode
-        (`hPut` toCommitSha uc)
+        (`hPutLbs` toCommitSha uc)
     [] -> fail $ "No commit matching prefix: " <> show rootCommit
     ambiP -> fail $ "Commit prefix is ambioguous:\n " <> intercalate "\n" ambiP
 
diff --git a/src/Data/Git/Phoenix/HeadsDiscovery.hs b/src/Data/Git/Phoenix/HeadsDiscovery.hs
--- a/src/Data/Git/Phoenix/HeadsDiscovery.hs
+++ b/src/Data/Git/Phoenix/HeadsDiscovery.hs
@@ -16,6 +16,7 @@
 import Data.Time.Format
 import Text.Regex.TDFA.ByteString.Lazy
 import Text.Regex.TDFA
+import Lazy.Scope qualified as S
 
 data CommitObject
   = CommitObject
@@ -36,30 +37,32 @@
     Just gp -> fmap (gp,) <$> go gop
   where
     orphanCommit parent bs =
-      case extractAuthor bs of
+      extractAuthor bs >>= \case
         ("", _) -> pure []
-        (comAuthor, bs') ->
-          case extractCommitTs bs' of
+        (comAuthorBs, bs') ->
+          extractCommitTs bs' >>= \case
             Nothing -> pure []
             Just (commitTs, bs'') ->
-              case extractMessage bs'' of
-                message ->
-                    pure [CommitObject {message, commitTs, comAuthor, parent}]
+              extractMessage bs'' >>= S.toLbs >>=
+              \message -> do
+                comAuthor <- S.toLbs comAuthorBs
+                pure [CommitObject {message, commitTs, comAuthor, parent}]
 
     goCommit bs =
-      case extractParent bs of
+      extractParent bs >>= \case
         ("", bs') -> orphanCommit Nothing bs'
-        (parent, bs') -> orphanCommit (Just $ hexToBin parent) bs'
+        (parent, bs') -> (`orphanCommit` bs') =<< (Just . hexToBin <$> S.toLbs parent)
 
     go :: FilePath -> m [CommitObject]
     go absGop = do
-      lr <- withCompressedH absGop $ \cbs bs ->
-        case classifyGitObject bs of
-          Just BlobType -> pure $ Right []
-          Just TreeType -> pure $ Right []
-          Just CommitType -> Right <$> goCommit bs
-          Just CollidedHash -> pure $ Left cbs
-          Nothing -> pure $ Right []
+      lr <-
+        withCompressedH absGop $ \cbs bs ->
+          classifyGitObject bs >>= \case
+            Just BlobType -> pure $ Right []
+            Just TreeType -> pure $ Right []
+            Just CommitType -> Right <$> goCommit bs
+            Just CollidedHash -> Left <$> sequenceA (fmap S.toLbs cbs)
+            Nothing -> pure $ Right []
       case lr of
         Right cmt -> pure cmt
         Left cbs -> do
diff --git a/src/Data/Git/Phoenix/Io.hs b/src/Data/Git/Phoenix/Io.hs
--- a/src/Data/Git/Phoenix/Io.hs
+++ b/src/Data/Git/Phoenix/Io.hs
@@ -1,9 +1,10 @@
 module Data.Git.Phoenix.Io where
 
 import Data.ByteString.Lazy qualified as L
-import Data.ByteString qualified as BS
 import Data.Git.Phoenix.Prelude
-import System.IO (openBinaryFile)
+import System.IO qualified as IO
+import Lazy.Scope as S
+import UnliftIO.IO qualified as U
 
 class HasInHandlesSem m where
   getInHandlesSem :: m QSem
@@ -14,49 +15,39 @@
 data Compressed
 
 withHandleX :: (NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
-  IOMode -> FilePath -> (Handle -> m a) -> m a
+  IOMode -> FilePath -> (forall s. Handle s -> LazyT s m a) -> m a
 withHandleX mode fp a = do
   s <- getInHandlesSem
   bracket_ (waitQSem s) (signalQSem s) $
-    -- withFile is not applicable because Handle might be closed twice
-    -- https://github.com/haskell/bytestring/issues/707
-    bracket (liftIO $ openBinaryFile fp mode)
-      (\h -> whenM (hIsOpen h) $ hClose h) go
-  where
-    go h = do
-      !r <- a h
-      case rnf r of
-        () -> pure r
+    withBinaryFile fp mode a
 
+
 withHandle :: (NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
-  FilePath -> (Handle -> m a) -> m a
+  FilePath -> (forall s. Handle s -> LazyT s m a) -> m a
 withHandle = withHandleX ReadMode
 
 withCompressedH :: (NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
   FilePath ->
-  (Tagged Compressed LByteString -> LByteString -> m a) ->
+  (forall s. Tagged Compressed (Bs s) -> Bs s -> LazyT s m a) ->
   m a
 withCompressedH fp a =
-  withHandle ($(tr "/fp") fp) $ \inH -> hGetContents inH >>= (\cbs -> a (Tagged cbs) $ decompress cbs)
+  withHandle ($(tr "/fp") fp) $ \inH -> hGetContents inH >>= (\cbs -> a (Tagged cbs) $ mapLbs decompress cbs)
 
-withCompressed :: (HasCallStack, NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
-  FilePath -> (HasCallStack => L.ByteString -> m a) -> m a
+withCompressed :: (NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
+  FilePath -> (forall s. Bs s -> LazyT s m a) -> m a
 withCompressed fp a = withCompressedH fp (\_cbs bs -> a bs)
 
-hGet :: MonadIO m => Handle -> Int -> m ByteString
-hGet h n = liftIO $ BS.hGet h n
-
-hGetContents :: MonadIO m => Handle -> m LByteString
-hGetContents h = liftIO $ L.hGetContents h
+writeBinaryFile :: MonadUnliftIO m => FilePath -> IOMode -> (IO.Handle -> m ()) -> m ()
+writeBinaryFile fp mode cb = U.withBinaryFile fp mode cb
 
-hPut :: MonadIO m => Handle -> LByteString -> m ()
-hPut h bs = liftIO $ L.hPut h bs
+hPutLbs :: MonadIO m => IO.Handle -> LByteString -> m ()
+hPutLbs h bs = liftIO $ L.hPut h bs
 
 -- | just 'copyFile' is not possible due to trash after archive
 saveCompressedBs :: MonadUnliftIO m => FilePath -> LByteString -> m ()
 saveCompressedBs fp bs = do
   createDirectoryIfMissing False $ dropFileName fp
-  withBinaryFile ($(tr "/fp") fp) WriteMode $ \h -> hPut h $ compress bs
+  withBinaryFile ($(tr "/fp") fp) WriteMode $ \h -> S.hPut h $ compress bs
 
 readNumber :: MonadIO m => Int -> Int -> m Int
 readNumber minVal maxVal = go
diff --git a/src/Data/Git/Phoenix/Object.hs b/src/Data/Git/Phoenix/Object.hs
--- a/src/Data/Git/Phoenix/Object.hs
+++ b/src/Data/Git/Phoenix/Object.hs
@@ -1,10 +1,13 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
 module Data.Git.Phoenix.Object where
 
 import Data.Binary qualified as B
 import Data.ByteString.Lazy qualified as L
 import Data.ByteString.Lazy.Char8 qualified as L8
 import Data.Git.Phoenix.Prelude
+import Lazy.Scope qualified as S
 
+
 data GitObjType = CommitType | TreeType | BlobType | CollidedHash deriving (Show, Eq)
 
 data GitObjTypeG = Commit | Tree deriving (Show, Eq)
@@ -15,32 +18,41 @@
 toCommitSha :: GitPath t -> LByteString
 toCommitSha (GitPath p) = L8.pack $ filter (/= '/') p
 
-classifyGitObject :: LByteString -> Maybe GitObjType
-classifyGitObject bs
-  | blob `L.isPrefixOf` bs = pure BlobType
-  | tree `L.isPrefixOf` bs = pure TreeType
-  | commit `L.isPrefixOf` bs = pure CommitType
-  | disambiguate `L.isPrefixOf` bs = pure CollidedHash
-  | otherwise = Nothing
+classifyGitObject :: Monad m => Bs s -> LazyT s m (Maybe GitObjType)
+classifyGitObject bs =
+  condM
+    [ (blob `S.isPrefixOf` bs, pure $ pure BlobType)
+    , (tree `S.isPrefixOf` bs, pure $ pure TreeType)
+    , (commit `S.isPrefixOf` bs, pure $ pure CommitType)
+    , (toBs disambiguate `S.isPrefixOf` bs, pure $ pure CollidedHash)
+    ]
+    (pure Nothing)
 
-commit, tree, blob, disambiguate :: L.ByteString
-disambiguate = "disambigate "
+commit, tree, blob :: Bs s
 commit = "commit "
 blob = "blob "
 tree = "tree "
 
-gitObjectP :: LByteString -> Bool
+disambiguate :: LByteString
+disambiguate = "disambigate "
+
+gitObjectP :: Monad m => Bs s -> LazyT s m Bool
 gitObjectP bs =
-  case classifyGitObject bs of
+  classifyGitObject bs >>= pure . \case
     Nothing -> False
     Just CollidedHash -> False
     Just _ -> True
 
-compressedDisambiguate :: L.ByteString
-compressedDisambiguate =
-  compressWith
-    (defaultCompressParams { compressLevel = CompressionLevel 0 })
-    disambiguate
+compressedDisambiguate :: LByteString
+compressedDisambiguate = compressWith params disambiguate
+  where
+    params = defaultCompressParams { compressLevel = CompressionLevel 0 }
+
+compressedDisambiguateBs :: Bs s
+compressedDisambiguateBs = toBs compressedDisambiguate
+
+compressedDisambiguateLen :: Int64
+compressedDisambiguateLen = L.length compressedDisambiguate
 
 encodedIntLen :: Int64
 encodedIntLen = L.length . B.encode $ L.length ""
diff --git a/src/Data/Git/Phoenix/Prelude.hs b/src/Data/Git/Phoenix/Prelude.hs
--- a/src/Data/Git/Phoenix/Prelude.hs
+++ b/src/Data/Git/Phoenix/Prelude.hs
@@ -18,11 +18,11 @@
 import Data.List as X ((!?))
 import Data.Tagged as X (Tagged (..), untag)
 import Data.Word8 as X (isHexDigit)
-import Relude as X
+import Lazy.Scope as X (LazyT, Scoped, Bs, unScope, toLbs, condM, toBs, bs2Scoped)
+import Relude as X hiding (Handle)
 import System.FilePath as X ((</>), dropFileName, splitFileName, makeRelative)
 import System.Time.Extra as X
 import Text.Printf as X
-import UnliftIO.IO as X (withBinaryFile, hIsOpen, hClose)
 import UnliftIO.QSem as X (QSem, newQSem, signalQSem, waitQSem)
 import UnliftIO.Exception as X (bracket, bracket_, catch)
 import UnliftIO.Directory as X
diff --git a/src/Data/Git/Phoenix/ShaCollision.hs b/src/Data/Git/Phoenix/ShaCollision.hs
--- a/src/Data/Git/Phoenix/ShaCollision.hs
+++ b/src/Data/Git/Phoenix/ShaCollision.hs
@@ -8,16 +8,16 @@
 import Data.Git.Phoenix.Io
 import Data.Git.Phoenix.Object
 import Data.Git.Phoenix.Prelude
-
+import Lazy.Scope qualified as S
 
 disambiguateByPair :: PhoenixM m => GitObjType -> [FilePath] -> m [FilePath]
 disambiguateByPair tt links =
   fmap (snd . head) . groupWith fst . sort . catMaybes <$> mapM go links
   where
-    go l = do
-      withCompressed l $ \bs -> do
-        case classifyGitObject bs of
-          Just x | x == tt -> pure $ Just (bs, l)
+    go l =
+      withCompressed l $ \bs ->
+        classifyGitObject bs >>= \case
+          Just x | x == tt -> Just . (, l) <$> S.toLbs bs
                  | otherwise -> pure Nothing
           Nothing -> pure Nothing
 
@@ -66,4 +66,4 @@
               error $ "List of files with collided SHA is corrupted (error: "
                 <> show e <> ") near: "  <> show bs
 
-    cbs = L.drop (L.length compressedDisambiguate) preCbs
+    cbs = L.drop compressedDisambiguateLen preCbs
diff --git a/src/Data/Git/Phoenix/Tree.hs b/src/Data/Git/Phoenix/Tree.hs
--- a/src/Data/Git/Phoenix/Tree.hs
+++ b/src/Data/Git/Phoenix/Tree.hs
@@ -7,9 +7,10 @@
 import Data.Git.Phoenix.Sha
 import Data.Git.Phoenix.ShaCollision
 import Data.Git.Phoenix.Io
+import Lazy.Scope as S
 
-dropTreeHeader :: LByteString -> LByteString
-dropTreeHeader = L.drop 1 . L.dropWhile (/= 0)
+dropTreeHeader :: Bs s -> Bs s
+dropTreeHeader = S.drop 1 . S.dropWhile (/= 0)
 
 data DOF = Dir | File deriving (Eq, Show, Generic)
 
@@ -57,16 +58,16 @@
 
 parseTreeObject :: PhoenixExtractM m =>
   FilePath ->
-  Tagged Compressed LByteString ->
-  LByteString ->
-  m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
+  Tagged Compressed (Bs s) ->
+  Bs s ->
+  LazyT s m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
 parseTreeObject gop cbs bs =
-  case classifyGitObject bs of
+  classifyGitObject bs >>= \case
     Just BlobType -> fail $ gop <> " is Git blob but expected Git tree"
     Just CommitType -> fail $ gop <> " is Git commit but expected Git tree"
-    Just TreeType -> do
-      pure . Right . readTreeShas $ dropTreeHeader bs
-    Just CollidedHash -> pure $ Left cbs
+    Just TreeType ->
+      Right <$> unScope (bs2Scoped readTreeShas (dropTreeHeader bs))
+    Just CollidedHash -> Left <$> sequenceA (fmap toLbs cbs)
     Nothing -> fail $ gop <> " is not a Git tree object"
 
 onRight_ :: Monad m => (b -> m ()) -> Either a b -> m (Either a b)
@@ -74,7 +75,9 @@
   v@(Left _) -> pure v
   r@(Right v) -> f v >> pure r
 
-extractTree :: PhoenixExtractM m => GitPath Tree -> m ()
+getDestDir :: MonadReader PhoenixExtractConf m => m FilePath
+getDestDir = (\(Tagged r) -> r </> ".git" </> "objects") <$> asks destGitDir
+extractTree :: forall m. PhoenixExtractM m => GitPath Tree -> m ()
 extractTree treeHash = do
   Tagged udr <- asks uberDir
   dd <- getDestDir
@@ -82,11 +85,14 @@
     mapM_ (copyTreeLinks dd) . $(tw "len/")
   where
     copyTree treePath trH = do
-      let save bs = do
+      let
+        save :: forall s. Bs s -> LazyT s m ()
+        save bs = do
             destDir <- getDestDir
-            saveCompressedBs (destDir </> toFp trH) bs
-      rl <- withCompressedH treePath $ \cTreeBs treeBs ->
-        parseTreeObject treePath cTreeBs treeBs >>= onRight_ (\_ -> save treeBs)
+            saveCompressedBs (destDir </> toFp trH) =<< toLbs bs
+      rl <- withCompressedH treePath $
+            \cTreeBs treeBs ->
+              parseTreeObject treePath cTreeBs treeBs >>= onRight_ (\_ -> save treeBs)
       shas <- case rl of
         Right shas' -> pure shas'
         Left cbs -> do
@@ -94,41 +100,45 @@
           withCompressed uniPath
             (\ubs -> do
                 save ubs
-                pure . readTreeShas $ dropTreeHeader ubs
+                unScope (bs2Scoped readTreeShas $ dropTreeHeader ubs)
             )
       pure shas
-    getDestDir = (\(Tagged r) -> r </> ".git" </> "objects") <$> asks destGitDir
+
     copyTreeLinks destDir (dof, binSha) = do
       (Tagged udr) <- asks uberDir
       liftIO $(trIo "/destDir binSha")
       let shaP = binSha2Path binSha
           absSha = udr </> toFp shaP
-          saveBlob = saveCompressedBs (destDir </> toFp shaP)
+          saveBlob :: forall s. Bs s -> LazyT s m ()
+          saveBlob = toLbs >=> saveCompressedBs (destDir </> toFp shaP)
+          saveTree :: forall s. Bs s -> LazyT s m [(DOF, LByteString)]
           saveTree bs = do
             saveBlob bs
-            pure . readTreeShas $ dropTreeHeader bs
-      nonRec <- withCompressedH absSha $ \cbs bs ->
-        case classifyGitObject bs of
-          Just BlobType
-            | dof == File -> JustBlob <$> saveBlob bs
-            | otherwise -> fail $ absSha <> " is not a GIT blob"
-          Just TreeType
-            | dof == Dir -> TreeShas <$> saveTree bs
-            | otherwise -> fail $ absSha <> " is not a GIT tree"
-          Just CollidedHash ->
-            pure $ Collision cbs
-          _ -> fail $ absSha <> " is not a GIT tree nor GIT blob nor disambiguate file"
+            unScope (bs2Scoped readTreeShas $ dropTreeHeader bs)
+      nonRec <-
+        withCompressedH absSha $ \cbs bs ->
+          classifyGitObject bs >>= \case
+            Just BlobType
+              | dof == File -> JustBlob <$> saveBlob bs
+              | otherwise -> fail $ absSha <> " is not a GIT blob"
+            Just TreeType
+              | dof == Dir -> TreeShas <$> saveTree bs
+              | otherwise -> fail $ absSha <> " is not a GIT tree"
+            Just CollidedHash ->
+              Collision <$> sequenceA (fmap toLbs cbs)
+            _ -> fail $ absSha <> " is not a GIT tree nor GIT blob nor disambiguate file"
       case nonRec of
         JustBlob () -> pure ()
         TreeShas rows ->
           mapM_ (copyTreeLinks destDir) rows
         Collision cbs' -> do
           uniPath <- uniqBs shaP cbs' (dofToGitObjType dof)
-          !lr <- withCompressed uniPath $ \ubs ->
-            case classifyGitObject ubs of
-              Just BlobType -> Left <$> saveBlob ubs
-              Just TreeType -> Right <$> saveTree ubs
-              _ -> fail $ absSha <> " is not GIT tree nor GIT blob"
+          !lr <-
+            withCompressed uniPath $ \ubs ->
+              classifyGitObject ubs >>= \case
+                Just BlobType -> Left <$> saveBlob ubs
+                Just TreeType -> Right <$> saveTree ubs
+                _ -> fail $ absSha <> " is not GIT tree nor GIT blob"
           case lr of
             Left () -> pure ()
             Right rows -> mapM_ (copyTreeLinks destDir) rows
diff --git a/src/Data/Git/Phoenix/Uber.hs b/src/Data/Git/Phoenix/Uber.hs
--- a/src/Data/Git/Phoenix/Uber.hs
+++ b/src/Data/Git/Phoenix/Uber.hs
@@ -13,6 +13,7 @@
 import Data.Git.Phoenix.Sha
 import Data.List qualified as I
 import Data.Map.Strict qualified as M
+import Lazy.Scope as S
 
 type ShaDedupMap = M.Map ComHash Int
 
@@ -28,25 +29,25 @@
 gitObjectFilePath :: GitObject -> FilePath
 gitObjectFilePath = uncurry (</>) . I.splitAt 2 . showDigest . gobHash
 
-mkGitObject :: PhoenixM m => FilePath -> m (Maybe GitObject)
-mkGitObject fp =
-  withHandle fp $ \inH -> do
-    magicBs <- hGet inH 2
-    if zlibP magicBs
-      then do
-        (`catch` skipCorruptedFile) $ do
-          headerBs <- (toLazy magicBs <>) . toLazy <$> hGet inH 510
-          if gitObjectP $ decompress headerBs
-            then do
-              !goh <- sha1 . decompress . (headerBs <>) <$> hGetContents inH
-              pure . Just $! GitObject goh fp
-            else
-              pure Nothing
-      else pure Nothing
+mkGitObject :: forall m. PhoenixM m => FilePath -> m (Maybe GitObject)
+mkGitObject fp = go
   where
+    go :: m (Maybe GitObject)
+    go =
+      withHandle fp $ \inH -> unScope =<< do
+        magicBs <- S.hGet inH 2
+        if zlibP magicBs
+          then do
+            (`catch` skipCorruptedFile) $ do
+              headerBs <- (toLazy magicBs <>) . toLazy <$> S.hGet inH 510
+              ifM (gitObjectP . toBs $ decompress headerBs)
+                (S.bs2Scoped (Just . (`GitObject` fp) . sha1 . decompress) . (toBs headerBs <>) <$> S.hGetContents inH)
+                (pure (pure Nothing))
+          else pure (pure Nothing)
+
     skipCorruptedFile (_ :: DecompressError) = do
       liftIO $ $(trIo "Skip corrupted file/fp")
-      pure Nothing
+      pure (pure Nothing)
 
     zlibNoCompression = "\x0078\x0001"
     zlibDefaultCompression = "\x0078\x009C"
@@ -70,20 +71,20 @@
 replaceSymLinkWithDisambiguate uberGob gob = do
   firstGobOrigin <- L8.pack <$> getSymbolicLinkTarget uberGob
   removeFile uberGob
-  withBinaryFile uberGob WriteMode $ \oh ->
-    hPut oh . mconcat $ [ compressedDisambiguate
-                        , B.encode $ L.length firstGobOrigin
-                        , firstGobOrigin
-                        , B.encode $ L.length gobPacked
-                        , gobPacked
-                        ]
+  S.withBinaryFile uberGob WriteMode $ \oh ->
+    hPutBs oh . mconcat $ (compressedDisambiguateBs : fmap toBs [
+                            B.encode $ L.length firstGobOrigin
+                           , firstGobOrigin
+                           , B.encode $ L.length gobPacked
+                           , gobPacked
+                           ])
   where
     gobPacked = L8.pack $ gobOrigin gob
 
 appendPathToUberGob :: MonadUnliftIO m => FilePath -> GitObject -> m ()
 appendPathToUberGob uberGob gob =
-  withBinaryFile uberGob AppendMode $ \oh ->
-    hPut oh $ gobLen <> gobPacked
+  writeBinaryFile uberGob AppendMode $ \oh ->
+    hPutLbs oh $ gobLen <> gobPacked
   where
     gobPacked = L8.pack $ gobOrigin gob
     gobLen = B.encode $ L.length gobPacked
diff --git a/test/Data/Git/Phoenix/Test.hs b/test/Data/Git/Phoenix/Test.hs
--- a/test/Data/Git/Phoenix/Test.hs
+++ b/test/Data/Git/Phoenix/Test.hs
@@ -7,7 +7,7 @@
 import Data.Git.Phoenix.Prelude
 import Test.QuickCheck as QC
 import UnliftIO.Directory
-import UnliftIO.IO (hSeek, SeekMode (..))
+import UnliftIO.IO ( SeekMode(AbsoluteSeek), hSeek, withBinaryFile )
 import UnliftIO.Temporary
 
 currentHead :: String