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
import Lazy.Scope qualified as S

disambiguateByPair :: PhoenixM m => GitObjType -> [FilePath] -> m [FilePath]
disambiguateByPair :: forall (m :: * -> *).
PhoenixM m =>
GitObjType -> [FilePath] -> m [FilePath]
disambiguateByPair GitObjType
tt [FilePath]
links =
  (NonEmpty (LByteString, FilePath) -> FilePath)
-> [NonEmpty (LByteString, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LByteString, FilePath) -> FilePath
forall a b. (a, b) -> b
snd ((LByteString, FilePath) -> FilePath)
-> (NonEmpty (LByteString, FilePath) -> (LByteString, FilePath))
-> NonEmpty (LByteString, FilePath)
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (LByteString, FilePath) -> (LByteString, FilePath)
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head) ([NonEmpty (LByteString, FilePath)] -> [FilePath])
-> ([Maybe (LByteString, FilePath)]
    -> [NonEmpty (LByteString, FilePath)])
-> [Maybe (LByteString, FilePath)]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LByteString, FilePath) -> LByteString)
-> [(LByteString, FilePath)] -> [NonEmpty (LByteString, FilePath)]
forall (f :: * -> *) b a.
(Foldable f, Eq b) =>
(a -> b) -> f a -> [NonEmpty a]
groupWith (LByteString, FilePath) -> LByteString
forall a b. (a, b) -> a
fst ([(LByteString, FilePath)] -> [NonEmpty (LByteString, FilePath)])
-> ([Maybe (LByteString, FilePath)] -> [(LByteString, FilePath)])
-> [Maybe (LByteString, FilePath)]
-> [NonEmpty (LByteString, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(LByteString, FilePath)] -> [(LByteString, FilePath)]
forall a. Ord a => [a] -> [a]
sort ([(LByteString, FilePath)] -> [(LByteString, FilePath)])
-> ([Maybe (LByteString, FilePath)] -> [(LByteString, FilePath)])
-> [Maybe (LByteString, FilePath)]
-> [(LByteString, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (LByteString, FilePath)] -> [(LByteString, FilePath)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (LByteString, FilePath)] -> [FilePath])
-> m [Maybe (LByteString, FilePath)] -> m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> m (Maybe (LByteString, FilePath)))
-> [FilePath] -> m [Maybe (LByteString, 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 (LByteString, FilePath))
go [FilePath]
links
  where
    go :: FilePath -> m (Maybe (LByteString, FilePath))
go FilePath
l =
      FilePath
-> (forall (s :: ZonkAny 0).
    Bs s -> LazyT s m (Maybe (LByteString, FilePath)))
-> m (Maybe (LByteString, FilePath))
forall {k} a (m :: * -> *).
(NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
FilePath -> (forall (s :: k). Bs s -> LazyT s m a) -> m a
withCompressed FilePath
l ((forall (s :: ZonkAny 0).
  Bs s -> LazyT s m (Maybe (LByteString, FilePath)))
 -> m (Maybe (LByteString, FilePath)))
-> (forall (s :: ZonkAny 0).
    Bs s -> LazyT s m (Maybe (LByteString, FilePath)))
-> m (Maybe (LByteString, FilePath))
forall a b. (a -> b) -> a -> b
$ \Bs s
bs ->
        Bs s -> LazyT s m (Maybe GitObjType)
forall {k} (m :: * -> *) (s :: k).
Monad m =>
Bs s -> LazyT s m (Maybe GitObjType)
classifyGitObject Bs s
bs LazyT s m (Maybe GitObjType)
-> (Maybe GitObjType -> LazyT s m (Maybe (LByteString, FilePath)))
-> LazyT s m (Maybe (LByteString, FilePath))
forall a b. LazyT s m a -> (a -> LazyT s m b) -> LazyT s m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just GitObjType
x | GitObjType
x GitObjType -> GitObjType -> Bool
forall a. Eq a => a -> a -> Bool
== GitObjType
tt -> (LByteString, FilePath) -> Maybe (LByteString, FilePath)
forall a. a -> Maybe a
Just ((LByteString, FilePath) -> Maybe (LByteString, FilePath))
-> (LByteString -> (LByteString, FilePath))
-> LByteString
-> Maybe (LByteString, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, FilePath
l) (LByteString -> Maybe (LByteString, FilePath))
-> LazyT s m LByteString
-> LazyT s m (Maybe (LByteString, FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bs s -> LazyT s m LByteString
forall {k} (m :: * -> *) (s :: k).
Monad m =>
Bs s -> LazyT s m LByteString
S.toLbs Bs s
bs
                 | Bool
otherwise -> Maybe (LByteString, FilePath)
-> LazyT s m (Maybe (LByteString, FilePath))
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (LByteString, FilePath)
forall a. Maybe a
Nothing
          Maybe GitObjType
Nothing -> Maybe (LByteString, FilePath)
-> LazyT s m (Maybe (LByteString, FilePath))
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (LByteString, 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 LByteString -> GitObjType -> m FilePath
uniqBs GitPath x
ambiHash Tagged Compressed LByteString
cbs GitObjType
expectedGitObjType = do
  case Tagged Compressed LByteString -> [LByteString]
parseFileLinks Tagged Compressed LByteString
cbs of
    [LByteString
_] -> 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 LByteString -> FilePath
forall b a. (Show a, IsString b) => a -> b
show Tagged Compressed LByteString
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 LByteString -> FilePath
forall b a. (Show a, IsString b) => a -> b
show Tagged Compressed LByteString
cbs FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" is emply list"
    [LByteString]
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
$ (LByteString -> FilePath) -> [LByteString] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LByteString -> FilePath
L8.unpack [LByteString]
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 LByteString -> FilePath
forall b a. (Show a, IsString b) => a -> b
show Tagged Compressed LByteString
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 LByteString -> [LByteString]
parseFileLinks (Tagged LByteString
preCbs) = LByteString -> [LByteString]
go LByteString
cbs
  where
    go :: LByteString -> [LByteString]
go LByteString
bs =
      case Int64 -> LByteString -> (LByteString, LByteString)
L.splitAt Int64
encodedIntLen LByteString
bs of
        (LByteString
"", LByteString
_) -> []
        (LByteString
binLen, LByteString
bs') ->
          case LByteString
-> Either
     (LByteString, Int64, FilePath) (LByteString, Int64, Int64)
forall a.
Binary a =>
LByteString
-> Either (LByteString, Int64, FilePath) (LByteString, Int64, a)
B.decodeOrFail LByteString
binLen of
            Right (LByteString
_, Int64
_, Int64
fsLinkLen) ->
              case Int64 -> LByteString -> (LByteString, LByteString)
L.splitAt Int64
fsLinkLen LByteString
bs' of
                (LByteString
fsLinkBs, LByteString
bs'')
                  | LByteString -> Int64
L.length LByteString
fsLinkBs Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
fsLinkLen ->
                    LByteString
fsLinkBs LByteString -> [LByteString] -> [LByteString]
forall a. a -> [a] -> [a]
: LByteString -> [LByteString]
go LByteString
bs''
                  | Bool
otherwise ->
                      Text -> [LByteString]
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> [LByteString]) -> Text -> [LByteString]
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 (LByteString -> Int64
L.length LByteString
fsLinkBs)
            Left (LByteString, Int64, FilePath)
e ->
              Text -> [LByteString]
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> [LByteString]) -> Text -> [LByteString]
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
<> (LByteString, Int64, FilePath) -> Text
forall b a. (Show a, IsString b) => a -> b
show (LByteString, 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
<> LByteString -> Text
forall b a. (Show a, IsString b) => a -> b
show LByteString
bs

    cbs :: LByteString
cbs = Int64 -> LByteString -> LByteString
L.drop Int64
compressedDisambiguateLen LByteString
preCbs