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
    , getDirectoryContents
    , doesDirectoryExist
    , doesFileExist
    , renameFile
    , renameDirectory
    , copyFile
    )

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

import Darcs.Util.Global ( defaultRemoteDarcsCmd )
import Darcs.Util.Download
    ( copyUrl
    , copyUrlFirst
    , waitUrl
    , Cachable(..)
    )

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.Browser
    ( browse
    , request
    , setErrHandler
    , setOutHandler
    , setAllowRedirects
    )
import Network.HTTP
    ( RequestMethod(GET)
    , rspCode
    , rspBody
    , rspReason
    , mkRequest
    )
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 _    fou :: String
fou out :: String
out _     | String -> Bool
isValidLocalPath String
fou = String -> String -> IO ()
copyLocal String
fou String
out
copyFileOrUrl _    fou :: String
fou out :: String
out cache :: Cachable
cache | String -> Bool
isHttpUrl  String
fou = String -> String -> Cachable -> IO ()
copyRemote String
fou String
out Cachable
cache
copyFileOrUrl rd :: String
rd   fou :: String
fou out :: String
out _     | String -> Bool
isSshUrl  String
fou = String -> SshFilePath -> String -> IO ()
copySSH String
rd (String -> SshFilePath
splitSshUrl String
fou) String
out
copyFileOrUrl _    fou :: String
fou _   _     = String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "unknown transport protocol: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fou

copyLocal  :: String -> FilePath -> IO ()
copyLocal :: String -> String -> IO ()
copyLocal fou :: String
fou out :: 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] -> String -> String -> IO ()
cloneTreeExcept []

cloneTreeExcept :: [FilePath] -> FilePath -> FilePath -> IO ()
cloneTreeExcept :: [String] -> String -> String -> IO ()
cloneTreeExcept except :: [String]
except source :: String
source dest :: String
dest =
 do FileStatus
fs <- String -> IO FileStatus
getSymbolicLinkStatus String
source
    if FileStatus -> Bool
isDirectory FileStatus
fs then do
        [String]
fps <- String -> IO [String]
getDirectoryContents String
source
        let fps' :: [String]
fps' = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ("."String -> [String] -> [String]
forall a. a -> [a] -> [a]
:".."String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
except)) [String]
fps
            mk_source :: String -> String
mk_source fp :: String
fp = String
source String -> String -> String
</> String
fp
            mk_dest :: String -> String
mk_dest   fp :: String
fp = String
dest   String -> String -> String
</> String
fp
        (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 -> String
mk_source [String]
fps') ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
mk_dest [String]
fps')
     else String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("cloneTreeExcept: 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 ("cloneTreeExcept: Bad source " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
source)

cloneSubTree :: FilePath -> FilePath -> IO ()
cloneSubTree :: String -> String -> IO ()
cloneSubTree source :: String
source dest :: 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]
getDirectoryContents String
source
        let fps' :: [String]
fps' = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [".", ".."]) [String]
fps
            mk_source :: String -> String
mk_source fp :: String
fp = String
source String -> String -> String
</> String
fp
            mk_dest :: String -> String
mk_dest   fp :: String
fp = String
dest   String -> String -> String
</> String
fp
        (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 -> String
mk_source [String]
fps') ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
mk_dest [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 ("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` (\e :: 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 x :: String
x y :: 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 x :: String
x y :: 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 backup :: String -> String -> IO ()
backup f :: 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 0
  where
  helper :: Int -> IO ()
  helper :: Int -> IO ()
helper i :: 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
+ 1)
                   else do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Backing up " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ "(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"
                           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
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ "~"

copyAndReadFile :: (FilePath -> IO a) -> String -> Cachable -> IO a
copyAndReadFile :: (String -> IO a) -> String -> Cachable -> IO a
copyAndReadFile readfn :: String -> IO a
readfn fou :: String
fou _ | String -> Bool
isValidLocalPath String
fou = String -> IO a
readfn String
fou
copyAndReadFile readfn :: String -> IO a
readfn fou :: String
fou cache :: 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
$ \t :: 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 x :: String
x c :: Cachable
c = case String -> Maybe URI
parseURI String
x of
  Just x' :: URI
x' | URI -> String
uriScheme URI
x' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "http:" -> do
    Response ByteString
rsp <- ((URI, Response ByteString) -> Response ByteString)
-> IO (URI, Response ByteString) -> IO (Response ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (URI, Response ByteString) -> Response ByteString
forall a b. (a, b) -> b
snd (IO (URI, Response ByteString) -> IO (Response ByteString))
-> (BrowserAction
      (HandleStream ByteString) (URI, Response ByteString)
    -> IO (URI, Response ByteString))
-> BrowserAction
     (HandleStream ByteString) (URI, Response ByteString)
-> IO (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BrowserAction (HandleStream ByteString) (URI, Response ByteString)
-> IO (URI, Response ByteString)
forall conn a. BrowserAction conn a -> IO a
browse (BrowserAction (HandleStream ByteString) (URI, Response ByteString)
 -> IO (Response ByteString))
-> BrowserAction
     (HandleStream ByteString) (URI, Response ByteString)
-> IO (Response ByteString)
forall a b. (a -> b) -> a -> b
$ do
      (String -> IO ()) -> BrowserAction (HandleStream ByteString) ()
forall t. (String -> IO ()) -> BrowserAction t ()
setErrHandler ((String -> IO ()) -> BrowserAction (HandleStream ByteString) ())
-> (IO () -> String -> IO ())
-> IO ()
-> BrowserAction (HandleStream ByteString) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> String -> IO ()
forall a b. a -> b -> a
const (IO () -> BrowserAction (HandleStream ByteString) ())
-> IO () -> BrowserAction (HandleStream ByteString) ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      (String -> IO ()) -> BrowserAction (HandleStream ByteString) ()
forall t. (String -> IO ()) -> BrowserAction t ()
setOutHandler ((String -> IO ()) -> BrowserAction (HandleStream ByteString) ())
-> (IO () -> String -> IO ())
-> IO ()
-> BrowserAction (HandleStream ByteString) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> String -> IO ()
forall a b. a -> b -> a
const (IO () -> BrowserAction (HandleStream ByteString) ())
-> IO () -> BrowserAction (HandleStream ByteString) ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Bool -> BrowserAction (HandleStream ByteString) ()
forall t. Bool -> BrowserAction t ()
setAllowRedirects Bool
True
      Request ByteString
-> BrowserAction
     (HandleStream ByteString) (URI, Response ByteString)
forall ty.
HStream ty =>
Request ty -> BrowserAction (HandleStream ty) (URI, Response ty)
request (Request ByteString
 -> BrowserAction
      (HandleStream ByteString) (URI, Response ByteString))
-> Request ByteString
-> BrowserAction
     (HandleStream ByteString) (URI, Response ByteString)
forall a b. (a -> b) -> a -> b
$ RequestMethod -> URI -> Request ByteString
forall ty. BufferType ty => RequestMethod -> URI -> Request ty
mkRequest RequestMethod
GET URI
x'
    if Response ByteString -> ResponseCode
forall a. Response a -> ResponseCode
rspCode Response ByteString
rsp ResponseCode -> ResponseCode -> Bool
forall a. Eq a => a -> a -> Bool
/= (2, 0, 0)
      then String -> IO ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ "fetchFileLazyPS: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Response ByteString -> String
forall a. Response a -> String
rspReason Response ByteString
rsp
      else ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall a. Response a -> a
rspBody Response ByteString
rsp
  _ -> (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

copyRemote :: String -> FilePath -> Cachable -> IO ()
copyRemote :: String -> String -> Cachable -> IO ()
copyRemote u :: String
u v :: String
v cache :: Cachable
cache = String -> String -> Cachable -> IO ()
copyUrlFirst String
u String
v Cachable
cache IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
waitUrl String
u

speculateFileOrUrl :: String -> FilePath -> IO ()
speculateFileOrUrl :: String -> String -> IO ()
speculateFileOrUrl fou :: String
fou out :: 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 ()

speculateRemote :: String -> FilePath -> IO () -- speculations are always Cachable
speculateRemote :: String -> String -> IO ()
speculateRemote u :: String
u v :: String
v = String -> String -> Cachable -> IO ()
copyUrl String
u String
v Cachable
Cachable