From 80576d9caa3b3fea7bf5779ddffe5bcf52af59c8 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Fri, 13 May 2016 10:58:42 +0000
Subject: [PATCH] Darcs pull over HTTP

---
 config/routes                    |  2 ++
 src/Vervis/Handler/Repo.hs       |  1 +
 src/Vervis/Handler/Repo/Darcs.hs | 17 +++++++++++++++--
 3 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/config/routes b/config/routes
index 79abfb1..75d41ec 100644
--- a/config/routes
+++ b/config/routes
@@ -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
 
diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs
index d321173..21c6959 100644
--- a/src/Vervis/Handler/Repo.hs
+++ b/src/Vervis/Handler/Repo.hs
@@ -21,6 +21,7 @@ module Vervis.Handler.Repo
     , getRepoSourceR
     , getRepoHeadChangesR
     , getRepoChangesR
+    , getDarcsDownloadR
     )
 where
 
diff --git a/src/Vervis/Handler/Repo/Darcs.hs b/src/Vervis/Handler/Repo/Darcs.hs
index ea40d90..a69d626 100644
--- a/src/Vervis/Handler/Repo/Darcs.hs
+++ b/src/Vervis/Handler/Repo/Darcs.hs
@@ -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