{-
Copyright (C) 2004 David Roundy

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA.
-}

{-|

  Path resolving:

    * An http URL contains the sequence @\"http(s):\/\/\"@.

    * A local filepath does not contain colons, except
      as second character (windows drives) when this
      filepath is meant to be used as repository name

    * A path that is neither an http URL nor a local file
      is an ssh-path.

  Examples:

  > /usr/repo/foo                 -- local file
  > c:/src/darcs                  -- local file
  > http://darcs.net/             -- URL
  > peter@host:/path              -- ssh
  > droundy@host:                 -- ssh
  > host:/path                    -- ssh

  This means that single-letter hosts in ssh-paths do not work,
  unless a username is provided.

  Perhaps ssh-paths should use @\"ssh:\/\/user\@host\/path\"@-syntax instead?

  TODO: This whole module should be re-written using a regex matching library!
  The way we do this here is error-prone and inefficient.
-}

module Darcs.Util.URL (
    isValidLocalPath, isHttpUrl, isSshUrl, isRelative, isAbsolute,
    isSshNopath, SshFilePath, sshRepo, sshUhost, sshFile, sshFilePathOf, splitSshUrl
  ) where

import Darcs.Prelude

import Darcs.Util.Global ( darcsdir )
import Data.List ( isPrefixOf, isInfixOf )
import Data.Char ( isSpace )
import qualified System.FilePath as FP
    ( hasDrive
    , isAbsolute
    , isRelative
    , isValid
    , pathSeparators
    )
import System.FilePath ( (</>) )

isRelative :: String -> Bool
isRelative :: String -> Bool
isRelative String
"" = String -> Bool
forall a. HasCallStack => String -> a
error String
"Empty filename in isRelative"
isRelative String
f  = String -> Bool
FP.isRelative String
f

isAbsolute :: String -> Bool
isAbsolute :: String -> Bool
isAbsolute String
"" = String -> Bool
forall a. HasCallStack => String -> a
error String
"isAbsolute called with empty filename"
isAbsolute String
f = String -> Bool
FP.isAbsolute String
f

isValidLocalPath :: String -> Bool
isValidLocalPath :: String -> Bool
isValidLocalPath String
s =
  String -> Bool
FP.isValid String
s Bool -> Bool -> Bool
&&
  (String -> Bool
FP.hasDrive String
s Bool -> Bool -> Bool
|| Bool -> Bool
not (Char
':' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
FP.pathSeparators) String
s))

isHttpUrl :: String -> Bool
isHttpUrl :: String -> Bool
isHttpUrl String
u =
    let u' :: String
u' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
u in
            (String
"http://" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
u') Bool -> Bool -> Bool
|| (String
"https://" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
u')


isSshUrl :: String -> Bool
isSshUrl :: String -> Bool
isSshUrl String
s = String -> Bool
isu' ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
s)
    where
      isu' :: String -> Bool
isu' String
s'
          | String
"ssh://" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s' = Bool
True
          | String
"://" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s' = Bool
False
          | String -> Bool
isValidLocalPath String
s' = Bool
False
          | Bool
otherwise = String
":" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s'

isSshNopath :: String -> Bool
isSshNopath :: String -> Bool
isSshNopath String
s = case String -> String
forall a. [a] -> [a]
reverse String
s of
                  Char
':':x :: String
x@(Char
_:Char
_:String
_) -> Char
':' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
x
                  String
_ -> Bool
False

-- | Given an ssh URL or file path, split it into
-- user@host, repodir, and the file (with any _darcs/ prefix removed)
splitSshUrl :: String -> SshFilePath
splitSshUrl :: String -> SshFilePath
splitSshUrl String
s | String
"ssh://" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s =
  let s' :: String
s' = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"ssh://") (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
s
      (String
dir, String
file) = Char -> String -> (String, String)
cleanrepodir Char
'/' String
s'
  in
  SshFP :: String -> String -> String -> SshFilePath
SshFP { sshUhost :: String
sshUhost = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') String
s'
        , sshRepo :: String
sshRepo = String
dir
        , sshFile :: String
sshFile = String
file }
splitSshUrl String
s =
  let (String
dir, String
file) = Char -> String -> (String, String)
cleanrepodir Char
':' String
s in
  SshFP :: String -> String -> String -> SshFilePath
SshFP { sshUhost :: String
sshUhost = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') String
s
        , sshRepo :: String
sshRepo = String
dir
        , sshFile :: String
sshFile = String
file }

cleanrepourl :: String -> (String, String)
cleanrepourl :: String -> (String, String)
cleanrepourl String
zzz | String
dd String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
zzz = ([], Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
dd) String
zzz)
                 where dd :: String
dd = String
darcsdirString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"/"
cleanrepourl (Char
z:String
zs) =
  let (String
repo',String
file) = String -> (String, String)
cleanrepourl String
zs in
  (Char
z Char -> String -> String
forall a. a -> [a] -> [a]
: String
repo', String
file)
cleanrepourl String
"" = ([],[])

cleanrepodir :: Char -> String -> (String, String)
cleanrepodir :: Char -> String -> (String, String)
cleanrepodir Char
sep = String -> (String, String)
cleanrepourl (String -> (String, String))
-> (String -> String) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
sep)

data SshFilePath = SshFP { SshFilePath -> String
sshUhost :: String
                         , SshFilePath -> String
sshRepo :: String
                         , SshFilePath -> String
sshFile :: String }

sshFilePathOf :: SshFilePath -> String
sshFilePathOf :: SshFilePath -> String
sshFilePathOf (SshFP String
uhost String
dir String
file) = String
uhost String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String
dir String -> String -> String
</> String
darcsdir String -> String -> String
</> String
file)