{-# LANGUAGE CPP #-}
module Darcs.Util.External
    ( cloneTree
    , cloneFile
    , fetchFilePS
    , fetchFileLazyPS
    , gzFetchFilePS
    , speculateFileOrUrl
    , copyFileOrUrl
    , Cachable(..)
    , backupByRenaming
    , backupByCopying
    ) where

import Control.Exception ( catch, IOException )

import System.Posix.Files
    ( getSymbolicLinkStatus
    , isRegularFile
    , isDirectory
    , createLink
    )
import System.Directory
    ( createDirectory
    , listDirectory
    , doesDirectoryExist
    , doesFileExist
    , renameFile
    , renameDirectory
    , copyFile
    )

import System.FilePath.Posix ( (</>), normalise )
import System.IO.Error ( isDoesNotExistError )
import Control.Monad
    ( unless
    , when
    , zipWithM_
    )

import Darcs.Prelude

import Darcs.Util.Global ( defaultRemoteDarcsCmd )
import Darcs.Util.Download ( Cachable(..) )
#ifdef HAVE_CURL
import Darcs.Util.Download ( copyUrl, copyUrlFirst, waitUrl )
#endif
import qualified Darcs.Util.HTTP as HTTP
import Darcs.Util.URL
    ( isValidLocalPath
    , isHttpUrl
    , isSshUrl
    , splitSshUrl
    )
import Darcs.Util.Exception ( catchall )
import Darcs.Util.Lock ( withTemp )
import Darcs.Util.Ssh ( copySSH )
import Darcs.Util.ByteString ( gzReadFilePS )
import qualified Data.ByteString as B (ByteString, readFile )
import qualified Data.ByteString.Lazy as BL

import Network.URI
    ( parseURI
    , uriScheme
    )

copyFileOrUrl :: String    -- ^ remote darcs executable
              -> FilePath  -- ^ path representing the origin file or URL
              -> FilePath  -- ^ destination path
              -> Cachable  -- ^ tell whether file to copy is cachable
              -> IO ()
copyFileOrUrl :: String -> String -> String -> Cachable -> IO ()
copyFileOrUrl String
_    String
fou String
out Cachable
_     | String -> Bool
isValidLocalPath String
fou = String -> String -> IO ()
copyLocal String
fou String
out
copyFileOrUrl String
_    String
fou String
out Cachable
cache | String -> Bool
isHttpUrl  String
fou = String -> String -> Cachable -> IO ()
copyRemote String
fou String
out Cachable
cache
copyFileOrUrl String
rd   String
fou String
out Cachable
_     | String -> Bool
isSshUrl  String
fou = String -> SshFilePath -> String -> IO ()
copySSH String
rd (String -> SshFilePath
splitSshUrl String
fou) String
out
copyFileOrUrl String
_    String
fou String
_   Cachable
_     = String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"unknown transport protocol: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fou

copyLocal  :: String -> FilePath -> IO ()
copyLocal :: String -> String -> IO ()
copyLocal String
fou String
out = String -> String -> IO ()
createLink String
fou String
out IO () -> IO () -> IO ()
forall a. IO a -> IO a -> IO a
`catchall` String -> String -> IO ()
cloneFile String
fou String
out

cloneTree :: FilePath -> FilePath -> IO ()
cloneTree :: String -> String -> IO ()
cloneTree String
source String
dest =
 do FileStatus
fs <- String -> IO FileStatus
getSymbolicLinkStatus String
source
    if FileStatus -> Bool
isDirectory FileStatus
fs then do
        [String]
fps <- String -> IO [String]
listDirectory String
source
        (String -> String -> IO ()) -> [String] -> [String] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ String -> String -> IO ()
cloneSubTree ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
source String -> String -> String
</>) [String]
fps) ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
dest String -> String -> String
</>) [String]
fps)
     else String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"cloneTree: Bad source " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
source)
   IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
_ :: IOException) -> String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"cloneTree: Bad source " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
source)

cloneSubTree :: FilePath -> FilePath -> IO ()
cloneSubTree :: String -> String -> IO ()
cloneSubTree String
source String
dest =
 do FileStatus
fs <- String -> IO FileStatus
getSymbolicLinkStatus String
source
    if FileStatus -> Bool
isDirectory FileStatus
fs then do
        String -> IO ()
createDirectory String
dest
        [String]
fps <- String -> IO [String]
listDirectory String
source
        (String -> String -> IO ()) -> [String] -> [String] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ String -> String -> IO ()
cloneSubTree ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
source String -> String -> String
</>) [String]
fps) ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
dest String -> String -> String
</>) [String]
fps)
     else if FileStatus -> Bool
isRegularFile FileStatus
fs then
        String -> String -> IO ()
cloneFile String
source String
dest
     else String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"cloneSubTree: Bad source "String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
source)
    IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\IOException
e -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (IOException -> Bool
isDoesNotExistError IOException
e) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e)

cloneFile :: FilePath -> FilePath -> IO ()
cloneFile :: String -> String -> IO ()
cloneFile = String -> String -> IO ()
copyFile

backupByRenaming :: FilePath -> IO ()
backupByRenaming :: String -> IO ()
backupByRenaming = (String -> String -> IO ()) -> String -> IO ()
backupBy String -> String -> IO ()
rename
 where rename :: String -> String -> IO ()
rename String
x String
y = do
         Bool
isD <- String -> IO Bool
doesDirectoryExist String
x
         if Bool
isD then String -> String -> IO ()
renameDirectory String
x String
y else String -> String -> IO ()
renameFile String
x String
y

backupByCopying :: FilePath -> IO ()
backupByCopying :: String -> IO ()
backupByCopying = (String -> String -> IO ()) -> String -> IO ()
backupBy String -> String -> IO ()
copy
 where
  copy :: String -> String -> IO ()
copy String
x String
y = do
    Bool
isD <- String -> IO Bool
doesDirectoryExist String
x
    if Bool
isD then do String -> IO ()
createDirectory String
y
                   String -> String -> IO ()
cloneTree (String -> String
normalise String
x) (String -> String
normalise String
y)
           else String -> String -> IO ()
copyFile String
x String
y

backupBy :: (FilePath -> FilePath -> IO ()) -> FilePath -> IO ()
backupBy :: (String -> String -> IO ()) -> String -> IO ()
backupBy String -> String -> IO ()
backup String
f =
           do Bool
hasBF <- String -> IO Bool
doesFileExist String
f
              Bool
hasBD <- String -> IO Bool
doesDirectoryExist String
f
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasBF Bool -> Bool -> Bool
|| Bool
hasBD) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
helper Int
0
  where
  helper :: Int -> IO ()
  helper :: Int -> IO ()
helper Int
i = do Bool
existsF <- String -> IO Bool
doesFileExist String
next
                Bool
existsD <- String -> IO Bool
doesDirectoryExist String
next
                if Bool
existsF Bool -> Bool -> Bool
|| Bool
existsD
                   then Int -> IO ()
helper (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                   else do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Backing up " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                           String -> String -> IO ()
backup String
f String
next
             where next :: String
next = String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix
                   suffix :: String
suffix = String
".~" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"~"

copyAndReadFile :: (FilePath -> IO a) -> String -> Cachable -> IO a
copyAndReadFile :: (String -> IO a) -> String -> Cachable -> IO a
copyAndReadFile String -> IO a
readfn String
fou Cachable
_ | String -> Bool
isValidLocalPath String
fou = String -> IO a
readfn String
fou
copyAndReadFile String -> IO a
readfn String
fou Cachable
cache = (String -> IO a) -> IO a
forall a. (String -> IO a) -> IO a
withTemp ((String -> IO a) -> IO a) -> (String -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \String
t -> do
  String -> String -> String -> Cachable -> IO ()
copyFileOrUrl String
defaultRemoteDarcsCmd String
fou String
t Cachable
cache
  String -> IO a
readfn String
t

-- | @fetchFile fileOrUrl cache@ returns the content of its argument (either a
-- file or an URL). If it has to download an url, then it will use a cache as
-- required by its second argument.
--
-- We always use default remote darcs, since it is not fatal if the remote
-- darcs does not exist or is too old -- anything that supports transfer-mode
-- should do, and if not, we will fall back to SFTP or SCP.
fetchFilePS :: String -> Cachable -> IO B.ByteString
fetchFilePS :: String -> Cachable -> IO ByteString
fetchFilePS = (String -> IO ByteString) -> String -> Cachable -> IO ByteString
forall a. (String -> IO a) -> String -> Cachable -> IO a
copyAndReadFile (String -> IO ByteString
B.readFile)

-- | @fetchFileLazyPS fileOrUrl cache@ lazily reads the content of its argument
-- (either a file or an URL). Warning: this function may constitute a fd leak;
-- make sure to force consumption of file contents to avoid that. See
-- "fetchFilePS" for details.
fetchFileLazyPS :: String -> Cachable -> IO BL.ByteString
fetchFileLazyPS :: String -> Cachable -> IO ByteString
fetchFileLazyPS String
x Cachable
c = case String -> Maybe URI
parseURI String
x of
  Just URI
x' | URI -> String
uriScheme URI
x' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"http:" -> String -> Cachable -> IO ByteString
HTTP.copyRemoteLazy String
x Cachable
c
  Maybe URI
_ -> (String -> IO ByteString) -> String -> Cachable -> IO ByteString
forall a. (String -> IO a) -> String -> Cachable -> IO a
copyAndReadFile String -> IO ByteString
BL.readFile String
x Cachable
c

gzFetchFilePS :: String -> Cachable -> IO B.ByteString
gzFetchFilePS :: String -> Cachable -> IO ByteString
gzFetchFilePS = (String -> IO ByteString) -> String -> Cachable -> IO ByteString
forall a. (String -> IO a) -> String -> Cachable -> IO a
copyAndReadFile String -> IO ByteString
gzReadFilePS

speculateFileOrUrl :: String -> FilePath -> IO ()
speculateFileOrUrl :: String -> String -> IO ()
speculateFileOrUrl String
fou String
out | String -> Bool
isHttpUrl String
fou = String -> String -> IO ()
speculateRemote String
fou String
out
                           | Bool
otherwise = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

copyRemote :: String -> FilePath -> Cachable -> IO ()
speculateRemote :: String -> FilePath -> IO () -- speculations are always Cachable

#ifdef HAVE_CURL
copyRemote u v cache = copyUrlFirst u v cache >> waitUrl u
speculateRemote u v = copyUrl u v Cachable
#else
copyRemote :: String -> String -> Cachable -> IO ()
copyRemote = String -> String -> Cachable -> IO ()
HTTP.copyRemote
speculateRemote :: String -> String -> IO ()
speculateRemote = String -> String -> IO ()
HTTP.speculateRemote
#endif