{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Network.IPFS.Git.RemoteHelper.Internal where
import qualified Crypto.Hash as C
import qualified Data.ByteString.BaseN as BaseN
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import qualified Data.Git.Ref as Git
import Data.Git.Storage.Object (Object(..))
import Data.Git.Types
import Data.IPLD.CID
( CID
, Codec(..)
, cidCodec
, cidFromText
, cidHash
, newCidV1
)
import Data.Multihash (Multihashable)
import qualified Data.Multihash as Multihash
objectLinks :: Multihashable hash => Object hash -> Vector CID
objectLinks = \case
ObjCommit x -> commitLinks x
ObjTag x -> tagLinks x
ObjBlob x -> blobLinks x
ObjTree x -> treeLinks x
ObjDeltaOfs _ -> mempty
ObjDeltaRef _ -> mempty
treeLinks :: forall hash. Multihashable hash => Tree hash -> Vector CID
treeLinks (Tree entries) = foldMap (Vector.singleton . cid) entries
where
cid (_,_,ref) = refToCid @hash ref
commitLinks :: Multihashable hash => Commit hash -> Vector CID
commitLinks Commit { commitTreeish, commitParents } =
Vector.singleton (refToCid commitTreeish)
<> Vector.fromList (map refToCid commitParents)
tagLinks :: Multihashable hash => Tag hash -> Vector CID
tagLinks = Vector.singleton . refToCid . tagRef
blobLinks :: Blob hash -> Vector CID
blobLinks = const mempty
cidFromHexShaText :: Text -> Either String CID
cidFromHexShaText t = do
bytes <- BaseN.decodeBase16Either $ Text.encodeUtf8 t
digest <- note ("Invalid digest: " <> Text.unpack t) $ C.digestFromByteString @Git.SHA1 bytes
pure $ newCidV1 GitRaw digest
hexShaFromCidText :: Text -> Either String Text
hexShaFromCidText t = do
cid <- cidFromText t
Text.pack . Git.toHexString <$> cidToRef @Git.SHA1 cid
refToCid :: forall hash. Multihashable hash => Git.Ref hash -> CID
refToCid =
newCidV1 GitRaw
. fromMaybe (error "refToCid: Subverted Git.Ref supplied")
. C.digestFromByteString @hash
. Git.toBinary
cidToRef :: Multihashable hash => CID -> Either String (Git.Ref hash)
cidToRef cid =
case cidCodec cid of
GitRaw ->
fmap Git.fromDigest
. Multihash.decodeDigest
. Multihash.encodedBytes
$ cidHash cid
codec -> Left $ "cidToRef: Unexpected codec `" <> show codec <> "`"
note :: a -> Maybe b -> Either a b
note l = maybe (Left l) Right
hush :: Either a b -> Maybe b
hush = either (const Nothing) pure