{- This file is part of Vervis. - - Written in 2016 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - - The author(s) have dedicated all copyright and related and neighboring - rights to this software to the public domain worldwide. This software is - distributed without any warranty. - - You should have received a copy of the CC0 Public Domain Dedication along - with this software. If not, see - . -} module Vervis.Handler.Git ( getGitRefDiscoverR ) where import Prelude import Control.Monad.IO.Class (liftIO) import Data.Git.Storage (isRepo, withRepo) import Data.String (fromString) import Data.Text (Text) import Network.Git.Fetch.RefDiscovery import Yesod.Core.Handler import Vervis.Content (GitRefDiscovery (..)) import Vervis.Foundation (Handler) import Vervis.Path (askRepoDir) getGitRefDiscoverR :: Text -> Text -> Handler GitRefDiscovery getGitRefDiscoverR sharer repo = do path <- askRepoDir sharer repo let pathG = fromString path seemsThere <- liftIO $ isRepo pathG if seemsThere then do rq <- getRequest case reqGetParams rq of [("service", serv)] -> if serv == "git-upload-pack" then do rd <- liftIO $ withRepo pathG $ flip buildRefDiscover' $ Just "git-upload-pack" setHeader "Cache-Control" "no-cache" return GitRefDiscovery { grdContent = serializeRefDiscover rd , grdService = "git-upload-pack" } else permissionDenied "Service not supported" _ -> notFound else notFound