Darcs pull over HTTP

This commit is contained in:
fr33domlover 2016-05-13 10:58:42 +00:00
parent 0d7349cb5d
commit 80576d9caa
3 changed files with 18 additions and 2 deletions

View file

@ -47,6 +47,8 @@
/u/#Text/r/#Text/c RepoHeadChangesR GET
/u/#Text/r/#Text/c/#Text RepoChangesR GET
/u/#Text/r/#Text/_darcs/+Texts DarcsDownloadR GET
/u/#Text/r/#Text/git/info/refs GitRefDiscoverR GET
--/u/#Text/r/#Text/git/git-upload-pack GitUploadRequestR POST

View file

@ -21,6 +21,7 @@ module Vervis.Handler.Repo
, getRepoSourceR
, getRepoHeadChangesR
, getRepoChangesR
, getDarcsDownloadR
)
where

View file

@ -17,11 +17,12 @@ module Vervis.Handler.Repo.Darcs
( getDarcsRepoSource
, getDarcsRepoHeadChanges
, getDarcsRepoChanges
, getDarcsDownloadR
)
where
import ClassyPrelude.Conduit hiding (last, unpack)
import Yesod hiding (Header, parseTime, (==.))
import Yesod hiding (Header, parseTime, (==.), joinPath)
import Yesod.Auth
import Prelude (init, last, tail)
@ -31,10 +32,12 @@ import Data.Text (unpack)
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Database.Esqueleto
import System.Directory (createDirectoryIfMissing)
import System.FilePath (joinPath)
import System.Directory (doesFileExist)
import qualified Data.DList as D
import qualified Data.Set as S (member)
import qualified Data.Text as T (unpack)
import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With)
import Data.ByteString.Char8.Local (takeLine)
@ -86,3 +89,13 @@ getDarcsRepoHeadChanges shar repo = do
getDarcsRepoChanges :: Text -> Text -> Text -> Handler Html
getDarcsRepoChanges shar repo tag = notFound
getDarcsDownloadR :: Text -> Text -> [Text] -> Handler TypedContent
getDarcsDownloadR shar repo dir = do
path <- askRepoDir shar repo
let darcsDir = path </> "_darcs"
filePath = darcsDir </> joinPath (map T.unpack dir)
exists <- liftIO $ doesFileExist filePath
if exists
then sendFile typeOctet filePath
else notFound