module Data.Git.Phoenix.Sha
  ( ComHash
  , hexToBin
  , shaToPath
  , binSha2Path
  , binSha2Str
  , parseSha1
  , showDigest
  , sha1
  , gitPath2Bs
  , cutGitPath
  ) where

import Crypto.Hash.SHA1 (hashlazy)
import Data.Binary qualified as B
import Data.ByteArray.Encoding (Base(Base16), convertFromBase, convertToBase)
import Data.ByteString.Char8 qualified as C
import Data.ByteString.Lazy.Char8 qualified as L8
import Data.Char (isHexDigit)
import Data.Git.Phoenix.Object
import Data.List.Extra qualified as L
import Relude

type ComHash = ByteString

sha1 :: LByteString -> ByteString
sha1 :: LByteString -> ByteString
sha1 = LByteString -> ByteString
hashlazy

showDigest :: ByteString -> String
showDigest :: ByteString -> String
showDigest = ByteString -> String
C.unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16

parseSha1 :: String -> Either String ComHash
parseSha1 :: String -> Either String ByteString
parseSha1
  String
h | String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isHexDigit String
h) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
40 =
      (ByteString -> ByteString)
-> Either String ByteString -> Either String ByteString
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LByteString -> ByteString
forall a. Binary a => LByteString -> a
B.decode (LByteString -> ByteString)
-> (ByteString -> LByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LByteString
forall l s. LazyStrict l s => s -> l
toLazy) (Either String ByteString -> Either String ByteString)
-> Either String ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16 (String -> ByteString
C.pack String
h)
    | Bool
otherwise = String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse SHA1: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
h

fromRightEr :: Either String a -> a
fromRightEr :: forall a. Either String a -> a
fromRightEr = \case
  Right a
a -> a
a
  Left String
e -> Text -> a
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToText a => a -> Text
toText String
e

hexToBin :: LByteString -> LByteString
hexToBin :: LByteString -> LByteString
hexToBin = ByteString -> LByteString
forall l s. LazyStrict l s => s -> l
toLazy (ByteString -> LByteString)
-> (LByteString -> ByteString) -> LByteString -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String ByteString -> ByteString
forall a. Either String a -> a
fromRightEr (Either String ByteString -> ByteString)
-> (LByteString -> Either String ByteString)
-> LByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16 (ByteString -> Either String ByteString)
-> (LByteString -> ByteString)
-> LByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict

shaToPath :: String -> GitPath a
shaToPath :: forall (a :: GitObjTypeG). String -> GitPath a
shaToPath = \case
  Char
a:Char
b:String
r -> String -> GitPath a
forall (a :: GitObjTypeG). String -> GitPath a
GitPath (String -> GitPath a) -> String -> GitPath a
forall a b. (a -> b) -> a -> b
$ Char
aChar -> String -> String
forall a. a -> [a] -> [a]
:Char
bChar -> String -> String
forall a. a -> [a] -> [a]
:Char
'/'Char -> String -> String
forall a. a -> [a] -> [a]
:String
r
  String
o -> String -> GitPath a
forall (a :: GitObjTypeG). String -> GitPath a
GitPath String
o

binSha2Path :: LByteString -> GitPath a
binSha2Path :: forall (a :: GitObjTypeG). LByteString -> GitPath a
binSha2Path = String -> GitPath a
forall (a :: GitObjTypeG). String -> GitPath a
shaToPath (String -> GitPath a)
-> (LByteString -> String) -> LByteString -> GitPath a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> String
binSha2Str

binSha2Str :: LByteString -> String
binSha2Str :: LByteString -> String
binSha2Str = ByteString -> String
C.unpack (ByteString -> String)
-> (LByteString -> ByteString) -> LByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16 (ByteString -> ByteString)
-> (LByteString -> ByteString) -> LByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict

gitPath2Bs :: GitPath a -> LByteString
gitPath2Bs :: forall (a :: GitObjTypeG). GitPath a -> LByteString
gitPath2Bs (GitPath String
fp) =
  case String
fp of
    Char
a:Char
b:Char
'/':String
r -> LByteString -> LByteString
hexToBin (LByteString -> LByteString)
-> (String -> LByteString) -> String -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LByteString
L8.pack (String -> LByteString) -> String -> LByteString
forall a b. (a -> b) -> a -> b
$ Char
aChar -> String -> String
forall a. a -> [a] -> [a]
:Char
bChar -> String -> String
forall a. a -> [a] -> [a]
:String
r
    String
_ -> Text -> LByteString
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> LByteString) -> (String -> Text) -> String -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> LByteString) -> String -> LByteString
forall a b. (a -> b) -> a -> b
$ String
"Bad GitPath: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fp

cutGitPath :: FilePath -> Maybe LByteString
cutGitPath :: String -> Maybe LByteString
cutGitPath String
fp =
  case Int -> String -> String
forall a. Int -> [a] -> [a]
L.takeEnd Int
41 String
fp of
    Char
a:Char
b:Char
'/':String
r -> LByteString -> Maybe LByteString
forall a. a -> Maybe a
Just (LByteString -> Maybe LByteString)
-> (String -> LByteString) -> String -> Maybe LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> LByteString
hexToBin (LByteString -> LByteString)
-> (String -> LByteString) -> String -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LByteString
L8.pack (String -> Maybe LByteString) -> String -> Maybe LByteString
forall a b. (a -> b) -> a -> b
$ Char
aChar -> String -> String
forall a. a -> [a] -> [a]
:Char
bChar -> String -> String
forall a. a -> [a] -> [a]
:String
r
    String
_ -> Maybe LByteString
forall a. Maybe a
Nothing