module Data.Git.Phoenix.ShaCollision where

import Data.List.NonEmpty (groupWith)
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.App
import Data.Git.Phoenix.Io
import Data.Git.Phoenix.Object
import Data.Git.Phoenix.Prelude


disambiguateByPair :: PhoenixM m => GitObjType -> [FilePath] -> m [FilePath]
disambiguateByPair :: forall (m :: * -> *).
PhoenixM m =>
GitObjType -> [FilePath] -> m [FilePath]
disambiguateByPair GitObjType
tt [FilePath]
links =
  (NonEmpty (ByteString, FilePath) -> FilePath)
-> [NonEmpty (ByteString, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString, FilePath) -> FilePath
forall a b. (a, b) -> b
snd ((ByteString, FilePath) -> FilePath)
-> (NonEmpty (ByteString, FilePath) -> (ByteString, FilePath))
-> NonEmpty (ByteString, FilePath)
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (ByteString, FilePath) -> (ByteString, FilePath)
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head) ([NonEmpty (ByteString, FilePath)] -> [FilePath])
-> ([Maybe (ByteString, FilePath)]
    -> [NonEmpty (ByteString, FilePath)])
-> [Maybe (ByteString, FilePath)]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, FilePath) -> ByteString)
-> [(ByteString, FilePath)] -> [NonEmpty (ByteString, FilePath)]
forall (f :: * -> *) b a.
(Foldable f, Eq b) =>
(a -> b) -> f a -> [NonEmpty a]
groupWith (ByteString, FilePath) -> ByteString
forall a b. (a, b) -> a
fst ([(ByteString, FilePath)] -> [NonEmpty (ByteString, FilePath)])
-> ([Maybe (ByteString, FilePath)] -> [(ByteString, FilePath)])
-> [Maybe (ByteString, FilePath)]
-> [NonEmpty (ByteString, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ByteString, FilePath)] -> [(ByteString, FilePath)]
forall a. Ord a => [a] -> [a]
sort ([(ByteString, FilePath)] -> [(ByteString, FilePath)])
-> ([Maybe (ByteString, FilePath)] -> [(ByteString, FilePath)])
-> [Maybe (ByteString, FilePath)]
-> [(ByteString, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (ByteString, FilePath)] -> [(ByteString, FilePath)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (ByteString, FilePath)] -> [FilePath])
-> m [Maybe (ByteString, FilePath)] -> m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> m (Maybe (ByteString, FilePath)))
-> [FilePath] -> m [Maybe (ByteString, FilePath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> m (Maybe (ByteString, FilePath))
go [FilePath]
links
  where
    go :: FilePath -> m (Maybe (ByteString, FilePath))
go FilePath
l = do
      FilePath
-> (HasCallStack => ByteString -> m (Maybe (ByteString, FilePath)))
-> m (Maybe (ByteString, FilePath))
forall a (m :: * -> *).
(HasCallStack, NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
FilePath -> (HasCallStack => ByteString -> m a) -> m a
withCompressed FilePath
l ((HasCallStack => ByteString -> m (Maybe (ByteString, FilePath)))
 -> m (Maybe (ByteString, FilePath)))
-> (HasCallStack => ByteString -> m (Maybe (ByteString, FilePath)))
-> m (Maybe (ByteString, FilePath))
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> do
        case ByteString -> Maybe GitObjType
classifyGitObject ByteString
bs of
          Just GitObjType
x | GitObjType
x GitObjType -> GitObjType -> Bool
forall a. Eq a => a -> a -> Bool
== GitObjType
tt -> Maybe (ByteString, FilePath) -> m (Maybe (ByteString, FilePath))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ByteString, FilePath) -> m (Maybe (ByteString, FilePath)))
-> Maybe (ByteString, FilePath) -> m (Maybe (ByteString, FilePath))
forall a b. (a -> b) -> a -> b
$ (ByteString, FilePath) -> Maybe (ByteString, FilePath)
forall a. a -> Maybe a
Just (ByteString
bs, FilePath
l)
                 | Bool
otherwise -> Maybe (ByteString, FilePath) -> m (Maybe (ByteString, FilePath))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ByteString, FilePath)
forall a. Maybe a
Nothing
          Maybe GitObjType
Nothing -> Maybe (ByteString, FilePath) -> m (Maybe (ByteString, FilePath))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ByteString, FilePath)
forall a. Maybe a
Nothing

uniqBs :: PhoenixExtractM m =>
  GitPath x ->
  Tagged Compressed LByteString ->
  GitObjType ->
  m FilePath
uniqBs :: forall (m :: * -> *) (x :: GitObjTypeG).
PhoenixExtractM m =>
GitPath x
-> Tagged Compressed ByteString -> GitObjType -> m FilePath
uniqBs GitPath x
ambiHash Tagged Compressed ByteString
cbs GitObjType
expectedGitObjType = do
  case Tagged Compressed ByteString -> [ByteString]
parseFileLinks Tagged Compressed ByteString
cbs of
    [ByteString
_] -> FilePath -> m FilePath
forall a. FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m FilePath) -> FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ Tagged Compressed ByteString -> FilePath
forall b a. (Show a, IsString b) => a -> b
show Tagged Compressed ByteString
cbs FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" is not ambiguous"
    [] -> FilePath -> m FilePath
forall a. FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m FilePath) -> FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ Tagged Compressed ByteString -> FilePath
forall b a. (Show a, IsString b) => a -> b
show Tagged Compressed ByteString
cbs FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" is emply list"
    [ByteString]
links -> do
      disLinks <- GitObjType -> [FilePath] -> m [FilePath]
forall (m :: * -> *).
PhoenixM m =>
GitObjType -> [FilePath] -> m [FilePath]
disambiguateByPair GitObjType
expectedGitObjType ([FilePath] -> m [FilePath]) -> [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ (ByteString -> FilePath) -> [ByteString] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> FilePath
L8.unpack [ByteString]
links
      case disLinks of
        [] -> FilePath -> m FilePath
forall a. FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m FilePath) -> FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ Tagged Compressed ByteString -> FilePath
forall b a. (Show a, IsString b) => a -> b
show Tagged Compressed ByteString
cbs FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" is emply list after dis"
        [FilePath
a] -> FilePath -> m FilePath
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
a
        [FilePath]
uniqLinks -> [FilePath] -> m FilePath
chooseOneLink [FilePath]
uniqLinks
  where
    chooseOneLink :: [FilePath] -> m FilePath
chooseOneLink [FilePath]
links = do
      [(Int, FilePath)] -> ((Int, FilePath) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [FilePath] -> [(Int, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [FilePath]
links) (((Int, FilePath) -> m ()) -> m ())
-> ((Int, FilePath) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, FilePath
l) -> FilePath -> m ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
putStrLn (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%4d) %s" Int
i FilePath
l
      FilePath -> m ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
putStrLn FilePath
"-----------------------------------------------------------"
      FilePath -> m ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
putStrLn (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Enter link number to disambiguate SHA " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> GitPath x -> FilePath
forall (t :: GitObjTypeG). GitPath t -> FilePath
toFp GitPath x
ambiHash FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" of " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> GitObjType -> FilePath
forall b a. (Show a, IsString b) => a -> b
show GitObjType
expectedGitObjType
      i <- Int -> Int -> m Int
forall (m :: * -> *). MonadIO m => Int -> Int -> m Int
readNumber Int
0 ([FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
links Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      case links !? i of
        Maybe FilePath
Nothing -> FilePath -> m FilePath
forall a. FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m FilePath) -> FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Link index out of range: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall b a. (Show a, IsString b) => a -> b
show Int
i FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" for " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall b a. (Show a, IsString b) => a -> b
show ([FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
links)
        Just FilePath
l -> FilePath -> m FilePath
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
l

parseFileLinks :: Tagged Compressed LByteString -> [LByteString]
parseFileLinks :: Tagged Compressed ByteString -> [ByteString]
parseFileLinks (Tagged ByteString
preCbs) = ByteString -> [ByteString]
go ByteString
cbs
  where
    go :: ByteString -> [ByteString]
go ByteString
bs =
      case Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt Int64
encodedIntLen ByteString
bs of
        (ByteString
"", ByteString
_) -> []
        (ByteString
binLen, ByteString
bs') ->
          case ByteString
-> Either (ByteString, Int64, FilePath) (ByteString, Int64, Int64)
forall a.
Binary a =>
ByteString
-> Either (ByteString, Int64, FilePath) (ByteString, Int64, a)
B.decodeOrFail ByteString
binLen of
            Right (ByteString
_, Int64
_, Int64
fsLinkLen) ->
              case Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt Int64
fsLinkLen ByteString
bs' of
                (ByteString
fsLinkBs, ByteString
bs'')
                  | ByteString -> Int64
L.length ByteString
fsLinkBs Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
fsLinkLen ->
                    ByteString
fsLinkBs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
go ByteString
bs''
                  | Bool
otherwise ->
                      Text -> [ByteString]
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> [ByteString]) -> Text -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Text
"Expected link len " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall b a. (Show a, IsString b) => a -> b
show Int64
fsLinkLen
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall b a. (Show a, IsString b) => a -> b
show (ByteString -> Int64
L.length ByteString
fsLinkBs)
            Left (ByteString, Int64, FilePath)
e ->
              Text -> [ByteString]
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> [ByteString]) -> Text -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Text
"List of files with collided SHA is corrupted (error: "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ByteString, Int64, FilePath) -> Text
forall b a. (Show a, IsString b) => a -> b
show (ByteString, Int64, FilePath)
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") near: "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall b a. (Show a, IsString b) => a -> b
show ByteString
bs

    cbs :: ByteString
cbs = Int64 -> ByteString -> ByteString
L.drop (ByteString -> Int64
L.length ByteString
compressedDisambiguate) ByteString
preCbs