summaryrefslogtreecommitdiff
path: root/Remote/WebDAV/DavLocation.hs
blob: 157e7151a4f7a233be20f9d1f0483e8f7b2426ec (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
{- WebDAV locations.
 -
 - Copyright 2014 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}

module Remote.WebDAV.DavLocation where

import Types
import Locations
import Utility.Url (URLString)

import System.FilePath.Posix -- for manipulating url paths
import Network.Protocol.HTTP.DAV (inDAVLocation, DAVT)
import Control.Monad.IO.Class (MonadIO)
import Data.Default
#ifdef mingw32_HOST_OS
import Data.String.Utils
#endif

-- Relative to the top of the DAV url.
type DavLocation = String

{- Runs action in subdirectory, relative to the current location. -}
inLocation :: (MonadIO m) => DavLocation -> DAVT m a -> DAVT m a
inLocation d = inDAVLocation (</> d)

{- The directory where files(s) for a key are stored. -}
keyDir :: Key -> DavLocation
keyDir k = addTrailingPathSeparator $ hashdir </> keyFile k
  where
#ifndef mingw32_HOST_OS
	hashdir = hashDirLower def k
#else
	hashdir = replace "\\" "/" (hashDirLower def k)
#endif

keyLocation :: Key -> DavLocation
keyLocation k = keyDir k ++ keyFile k

{- Where we store temporary data for a key as it's being uploaded. -}
keyTmpLocation :: Key -> DavLocation
keyTmpLocation = addTrailingPathSeparator . tmpLocation . keyFile

tmpLocation :: FilePath -> DavLocation
tmpLocation f = tmpDir </> f

tmpDir :: DavLocation
tmpDir = "tmp"

locationParent :: String -> Maybe String
locationParent loc
	| loc `elem` tops = Nothing
	| otherwise = Just (takeDirectory loc)
  where
	tops = ["/", "", "."]

locationUrl :: URLString -> DavLocation -> URLString
locationUrl baseurl loc = baseurl </> loc